{-# 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

-- | An ABI dependency is a dependency on a library which also
-- records the ABI hash ('abiHash') of the library it depends
-- on.
--
-- The primary utility of this is to enable an extra sanity when
-- GHC loads libraries: it can check if the dependency has a matching
-- ABI and if not, refuse to load this library.  This information
-- is critical if we are shadowing libraries; differences in the
-- ABI hash let us know what packages get shadowed by the new version
-- of a package.
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
/= :: AbiDependency -> AbiDependency -> Bool
$c/= :: AbiDependency -> AbiDependency -> Bool
== :: AbiDependency -> AbiDependency -> Bool
$c== :: AbiDependency -> AbiDependency -> Bool
External instance of the constraint type Eq AbiHash
External instance of the constraint type Eq UnitId
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
$cto :: forall x. Rep AbiDependency x -> AbiDependency
$cfrom :: forall x. AbiDependency -> Rep AbiDependency x
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
readListPrec :: ReadPrec [AbiDependency]
$creadListPrec :: ReadPrec [AbiDependency]
readPrec :: ReadPrec AbiDependency
$creadPrec :: ReadPrec AbiDependency
readList :: ReadS [AbiDependency]
$creadList :: ReadS [AbiDependency]
readsPrec :: Int -> ReadS AbiDependency
$creadsPrec :: Int -> ReadS AbiDependency
External instance of the constraint type Read AbiHash
External instance of the constraint type Read UnitId
External instance of the constraint type Monad ReadPrec
External instance of the constraint type Monad ReadPrec
Instance of class: Read of the constraint type Read 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
showList :: [AbiDependency] -> ShowS
$cshowList :: [AbiDependency] -> ShowS
show :: AbiDependency -> String
$cshow :: AbiDependency -> String
showsPrec :: Int -> AbiDependency -> ShowS
$cshowsPrec :: Int -> AbiDependency -> ShowS
External instance of the constraint type Show AbiHash
External instance of the constraint type Show UnitId
External instance of the constraint type Ord Int
Show, Typeable)

instance Pretty AbiDependency where
    pretty :: AbiDependency -> Doc
pretty (AbiDependency UnitId
uid AbiHash
abi) =
        UnitId -> Doc
forall a. Pretty a => a -> Doc
External instance of the constraint type Pretty UnitId
pretty UnitId
uid Doc -> Doc -> Doc
<<>> Char -> Doc
Disp.char Char
'=' Doc -> Doc -> Doc
<<>> AbiHash -> Doc
forall a. Pretty a => a -> Doc
External instance of the constraint type Pretty AbiHash
pretty AbiHash
abi

instance  Parsec AbiDependency where
    parsec :: m AbiDependency
parsec = do
        UnitId
uid <- m UnitId
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
Evidence bound by a type signature of the constraint type CabalParsing m
External instance of the constraint type Parsec UnitId
parsec
        Char
_ <- Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
P.char Char
'='
        AbiHash
abi <- m AbiHash
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
Evidence bound by a type signature of the constraint type CabalParsing m
External instance of the constraint type Parsec AbiHash
parsec
        AbiDependency -> m AbiDependency
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => MonadPlus m
Evidence bound by a type signature of the constraint type CabalParsing m
return (UnitId -> AbiHash -> AbiDependency
AbiDependency UnitId
uid AbiHash
abi)

instance Binary AbiDependency
instance Structured AbiDependency
instance NFData AbiDependency where rnf :: AbiDependency -> ()
rnf = AbiDependency -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
External instance of the constraint type forall (a :: * -> *) i (c :: Meta). GNFData a => GNFData (M1 i c a)
External instance of the constraint type forall (a :: * -> *) i (c :: Meta). GNFData a => GNFData (M1 i c a)
External instance of the constraint type forall (a :: * -> *) (b :: * -> *).
(GNFData a, GNFData b) =>
GNFData (a :*: b)
External instance of the constraint type forall (a :: * -> *) i (c :: Meta). GNFData a => GNFData (M1 i c a)
External instance of the constraint type forall a i. NFData a => GNFData (K1 i a)
External instance of the constraint type NFData UnitId
External instance of the constraint type forall (a :: * -> *) i (c :: Meta). GNFData a => GNFData (M1 i c a)
External instance of the constraint type forall a i. NFData a => GNFData (K1 i a)
External instance of the constraint type NFData AbiHash
Instance of class: Generic of the constraint type Generic AbiDependency
genericRnf