module CabalGild.Unstable.Type.ExeDependency where

import qualified CabalGild.Unstable.Type.VersionRange as VersionRange
import qualified Data.Ord as Ord
import qualified Distribution.Parsec as Parsec
import qualified Distribution.Pretty as Pretty
import qualified Distribution.Types.ExeDependency as ExeDependency

-- | This type exists to provide an 'Ord' instance for
-- 'ExeDependency.ExeDependency', which was added in @Cabal-syntax-3.10.1.0@.
newtype ExeDependency = ExeDependency
  { ExeDependency -> ExeDependency
unwrap :: ExeDependency.ExeDependency
  }
  deriving (ExeDependency -> ExeDependency -> Bool
(ExeDependency -> ExeDependency -> Bool)
-> (ExeDependency -> ExeDependency -> Bool) -> Eq ExeDependency
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExeDependency -> ExeDependency -> Bool
== :: ExeDependency -> ExeDependency -> Bool
$c/= :: ExeDependency -> ExeDependency -> Bool
/= :: ExeDependency -> ExeDependency -> Bool
Eq, Int -> ExeDependency -> ShowS
[ExeDependency] -> ShowS
ExeDependency -> String
(Int -> ExeDependency -> ShowS)
-> (ExeDependency -> String)
-> ([ExeDependency] -> ShowS)
-> Show ExeDependency
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExeDependency -> ShowS
showsPrec :: Int -> ExeDependency -> ShowS
$cshow :: ExeDependency -> String
show :: ExeDependency -> String
$cshowList :: [ExeDependency] -> ShowS
showList :: [ExeDependency] -> ShowS
Show)

instance Ord ExeDependency where
  compare :: ExeDependency -> ExeDependency -> Ordering
compare =
    (ExeDependency
 -> (PackageName, UnqualComponentName, VersionRange Version))
-> ExeDependency -> ExeDependency -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
Ord.comparing ((ExeDependency
  -> (PackageName, UnqualComponentName, VersionRange Version))
 -> ExeDependency -> ExeDependency -> Ordering)
-> (ExeDependency
    -> (PackageName, UnqualComponentName, VersionRange Version))
-> ExeDependency
-> ExeDependency
-> Ordering
forall a b. (a -> b) -> a -> b
$
      (\(ExeDependency.ExeDependency PackageName
pn UnqualComponentName
ucn VersionRange
vr) -> (PackageName
pn, UnqualComponentName
ucn, VersionRange -> VersionRange Version
VersionRange.fromVersionRange VersionRange
vr))
        (ExeDependency
 -> (PackageName, UnqualComponentName, VersionRange Version))
-> (ExeDependency -> ExeDependency)
-> ExeDependency
-> (PackageName, UnqualComponentName, VersionRange Version)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExeDependency -> ExeDependency
unwrap

instance Parsec.Parsec ExeDependency where
  parsec :: forall (m :: * -> *). CabalParsing m => m ExeDependency
parsec = ExeDependency -> ExeDependency
ExeDependency (ExeDependency -> ExeDependency)
-> m ExeDependency -> m ExeDependency
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m ExeDependency
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m ExeDependency
Parsec.parsec

instance Pretty.Pretty ExeDependency where
  pretty :: ExeDependency -> Doc
pretty = ExeDependency -> Doc
forall a. Pretty a => a -> Doc
Pretty.pretty (ExeDependency -> Doc)
-> (ExeDependency -> ExeDependency) -> ExeDependency -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExeDependency -> ExeDependency
unwrap