{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
module Distribution.Types.AbiDependency where
import Distribution.Compat.Prelude
import Prelude ()
import Distribution.Parsec
import Distribution.Pretty
import qualified Distribution.Compat.CharParsing as P
import qualified Distribution.Package as Package
import qualified Text.PrettyPrint as Disp
data AbiDependency = AbiDependency
{ AbiDependency -> UnitId
depUnitId :: Package.UnitId
, AbiDependency -> AbiHash
depAbiHash :: Package.AbiHash
}
deriving (AbiDependency -> AbiDependency -> Bool
(AbiDependency -> AbiDependency -> Bool)
-> (AbiDependency -> AbiDependency -> Bool) -> Eq AbiDependency
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AbiDependency -> AbiDependency -> Bool
== :: AbiDependency -> AbiDependency -> Bool
$c/= :: AbiDependency -> AbiDependency -> Bool
/= :: AbiDependency -> AbiDependency -> Bool
Eq, (forall x. AbiDependency -> Rep AbiDependency x)
-> (forall x. Rep AbiDependency x -> AbiDependency)
-> Generic AbiDependency
forall x. Rep AbiDependency x -> AbiDependency
forall x. AbiDependency -> Rep AbiDependency x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AbiDependency -> Rep AbiDependency x
from :: forall x. AbiDependency -> Rep AbiDependency x
$cto :: forall x. Rep AbiDependency x -> AbiDependency
to :: forall x. Rep AbiDependency x -> AbiDependency
Generic, ReadPrec [AbiDependency]
ReadPrec AbiDependency
Int -> ReadS AbiDependency
ReadS [AbiDependency]
(Int -> ReadS AbiDependency)
-> ReadS [AbiDependency]
-> ReadPrec AbiDependency
-> ReadPrec [AbiDependency]
-> Read AbiDependency
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS AbiDependency
readsPrec :: Int -> ReadS AbiDependency
$creadList :: ReadS [AbiDependency]
readList :: ReadS [AbiDependency]
$creadPrec :: ReadPrec AbiDependency
readPrec :: ReadPrec AbiDependency
$creadListPrec :: ReadPrec [AbiDependency]
readListPrec :: ReadPrec [AbiDependency]
Read, Int -> AbiDependency -> ShowS
[AbiDependency] -> ShowS
AbiDependency -> String
(Int -> AbiDependency -> ShowS)
-> (AbiDependency -> String)
-> ([AbiDependency] -> ShowS)
-> Show AbiDependency
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AbiDependency -> ShowS
showsPrec :: Int -> AbiDependency -> ShowS
$cshow :: AbiDependency -> String
show :: AbiDependency -> String
$cshowList :: [AbiDependency] -> ShowS
showList :: [AbiDependency] -> ShowS
Show, Typeable)
instance Pretty AbiDependency where
pretty :: AbiDependency -> Doc
pretty (AbiDependency UnitId
uid AbiHash
abi) =
UnitId -> Doc
forall a. Pretty a => a -> Doc
pretty UnitId
uid Doc -> Doc -> Doc
<<>> Char -> Doc
Disp.char Char
'=' Doc -> Doc -> Doc
<<>> AbiHash -> Doc
forall a. Pretty a => a -> Doc
pretty AbiHash
abi
instance Parsec AbiDependency where
parsec :: forall (m :: * -> *). CabalParsing m => m AbiDependency
parsec = do
uid <- m UnitId
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m UnitId
parsec
_ <- P.char '='
abi <- parsec
return (AbiDependency uid abi)
instance Binary AbiDependency
instance Structured AbiDependency
instance NFData AbiDependency where rnf :: AbiDependency -> ()
rnf = AbiDependency -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf