{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleContexts #-}

module Distribution.Types.UnitId
  ( UnitId, unUnitId, mkUnitId
  , DefUnitId
  , unsafeMkDefUnitId
  , unDefUnitId
  , newSimpleUnitId
  , mkLegacyUnitId
  , getHSLibraryName
  ) where

import Prelude ()
import Distribution.Compat.Prelude
import Distribution.Utils.ShortText

import qualified Distribution.Compat.CharParsing as P
import Distribution.Pretty
import Distribution.Parsec
import Distribution.Types.ComponentId
import Distribution.Types.PackageId

import Text.PrettyPrint (text)

-- | A unit identifier identifies a (possibly instantiated)
-- package/component that can be installed the installed package
-- database.  There are several types of components that can be
-- installed:
--
--  * A traditional library with no holes, so that 'unitIdHash'
--    is @Nothing@.  In the absence of Backpack, 'UnitId'
--    is the same as a 'ComponentId'.
--
--  * An indefinite, Backpack library with holes.  In this case,
--    'unitIdHash' is still @Nothing@, but in the install,
--    there are only interfaces, no compiled objects.
--
--  * An instantiated Backpack library with all the holes
--    filled in.  'unitIdHash' is a @Just@ a hash of the
--    instantiating mapping.
--
-- A unit is a component plus the additional information on how the
-- holes are filled in. Thus there is a one to many relationship: for a
-- particular component there are many different ways of filling in the
-- holes, and each different combination is a unit (and has a separate
-- 'UnitId').
--
-- 'UnitId' is distinct from 'OpenUnitId', in that it is always
-- installed, whereas 'OpenUnitId' are intermediate unit identities
-- that arise during mixin linking, and don't necessarily correspond
-- to any actually installed unit.  Since the mapping is not actually
-- recorded in a 'UnitId', you can't actually substitute over them
-- (but you can substitute over 'OpenUnitId').  See also
-- "Distribution.Backpack.FullUnitId" for a mechanism for expanding an
-- instantiated 'UnitId' to retrieve its mapping.
--
-- Backwards compatibility note: if you need to get the string
-- representation of a UnitId to pass, e.g., as a @-package-id@
-- flag, use the 'display' function, which will work on all
-- versions of Cabal.
--
newtype UnitId = UnitId ShortText
  deriving ((forall x. UnitId -> Rep UnitId x)
-> (forall x. Rep UnitId x -> UnitId) -> Generic UnitId
forall x. Rep UnitId x -> UnitId
forall x. UnitId -> Rep UnitId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UnitId x -> UnitId
$cfrom :: forall x. UnitId -> Rep UnitId x
Generic, ReadPrec [UnitId]
ReadPrec UnitId
Int -> ReadS UnitId
ReadS [UnitId]
(Int -> ReadS UnitId)
-> ReadS [UnitId]
-> ReadPrec UnitId
-> ReadPrec [UnitId]
-> Read UnitId
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UnitId]
$creadListPrec :: ReadPrec [UnitId]
readPrec :: ReadPrec UnitId
$creadPrec :: ReadPrec UnitId
readList :: ReadS [UnitId]
$creadList :: ReadS [UnitId]
readsPrec :: Int -> ReadS UnitId
$creadsPrec :: Int -> ReadS UnitId
Read, Int -> UnitId -> ShowS
[UnitId] -> ShowS
UnitId -> String
(Int -> UnitId -> ShowS)
-> (UnitId -> String) -> ([UnitId] -> ShowS) -> Show UnitId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnitId] -> ShowS
$cshowList :: [UnitId] -> ShowS
show :: UnitId -> String
$cshow :: UnitId -> String
showsPrec :: Int -> UnitId -> ShowS
$cshowsPrec :: Int -> UnitId -> ShowS
Show, UnitId -> UnitId -> Bool
(UnitId -> UnitId -> Bool)
-> (UnitId -> UnitId -> Bool) -> Eq UnitId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnitId -> UnitId -> Bool
$c/= :: UnitId -> UnitId -> Bool
== :: UnitId -> UnitId -> Bool
$c== :: UnitId -> UnitId -> Bool
Eq, Eq UnitId
Eq UnitId
-> (UnitId -> UnitId -> Ordering)
-> (UnitId -> UnitId -> Bool)
-> (UnitId -> UnitId -> Bool)
-> (UnitId -> UnitId -> Bool)
-> (UnitId -> UnitId -> Bool)
-> (UnitId -> UnitId -> UnitId)
-> (UnitId -> UnitId -> UnitId)
-> Ord UnitId
UnitId -> UnitId -> Bool
UnitId -> UnitId -> Ordering
UnitId -> UnitId -> UnitId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: UnitId -> UnitId -> UnitId
$cmin :: UnitId -> UnitId -> UnitId
max :: UnitId -> UnitId -> UnitId
$cmax :: UnitId -> UnitId -> UnitId
>= :: UnitId -> UnitId -> Bool
$c>= :: UnitId -> UnitId -> Bool
> :: UnitId -> UnitId -> Bool
$c> :: UnitId -> UnitId -> Bool
<= :: UnitId -> UnitId -> Bool
$c<= :: UnitId -> UnitId -> Bool
< :: UnitId -> UnitId -> Bool
$c< :: UnitId -> UnitId -> Bool
compare :: UnitId -> UnitId -> Ordering
$ccompare :: UnitId -> UnitId -> Ordering
Ord, Typeable, Typeable UnitId
Typeable UnitId
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> UnitId -> c UnitId)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c UnitId)
-> (UnitId -> Constr)
-> (UnitId -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c UnitId))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UnitId))
-> ((forall b. Data b => b -> b) -> UnitId -> UnitId)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> UnitId -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> UnitId -> r)
-> (forall u. (forall d. Data d => d -> u) -> UnitId -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> UnitId -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> UnitId -> m UnitId)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> UnitId -> m UnitId)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> UnitId -> m UnitId)
-> Data UnitId
UnitId -> DataType
UnitId -> Constr
(forall b. Data b => b -> b) -> UnitId -> UnitId
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> UnitId -> u
forall u. (forall d. Data d => d -> u) -> UnitId -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UnitId -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UnitId -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UnitId -> m UnitId
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UnitId -> m UnitId
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UnitId
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UnitId -> c UnitId
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UnitId)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UnitId)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UnitId -> m UnitId
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UnitId -> m UnitId
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UnitId -> m UnitId
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UnitId -> m UnitId
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UnitId -> m UnitId
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UnitId -> m UnitId
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UnitId -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UnitId -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> UnitId -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> UnitId -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UnitId -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UnitId -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UnitId -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UnitId -> r
gmapT :: (forall b. Data b => b -> b) -> UnitId -> UnitId
$cgmapT :: (forall b. Data b => b -> b) -> UnitId -> UnitId
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UnitId)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UnitId)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UnitId)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UnitId)
dataTypeOf :: UnitId -> DataType
$cdataTypeOf :: UnitId -> DataType
toConstr :: UnitId -> Constr
$ctoConstr :: UnitId -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UnitId
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UnitId
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UnitId -> c UnitId
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UnitId -> c UnitId
Data, UnitId -> ()
(UnitId -> ()) -> NFData UnitId
forall a. (a -> ()) -> NFData a
rnf :: UnitId -> ()
$crnf :: UnitId -> ()
NFData)

instance Binary UnitId
instance Structured UnitId

-- | The textual format for 'UnitId' coincides with the format
-- GHC accepts for @-package-id@.
--
instance Pretty UnitId where
    pretty :: UnitId -> Doc
pretty = String -> Doc
text (String -> Doc) -> (UnitId -> String) -> UnitId -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnitId -> String
unUnitId

-- | The textual format for 'UnitId' coincides with the format
-- GHC accepts for @-package-id@.
--
instance Parsec UnitId where
    parsec :: forall (m :: * -> *). CabalParsing m => m UnitId
parsec = String -> UnitId
mkUnitId (String -> UnitId) -> m String -> m UnitId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> m String
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m String
P.munch1 Char -> Bool
isUnitChar where
        -- https://gitlab.haskell.org/ghc/ghc/issues/17752
        isUnitChar :: Char -> Bool
isUnitChar Char
'-' = Bool
True
        isUnitChar Char
'_' = Bool
True
        isUnitChar Char
'.' = Bool
True
        isUnitChar Char
'+' = Bool
True
        isUnitChar Char
c   = Char -> Bool
isAlphaNum Char
c

-- | If you need backwards compatibility, consider using 'display'
-- instead, which is supported by all versions of Cabal.
--
unUnitId :: UnitId -> String
unUnitId :: UnitId -> String
unUnitId (UnitId ShortText
s) = ShortText -> String
fromShortText ShortText
s

mkUnitId :: String -> UnitId
mkUnitId :: String -> UnitId
mkUnitId = ShortText -> UnitId
UnitId (ShortText -> UnitId) -> (String -> ShortText) -> String -> UnitId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShortText
toShortText

-- | 'mkUnitId'
--
-- @since 2.0.0.2
instance IsString UnitId where
    fromString :: String -> UnitId
fromString = String -> UnitId
mkUnitId

-- | Create a unit identity with no associated hash directly
-- from a 'ComponentId'.
newSimpleUnitId :: ComponentId -> UnitId
newSimpleUnitId :: ComponentId -> UnitId
newSimpleUnitId = String -> UnitId
mkUnitId (String -> UnitId)
-> (ComponentId -> String) -> ComponentId -> UnitId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ComponentId -> String
unComponentId

-- | Make an old-style UnitId from a package identifier.
-- Assumed to be for the public library
mkLegacyUnitId :: PackageId -> UnitId
mkLegacyUnitId :: PackageId -> UnitId
mkLegacyUnitId = ComponentId -> UnitId
newSimpleUnitId (ComponentId -> UnitId)
-> (PackageId -> ComponentId) -> PackageId -> UnitId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ComponentId
mkComponentId (String -> ComponentId)
-> (PackageId -> String) -> PackageId -> ComponentId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageId -> String
forall a. Pretty a => a -> String
prettyShow

-- | Returns library name prefixed with HS, suitable for filenames
getHSLibraryName :: UnitId -> String
getHSLibraryName :: UnitId -> String
getHSLibraryName UnitId
uid = String
"HS" String -> ShowS
forall a. [a] -> [a] -> [a]
++ UnitId -> String
forall a. Pretty a => a -> String
prettyShow UnitId
uid

-- | A 'UnitId' for a definite package.  The 'DefUnitId' invariant says
-- that a 'UnitId' identified this way is definite; i.e., it has no
-- unfilled holes.
newtype DefUnitId = DefUnitId { DefUnitId -> UnitId
unDefUnitId :: UnitId }
  deriving ((forall x. DefUnitId -> Rep DefUnitId x)
-> (forall x. Rep DefUnitId x -> DefUnitId) -> Generic DefUnitId
forall x. Rep DefUnitId x -> DefUnitId
forall x. DefUnitId -> Rep DefUnitId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DefUnitId x -> DefUnitId
$cfrom :: forall x. DefUnitId -> Rep DefUnitId x
Generic, ReadPrec [DefUnitId]
ReadPrec DefUnitId
Int -> ReadS DefUnitId
ReadS [DefUnitId]
(Int -> ReadS DefUnitId)
-> ReadS [DefUnitId]
-> ReadPrec DefUnitId
-> ReadPrec [DefUnitId]
-> Read DefUnitId
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DefUnitId]
$creadListPrec :: ReadPrec [DefUnitId]
readPrec :: ReadPrec DefUnitId
$creadPrec :: ReadPrec DefUnitId
readList :: ReadS [DefUnitId]
$creadList :: ReadS [DefUnitId]
readsPrec :: Int -> ReadS DefUnitId
$creadsPrec :: Int -> ReadS DefUnitId
Read, Int -> DefUnitId -> ShowS
[DefUnitId] -> ShowS
DefUnitId -> String
(Int -> DefUnitId -> ShowS)
-> (DefUnitId -> String)
-> ([DefUnitId] -> ShowS)
-> Show DefUnitId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DefUnitId] -> ShowS
$cshowList :: [DefUnitId] -> ShowS
show :: DefUnitId -> String
$cshow :: DefUnitId -> String
showsPrec :: Int -> DefUnitId -> ShowS
$cshowsPrec :: Int -> DefUnitId -> ShowS
Show, DefUnitId -> DefUnitId -> Bool
(DefUnitId -> DefUnitId -> Bool)
-> (DefUnitId -> DefUnitId -> Bool) -> Eq DefUnitId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DefUnitId -> DefUnitId -> Bool
$c/= :: DefUnitId -> DefUnitId -> Bool
== :: DefUnitId -> DefUnitId -> Bool
$c== :: DefUnitId -> DefUnitId -> Bool
Eq, Eq DefUnitId
Eq DefUnitId
-> (DefUnitId -> DefUnitId -> Ordering)
-> (DefUnitId -> DefUnitId -> Bool)
-> (DefUnitId -> DefUnitId -> Bool)
-> (DefUnitId -> DefUnitId -> Bool)
-> (DefUnitId -> DefUnitId -> Bool)
-> (DefUnitId -> DefUnitId -> DefUnitId)
-> (DefUnitId -> DefUnitId -> DefUnitId)
-> Ord DefUnitId
DefUnitId -> DefUnitId -> Bool
DefUnitId -> DefUnitId -> Ordering
DefUnitId -> DefUnitId -> DefUnitId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DefUnitId -> DefUnitId -> DefUnitId
$cmin :: DefUnitId -> DefUnitId -> DefUnitId
max :: DefUnitId -> DefUnitId -> DefUnitId
$cmax :: DefUnitId -> DefUnitId -> DefUnitId
>= :: DefUnitId -> DefUnitId -> Bool
$c>= :: DefUnitId -> DefUnitId -> Bool
> :: DefUnitId -> DefUnitId -> Bool
$c> :: DefUnitId -> DefUnitId -> Bool
<= :: DefUnitId -> DefUnitId -> Bool
$c<= :: DefUnitId -> DefUnitId -> Bool
< :: DefUnitId -> DefUnitId -> Bool
$c< :: DefUnitId -> DefUnitId -> Bool
compare :: DefUnitId -> DefUnitId -> Ordering
$ccompare :: DefUnitId -> DefUnitId -> Ordering
Ord, Typeable, Typeable DefUnitId
Typeable DefUnitId
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> DefUnitId -> c DefUnitId)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DefUnitId)
-> (DefUnitId -> Constr)
-> (DefUnitId -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DefUnitId))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DefUnitId))
-> ((forall b. Data b => b -> b) -> DefUnitId -> DefUnitId)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DefUnitId -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DefUnitId -> r)
-> (forall u. (forall d. Data d => d -> u) -> DefUnitId -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> DefUnitId -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> DefUnitId -> m DefUnitId)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DefUnitId -> m DefUnitId)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DefUnitId -> m DefUnitId)
-> Data DefUnitId
DefUnitId -> DataType
DefUnitId -> Constr
(forall b. Data b => b -> b) -> DefUnitId -> DefUnitId
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> DefUnitId -> u
forall u. (forall d. Data d => d -> u) -> DefUnitId -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DefUnitId -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DefUnitId -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DefUnitId -> m DefUnitId
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DefUnitId -> m DefUnitId
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DefUnitId
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DefUnitId -> c DefUnitId
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DefUnitId)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DefUnitId)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DefUnitId -> m DefUnitId
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DefUnitId -> m DefUnitId
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DefUnitId -> m DefUnitId
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DefUnitId -> m DefUnitId
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DefUnitId -> m DefUnitId
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DefUnitId -> m DefUnitId
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DefUnitId -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DefUnitId -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> DefUnitId -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DefUnitId -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DefUnitId -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DefUnitId -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DefUnitId -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DefUnitId -> r
gmapT :: (forall b. Data b => b -> b) -> DefUnitId -> DefUnitId
$cgmapT :: (forall b. Data b => b -> b) -> DefUnitId -> DefUnitId
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DefUnitId)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DefUnitId)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DefUnitId)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DefUnitId)
dataTypeOf :: DefUnitId -> DataType
$cdataTypeOf :: DefUnitId -> DataType
toConstr :: DefUnitId -> Constr
$ctoConstr :: DefUnitId -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DefUnitId
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DefUnitId
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DefUnitId -> c DefUnitId
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DefUnitId -> c DefUnitId
Data, Get DefUnitId
[DefUnitId] -> Put
DefUnitId -> Put
(DefUnitId -> Put)
-> Get DefUnitId -> ([DefUnitId] -> Put) -> Binary DefUnitId
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [DefUnitId] -> Put
$cputList :: [DefUnitId] -> Put
get :: Get DefUnitId
$cget :: Get DefUnitId
put :: DefUnitId -> Put
$cput :: DefUnitId -> Put
Binary, DefUnitId -> ()
(DefUnitId -> ()) -> NFData DefUnitId
forall a. (a -> ()) -> NFData a
rnf :: DefUnitId -> ()
$crnf :: DefUnitId -> ()
NFData, CabalSpecVersion -> DefUnitId -> Doc
DefUnitId -> Doc
(DefUnitId -> Doc)
-> (CabalSpecVersion -> DefUnitId -> Doc) -> Pretty DefUnitId
forall a. (a -> Doc) -> (CabalSpecVersion -> a -> Doc) -> Pretty a
prettyVersioned :: CabalSpecVersion -> DefUnitId -> Doc
$cprettyVersioned :: CabalSpecVersion -> DefUnitId -> Doc
pretty :: DefUnitId -> Doc
$cpretty :: DefUnitId -> Doc
Pretty)

instance Structured DefUnitId

-- Workaround for a GHC 8.0.1 bug, see
-- https://github.com/haskell/cabal/issues/4793#issuecomment-334258288
instance Parsec DefUnitId where
  parsec :: forall (m :: * -> *). CabalParsing m => m DefUnitId
parsec = UnitId -> DefUnitId
DefUnitId (UnitId -> DefUnitId) -> m UnitId -> m DefUnitId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m UnitId
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec

-- | Unsafely create a 'DefUnitId' from a 'UnitId'.  Your responsibility
-- is to ensure that the 'DefUnitId' invariant holds.
unsafeMkDefUnitId :: UnitId -> DefUnitId
unsafeMkDefUnitId :: UnitId -> DefUnitId
unsafeMkDefUnitId = UnitId -> DefUnitId
DefUnitId