{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE PatternGuards              #-}
{-# LANGUAGE RankNTypes                 #-}

-- | This module defines the core data types for Backpack.  For more
-- details, see:
--
--  <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst>

module Distribution.Backpack (
    -- * OpenUnitId
    OpenUnitId(..),
    openUnitIdFreeHoles,
    mkOpenUnitId,

    -- * DefUnitId
    DefUnitId,
    unDefUnitId,
    mkDefUnitId,

    -- * OpenModule
    OpenModule(..),
    openModuleFreeHoles,

    -- * OpenModuleSubst
    OpenModuleSubst,
    dispOpenModuleSubst,
    dispOpenModuleSubstEntry,
    parsecOpenModuleSubst,
    parsecOpenModuleSubstEntry,
    openModuleSubstFreeHoles,

    -- * Conversions to 'UnitId'
    abstractUnitId,
    hashModuleSubst,
) where

import Distribution.Compat.Prelude hiding (mod)
import Distribution.Parsec
import Distribution.Pretty
import Prelude ()
import Text.PrettyPrint            (hcat)

import qualified Distribution.Compat.CharParsing as P
import qualified Text.PrettyPrint                as Disp

import Distribution.ModuleName
import Distribution.Types.ComponentId
import Distribution.Types.Module
import Distribution.Types.UnitId
import Distribution.Utils.Base62

import qualified Data.Map as Map
import qualified Data.Set as Set

-----------------------------------------------------------------------
-- OpenUnitId

-- | An 'OpenUnitId' describes a (possibly partially) instantiated
-- Backpack component, with a description of how the holes are filled
-- in.  Unlike 'OpenUnitId', the 'ModuleSubst' is kept in a structured
-- form that allows for substitution (which fills in holes.) This form
-- of unit cannot be installed. It must first be converted to a
-- 'UnitId'.
--
-- In the absence of Backpack, there are no holes to fill, so any such
-- component always has an empty module substitution; thus we can lossly
-- represent it as an 'OpenUnitId uid'.
--
-- For a source component using Backpack, however, there is more
-- structure as components may be parametrized over some signatures, and
-- these \"holes\" may be partially or wholly filled.
--
-- OpenUnitId plays an important role when we are mix-in linking,
-- and is recorded to the installed packaged database for indefinite
-- packages; however, for compiled packages that are fully instantiated,
-- we instantiate 'OpenUnitId' into 'UnitId'.
--
-- For more details see the Backpack spec
-- <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst>
--

data OpenUnitId
    -- | Identifies a component which may have some unfilled holes;
    -- specifying its 'ComponentId' and its 'OpenModuleSubst'.
    -- TODO: Invariant that 'OpenModuleSubst' is non-empty?
    -- See also the Text instance.
    = IndefFullUnitId ComponentId OpenModuleSubst
    -- | Identifies a fully instantiated component, which has
    -- been compiled and abbreviated as a hash.  The embedded 'UnitId'
    -- MUST NOT be for an indefinite component; an 'OpenUnitId'
    -- is guaranteed not to have any holes.
    | DefiniteUnitId DefUnitId
  deriving ((forall x. OpenUnitId -> Rep OpenUnitId x)
-> (forall x. Rep OpenUnitId x -> OpenUnitId) -> Generic OpenUnitId
forall x. Rep OpenUnitId x -> OpenUnitId
forall x. OpenUnitId -> Rep OpenUnitId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OpenUnitId x -> OpenUnitId
$cfrom :: forall x. OpenUnitId -> Rep OpenUnitId x
Generic, ReadPrec [OpenUnitId]
ReadPrec OpenUnitId
Int -> ReadS OpenUnitId
ReadS [OpenUnitId]
(Int -> ReadS OpenUnitId)
-> ReadS [OpenUnitId]
-> ReadPrec OpenUnitId
-> ReadPrec [OpenUnitId]
-> Read OpenUnitId
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [OpenUnitId]
$creadListPrec :: ReadPrec [OpenUnitId]
readPrec :: ReadPrec OpenUnitId
$creadPrec :: ReadPrec OpenUnitId
readList :: ReadS [OpenUnitId]
$creadList :: ReadS [OpenUnitId]
readsPrec :: Int -> ReadS OpenUnitId
$creadsPrec :: Int -> ReadS OpenUnitId
External instance of the constraint type Read ModuleName
External instance of the constraint type Read DefUnitId
Instance of class: Read of the constraint type Read OpenModule
External instance of the constraint type Read ModuleName
External instance of the constraint type forall k e. (Ord k, Read k, Read e) => Read (Map k e)
External instance of the constraint type Read ComponentId
External instance of the constraint type Monad ReadPrec
External instance of the constraint type Monad ReadPrec
External instance of the constraint type Ord ModuleName
Instance of class: Read of the constraint type Read OpenUnitId
Instance of class: Read of the constraint type Read OpenModule
Read, Int -> OpenUnitId -> ShowS
[OpenUnitId] -> ShowS
OpenUnitId -> String
(Int -> OpenUnitId -> ShowS)
-> (OpenUnitId -> String)
-> ([OpenUnitId] -> ShowS)
-> Show OpenUnitId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OpenUnitId] -> ShowS
$cshowList :: [OpenUnitId] -> ShowS
show :: OpenUnitId -> String
$cshow :: OpenUnitId -> String
showsPrec :: Int -> OpenUnitId -> ShowS
$cshowsPrec :: Int -> OpenUnitId -> ShowS
External instance of the constraint type Show ModuleName
External instance of the constraint type Show DefUnitId
Instance of class: Show of the constraint type Show OpenModule
External instance of the constraint type Show ModuleName
External instance of the constraint type forall k a. (Show k, Show a) => Show (Map k a)
External instance of the constraint type Show ComponentId
External instance of the constraint type Ord Int
External instance of the constraint type Ord Int
Instance of class: Show of the constraint type Show OpenModule
Show, OpenUnitId -> OpenUnitId -> Bool
(OpenUnitId -> OpenUnitId -> Bool)
-> (OpenUnitId -> OpenUnitId -> Bool) -> Eq OpenUnitId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OpenUnitId -> OpenUnitId -> Bool
$c/= :: OpenUnitId -> OpenUnitId -> Bool
== :: OpenUnitId -> OpenUnitId -> Bool
$c== :: OpenUnitId -> OpenUnitId -> Bool
External instance of the constraint type Eq ModuleName
External instance of the constraint type Eq DefUnitId
Instance of class: Eq of the constraint type Eq OpenModule
External instance of the constraint type Eq ModuleName
External instance of the constraint type forall k a. (Eq k, Eq a) => Eq (Map k a)
External instance of the constraint type Eq ComponentId
Instance of class: Eq of the constraint type Eq OpenModule
Eq, Eq OpenUnitId
Eq OpenUnitId
-> (OpenUnitId -> OpenUnitId -> Ordering)
-> (OpenUnitId -> OpenUnitId -> Bool)
-> (OpenUnitId -> OpenUnitId -> Bool)
-> (OpenUnitId -> OpenUnitId -> Bool)
-> (OpenUnitId -> OpenUnitId -> Bool)
-> (OpenUnitId -> OpenUnitId -> OpenUnitId)
-> (OpenUnitId -> OpenUnitId -> OpenUnitId)
-> Ord OpenUnitId
OpenUnitId -> OpenUnitId -> Bool
OpenUnitId -> OpenUnitId -> Ordering
OpenUnitId -> OpenUnitId -> OpenUnitId
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 :: OpenUnitId -> OpenUnitId -> OpenUnitId
$cmin :: OpenUnitId -> OpenUnitId -> OpenUnitId
max :: OpenUnitId -> OpenUnitId -> OpenUnitId
$cmax :: OpenUnitId -> OpenUnitId -> OpenUnitId
>= :: OpenUnitId -> OpenUnitId -> Bool
$c>= :: OpenUnitId -> OpenUnitId -> Bool
> :: OpenUnitId -> OpenUnitId -> Bool
$c> :: OpenUnitId -> OpenUnitId -> Bool
<= :: OpenUnitId -> OpenUnitId -> Bool
$c<= :: OpenUnitId -> OpenUnitId -> Bool
< :: OpenUnitId -> OpenUnitId -> Bool
$c< :: OpenUnitId -> OpenUnitId -> Bool
compare :: OpenUnitId -> OpenUnitId -> Ordering
$ccompare :: OpenUnitId -> OpenUnitId -> Ordering
Instance of class: Ord of the constraint type Ord OpenModule
External instance of the constraint type Ord DefUnitId
Instance of class: Ord of the constraint type Ord OpenModule
External instance of the constraint type forall k v. (Ord k, Ord v) => Ord (Map k v)
External instance of the constraint type Ord ComponentId
Instance of class: Eq of the constraint type Eq OpenUnitId
External instance of the constraint type Ord ModuleName
Instance of class: Ord of the constraint type Ord OpenUnitId
Instance of class: Eq of the constraint type Eq OpenUnitId
Instance of class: Ord of the constraint type Ord OpenModule
Ord, Typeable, Typeable OpenUnitId
DataType
Constr
Typeable OpenUnitId
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> OpenUnitId -> c OpenUnitId)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c OpenUnitId)
-> (OpenUnitId -> Constr)
-> (OpenUnitId -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c OpenUnitId))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c OpenUnitId))
-> ((forall b. Data b => b -> b) -> OpenUnitId -> OpenUnitId)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> OpenUnitId -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> OpenUnitId -> r)
-> (forall u. (forall d. Data d => d -> u) -> OpenUnitId -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> OpenUnitId -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> OpenUnitId -> m OpenUnitId)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> OpenUnitId -> m OpenUnitId)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> OpenUnitId -> m OpenUnitId)
-> Data OpenUnitId
OpenUnitId -> DataType
OpenUnitId -> Constr
(forall b. Data b => b -> b) -> OpenUnitId -> OpenUnitId
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OpenUnitId -> c OpenUnitId
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OpenUnitId
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) -> OpenUnitId -> u
forall u. (forall d. Data d => d -> u) -> OpenUnitId -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OpenUnitId -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OpenUnitId -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OpenUnitId -> m OpenUnitId
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OpenUnitId -> m OpenUnitId
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OpenUnitId
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OpenUnitId -> c OpenUnitId
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OpenUnitId)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OpenUnitId)
$cDefiniteUnitId :: Constr
$cIndefFullUnitId :: Constr
$tOpenUnitId :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> OpenUnitId -> m OpenUnitId
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OpenUnitId -> m OpenUnitId
gmapMp :: (forall d. Data d => d -> m d) -> OpenUnitId -> m OpenUnitId
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OpenUnitId -> m OpenUnitId
gmapM :: (forall d. Data d => d -> m d) -> OpenUnitId -> m OpenUnitId
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OpenUnitId -> m OpenUnitId
gmapQi :: Int -> (forall d. Data d => d -> u) -> OpenUnitId -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> OpenUnitId -> u
gmapQ :: (forall d. Data d => d -> u) -> OpenUnitId -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> OpenUnitId -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OpenUnitId -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OpenUnitId -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OpenUnitId -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OpenUnitId -> r
gmapT :: (forall b. Data b => b -> b) -> OpenUnitId -> OpenUnitId
$cgmapT :: (forall b. Data b => b -> b) -> OpenUnitId -> OpenUnitId
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OpenUnitId)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OpenUnitId)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c OpenUnitId)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OpenUnitId)
dataTypeOf :: OpenUnitId -> DataType
$cdataTypeOf :: OpenUnitId -> DataType
toConstr :: OpenUnitId -> Constr
$ctoConstr :: OpenUnitId -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OpenUnitId
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OpenUnitId
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OpenUnitId -> c OpenUnitId
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OpenUnitId -> c OpenUnitId
External instance of the constraint type Data ModuleName
Instance of class: Data of the constraint type Data OpenModule
External instance of the constraint type Data ModuleName
External instance of the constraint type Data DefUnitId
External instance of the constraint type Data ComponentId
Instance of class: Data of the constraint type Data OpenModule
External instance of the constraint type Data ModuleName
External instance of the constraint type forall k a. (Data k, Data a, Ord k) => Data (Map k a)
External instance of the constraint type Ord ModuleName
Instance of class: Data of the constraint type Data OpenModule
Data)
-- TODO: cache holes?

instance Binary OpenUnitId
instance Structured OpenUnitId 
instance NFData OpenUnitId where
    rnf :: OpenUnitId -> ()
rnf (IndefFullUnitId ComponentId
cid OpenModuleSubst
subst) = ComponentId -> ()
forall a. NFData a => a -> ()
External instance of the constraint type NFData ComponentId
rnf ComponentId
cid () -> () -> ()
`seq` OpenModuleSubst -> ()
forall a. NFData a => a -> ()
External instance of the constraint type forall k a. (NFData k, NFData a) => NFData (Map k a)
External instance of the constraint type NFData ModuleName
Instance of class: NFData of the constraint type NFData OpenModule
rnf OpenModuleSubst
subst
    rnf (DefiniteUnitId DefUnitId
uid) = DefUnitId -> ()
forall a. NFData a => a -> ()
External instance of the constraint type NFData DefUnitId
rnf DefUnitId
uid

instance Pretty OpenUnitId where
    pretty :: OpenUnitId -> Doc
pretty (IndefFullUnitId ComponentId
cid OpenModuleSubst
insts)
        -- TODO: arguably a smart constructor to enforce invariant would be
        -- better
        | OpenModuleSubst -> Bool
forall k a. Map k a -> Bool
Map.null OpenModuleSubst
insts = ComponentId -> Doc
forall a. Pretty a => a -> Doc
External instance of the constraint type Pretty ComponentId
pretty ComponentId
cid
        | Bool
otherwise      = ComponentId -> Doc
forall a. Pretty a => a -> Doc
External instance of the constraint type Pretty ComponentId
pretty ComponentId
cid Doc -> Doc -> Doc
<<>> Doc -> Doc
Disp.brackets (OpenModuleSubst -> Doc
dispOpenModuleSubst OpenModuleSubst
insts)
    pretty (DefiniteUnitId DefUnitId
uid) = DefUnitId -> Doc
forall a. Pretty a => a -> Doc
External instance of the constraint type Pretty DefUnitId
pretty DefUnitId
uid

-- |
--
-- >>> eitherParsec "foobar" :: Either String OpenUnitId
--Right (DefiniteUnitId (DefUnitId {unDefUnitId = UnitId "foobar"}))
--
-- >>> eitherParsec "foo[Str=text-1.2.3:Data.Text.Text]" :: Either String OpenUnitId
-- Right (IndefFullUnitId (ComponentId "foo") (fromList [(ModuleName ["Str"],OpenModule (DefiniteUnitId (DefUnitId {unDefUnitId = UnitId "text-1.2.3"})) (ModuleName ["Data","Text","Text"]))]))
--
instance Parsec OpenUnitId where
    parsec :: m OpenUnitId
parsec = m OpenUnitId -> m OpenUnitId
forall (m :: * -> *) a. Parsing m => m a -> m a
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
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.try m OpenUnitId
parseOpenUnitId m OpenUnitId -> m OpenUnitId -> m OpenUnitId
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
<|> (DefUnitId -> OpenUnitId) -> m DefUnitId -> m OpenUnitId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type forall (f :: * -> *). Applicative f => Functor f
External instance of the constraint type forall (f :: * -> *). Alternative f => Applicative f
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
fmap DefUnitId -> OpenUnitId
DefiniteUnitId m DefUnitId
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 DefUnitId
parsec
      where
        parseOpenUnitId :: m OpenUnitId
parseOpenUnitId = do
            ComponentId
cid <- m ComponentId
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 ComponentId
parsec
            OpenModuleSubst
insts <- m Char -> m Char -> m OpenModuleSubst -> m OpenModuleSubst
forall (m :: * -> *) bra ket a.
Applicative m =>
m bra -> m ket -> m a -> m a
External instance of the constraint type forall (f :: * -> *). Alternative f => Applicative f
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
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.between (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
'[') (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
']')
                       m OpenModuleSubst
forall (m :: * -> *). CabalParsing m => m OpenModuleSubst
Evidence bound by a type signature of the constraint type CabalParsing m
parsecOpenModuleSubst
            OpenUnitId -> m OpenUnitId
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 (ComponentId -> OpenModuleSubst -> OpenUnitId
IndefFullUnitId ComponentId
cid OpenModuleSubst
insts)

-- | Get the set of holes ('ModuleVar') embedded in a 'UnitId'.
openUnitIdFreeHoles :: OpenUnitId -> Set ModuleName
openUnitIdFreeHoles :: OpenUnitId -> Set ModuleName
openUnitIdFreeHoles (IndefFullUnitId ComponentId
_ OpenModuleSubst
insts) = OpenModuleSubst -> Set ModuleName
openModuleSubstFreeHoles OpenModuleSubst
insts
openUnitIdFreeHoles OpenUnitId
_ = Set ModuleName
forall a. Set a
Set.empty

-- | Safe constructor from a UnitId.  The only way to do this safely
-- is if the instantiation is provided.
mkOpenUnitId :: UnitId -> ComponentId -> OpenModuleSubst -> OpenUnitId
mkOpenUnitId :: UnitId -> ComponentId -> OpenModuleSubst -> OpenUnitId
mkOpenUnitId UnitId
uid ComponentId
cid OpenModuleSubst
insts =
    if Set ModuleName -> Bool
forall a. Set a -> Bool
Set.null (OpenModuleSubst -> Set ModuleName
openModuleSubstFreeHoles OpenModuleSubst
insts)
        then DefUnitId -> OpenUnitId
DefiniteUnitId (UnitId -> DefUnitId
unsafeMkDefUnitId UnitId
uid) -- invariant holds!
        else ComponentId -> OpenModuleSubst -> OpenUnitId
IndefFullUnitId ComponentId
cid OpenModuleSubst
insts

-----------------------------------------------------------------------
-- DefUnitId

-- | Create a 'DefUnitId' from a 'ComponentId' and an instantiation
-- with no holes.
mkDefUnitId :: ComponentId -> Map ModuleName Module -> DefUnitId
mkDefUnitId :: ComponentId -> Map ModuleName Module -> DefUnitId
mkDefUnitId ComponentId
cid Map ModuleName Module
insts =
    UnitId -> DefUnitId
unsafeMkDefUnitId (String -> UnitId
mkUnitId
        (ComponentId -> String
unComponentId ComponentId
cid String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> ShowS -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (String
"+"String -> ShowS
forall a. [a] -> [a] -> [a]
++) (Map ModuleName Module -> Maybe String
hashModuleSubst Map ModuleName Module
insts)))
        -- impose invariant!

-----------------------------------------------------------------------
-- OpenModule

-- | Unlike a 'Module', an 'OpenModule' is either an ordinary
-- module from some unit, OR an 'OpenModuleVar', representing a
-- hole that needs to be filled in.  Substitutions are over
-- module variables.
data OpenModule
    = OpenModule OpenUnitId ModuleName
    | OpenModuleVar ModuleName
  deriving ((forall x. OpenModule -> Rep OpenModule x)
-> (forall x. Rep OpenModule x -> OpenModule) -> Generic OpenModule
forall x. Rep OpenModule x -> OpenModule
forall x. OpenModule -> Rep OpenModule x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OpenModule x -> OpenModule
$cfrom :: forall x. OpenModule -> Rep OpenModule x
Generic, ReadPrec [OpenModule]
ReadPrec OpenModule
Int -> ReadS OpenModule
ReadS [OpenModule]
(Int -> ReadS OpenModule)
-> ReadS [OpenModule]
-> ReadPrec OpenModule
-> ReadPrec [OpenModule]
-> Read OpenModule
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [OpenModule]
$creadListPrec :: ReadPrec [OpenModule]
readPrec :: ReadPrec OpenModule
$creadPrec :: ReadPrec OpenModule
readList :: ReadS [OpenModule]
$creadList :: ReadS [OpenModule]
readsPrec :: Int -> ReadS OpenModule
$creadsPrec :: Int -> ReadS OpenModule
External instance of the constraint type Read ModuleName
External instance of the constraint type Monad ReadPrec
External instance of the constraint type Read ModuleName
External instance of the constraint type Monad ReadPrec
Instance of class: Read of the constraint type Read OpenUnitId
Instance of class: Read of the constraint type Read OpenModule
Read, Int -> OpenModule -> ShowS
[OpenModule] -> ShowS
OpenModule -> String
(Int -> OpenModule -> ShowS)
-> (OpenModule -> String)
-> ([OpenModule] -> ShowS)
-> Show OpenModule
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OpenModule] -> ShowS
$cshowList :: [OpenModule] -> ShowS
show :: OpenModule -> String
$cshow :: OpenModule -> String
showsPrec :: Int -> OpenModule -> ShowS
$cshowsPrec :: Int -> OpenModule -> ShowS
External instance of the constraint type Show ModuleName
External instance of the constraint type Ord Int
External instance of the constraint type Show ModuleName
External instance of the constraint type Ord Int
Instance of class: Show of the constraint type Show OpenUnitId
Show, OpenModule -> OpenModule -> Bool
(OpenModule -> OpenModule -> Bool)
-> (OpenModule -> OpenModule -> Bool) -> Eq OpenModule
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OpenModule -> OpenModule -> Bool
$c/= :: OpenModule -> OpenModule -> Bool
== :: OpenModule -> OpenModule -> Bool
$c== :: OpenModule -> OpenModule -> Bool
External instance of the constraint type Eq ModuleName
External instance of the constraint type Eq ModuleName
Instance of class: Eq of the constraint type Eq OpenUnitId
Eq, Eq OpenModule
Eq OpenModule
-> (OpenModule -> OpenModule -> Ordering)
-> (OpenModule -> OpenModule -> Bool)
-> (OpenModule -> OpenModule -> Bool)
-> (OpenModule -> OpenModule -> Bool)
-> (OpenModule -> OpenModule -> Bool)
-> (OpenModule -> OpenModule -> OpenModule)
-> (OpenModule -> OpenModule -> OpenModule)
-> Ord OpenModule
OpenModule -> OpenModule -> Bool
OpenModule -> OpenModule -> Ordering
OpenModule -> OpenModule -> OpenModule
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 :: OpenModule -> OpenModule -> OpenModule
$cmin :: OpenModule -> OpenModule -> OpenModule
max :: OpenModule -> OpenModule -> OpenModule
$cmax :: OpenModule -> OpenModule -> OpenModule
>= :: OpenModule -> OpenModule -> Bool
$c>= :: OpenModule -> OpenModule -> Bool
> :: OpenModule -> OpenModule -> Bool
$c> :: OpenModule -> OpenModule -> Bool
<= :: OpenModule -> OpenModule -> Bool
$c<= :: OpenModule -> OpenModule -> Bool
< :: OpenModule -> OpenModule -> Bool
$c< :: OpenModule -> OpenModule -> Bool
compare :: OpenModule -> OpenModule -> Ordering
$ccompare :: OpenModule -> OpenModule -> Ordering
Instance of class: Eq of the constraint type Eq OpenModule
External instance of the constraint type Ord ModuleName
Instance of class: Ord of the constraint type Ord OpenUnitId
Instance of class: Ord of the constraint type Ord OpenModule
Instance of class: Eq of the constraint type Eq OpenModule
Ord, Typeable, Typeable OpenModule
DataType
Constr
Typeable OpenModule
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> OpenModule -> c OpenModule)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c OpenModule)
-> (OpenModule -> Constr)
-> (OpenModule -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c OpenModule))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c OpenModule))
-> ((forall b. Data b => b -> b) -> OpenModule -> OpenModule)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> OpenModule -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> OpenModule -> r)
-> (forall u. (forall d. Data d => d -> u) -> OpenModule -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> OpenModule -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> OpenModule -> m OpenModule)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> OpenModule -> m OpenModule)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> OpenModule -> m OpenModule)
-> Data OpenModule
OpenModule -> DataType
OpenModule -> Constr
(forall b. Data b => b -> b) -> OpenModule -> OpenModule
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OpenModule -> c OpenModule
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OpenModule
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) -> OpenModule -> u
forall u. (forall d. Data d => d -> u) -> OpenModule -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OpenModule -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OpenModule -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OpenModule -> m OpenModule
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OpenModule -> m OpenModule
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OpenModule
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OpenModule -> c OpenModule
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OpenModule)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OpenModule)
$cOpenModuleVar :: Constr
$cOpenModule :: Constr
$tOpenModule :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> OpenModule -> m OpenModule
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OpenModule -> m OpenModule
gmapMp :: (forall d. Data d => d -> m d) -> OpenModule -> m OpenModule
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OpenModule -> m OpenModule
gmapM :: (forall d. Data d => d -> m d) -> OpenModule -> m OpenModule
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OpenModule -> m OpenModule
gmapQi :: Int -> (forall d. Data d => d -> u) -> OpenModule -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> OpenModule -> u
gmapQ :: (forall d. Data d => d -> u) -> OpenModule -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> OpenModule -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OpenModule -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OpenModule -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OpenModule -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OpenModule -> r
gmapT :: (forall b. Data b => b -> b) -> OpenModule -> OpenModule
$cgmapT :: (forall b. Data b => b -> b) -> OpenModule -> OpenModule
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OpenModule)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OpenModule)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c OpenModule)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OpenModule)
dataTypeOf :: OpenModule -> DataType
$cdataTypeOf :: OpenModule -> DataType
toConstr :: OpenModule -> Constr
$ctoConstr :: OpenModule -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OpenModule
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OpenModule
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OpenModule -> c OpenModule
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OpenModule -> c OpenModule
External instance of the constraint type Data ModuleName
External instance of the constraint type Data ModuleName
External instance of the constraint type Data ModuleName
Instance of class: Data of the constraint type Data OpenUnitId
Data)

instance Binary OpenModule
instance Structured OpenModule

instance NFData OpenModule where
    rnf :: OpenModule -> ()
rnf (OpenModule OpenUnitId
uid ModuleName
mod_name) = OpenUnitId -> ()
forall a. NFData a => a -> ()
Instance of class: NFData of the constraint type NFData OpenUnitId
rnf OpenUnitId
uid () -> () -> ()
`seq` ModuleName -> ()
forall a. NFData a => a -> ()
External instance of the constraint type NFData ModuleName
rnf ModuleName
mod_name
    rnf (OpenModuleVar ModuleName
mod_name) = ModuleName -> ()
forall a. NFData a => a -> ()
External instance of the constraint type NFData ModuleName
rnf ModuleName
mod_name

instance Pretty OpenModule where
    pretty :: OpenModule -> Doc
pretty (OpenModule OpenUnitId
uid ModuleName
mod_name) =
        [Doc] -> Doc
hcat [OpenUnitId -> Doc
forall a. Pretty a => a -> Doc
Instance of class: Pretty of the constraint type Pretty OpenUnitId
pretty OpenUnitId
uid, String -> Doc
Disp.text String
":", ModuleName -> Doc
forall a. Pretty a => a -> Doc
External instance of the constraint type Pretty ModuleName
pretty ModuleName
mod_name]
    pretty (OpenModuleVar ModuleName
mod_name) =
        [Doc] -> Doc
hcat [Char -> Doc
Disp.char Char
'<', ModuleName -> Doc
forall a. Pretty a => a -> Doc
External instance of the constraint type Pretty ModuleName
pretty ModuleName
mod_name, Char -> Doc
Disp.char Char
'>']

-- |
--
-- >>> eitherParsec "Includes2-0.1.0.0-inplace-mysql:Database.MySQL" :: Either String OpenModule
-- Right (OpenModule (DefiniteUnitId (DefUnitId {unDefUnitId = UnitId "Includes2-0.1.0.0-inplace-mysql"})) (ModuleName ["Database","MySQL"]))
--
instance Parsec OpenModule where
    parsec :: m OpenModule
parsec = m OpenModule
parsecModuleVar m OpenModule -> m OpenModule -> m OpenModule
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
<|> m OpenModule
parsecOpenModule
      where
        parsecOpenModule :: m OpenModule
parsecOpenModule = do
            OpenUnitId
uid <- m OpenUnitId
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
Evidence bound by a type signature of the constraint type CabalParsing m
Instance of class: Parsec of the constraint type Parsec OpenUnitId
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
':'
            ModuleName
mod_name <- m ModuleName
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 ModuleName
parsec
            OpenModule -> m OpenModule
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 (OpenUnitId -> ModuleName -> OpenModule
OpenModule OpenUnitId
uid ModuleName
mod_name)

        parsecModuleVar :: m OpenModule
parsecModuleVar = do
            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
'<'
            ModuleName
mod_name <- m ModuleName
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 ModuleName
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
'>'
            OpenModule -> m OpenModule
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 (ModuleName -> OpenModule
OpenModuleVar ModuleName
mod_name)

-- | Get the set of holes ('ModuleVar') embedded in a 'Module'.
openModuleFreeHoles :: OpenModule -> Set ModuleName
openModuleFreeHoles :: OpenModule -> Set ModuleName
openModuleFreeHoles (OpenModuleVar ModuleName
mod_name) = ModuleName -> Set ModuleName
forall a. a -> Set a
Set.singleton ModuleName
mod_name
openModuleFreeHoles (OpenModule OpenUnitId
uid ModuleName
_n) = OpenUnitId -> Set ModuleName
openUnitIdFreeHoles OpenUnitId
uid

-----------------------------------------------------------------------
-- OpenModuleSubst

-- | An explicit substitution on modules.
--
-- NB: These substitutions are NOT idempotent, for example, a
-- valid substitution is (A -> B, B -> A).
type OpenModuleSubst = Map ModuleName OpenModule

-- | Pretty-print the entries of a module substitution, suitable
-- for embedding into a 'OpenUnitId' or passing to GHC via @--instantiate-with@.
dispOpenModuleSubst :: OpenModuleSubst -> Disp.Doc
dispOpenModuleSubst :: OpenModuleSubst -> Doc
dispOpenModuleSubst OpenModuleSubst
subst
    = [Doc] -> Doc
Disp.hcat
    ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
Disp.punctuate Doc
Disp.comma
    ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ ((ModuleName, OpenModule) -> Doc)
-> [(ModuleName, OpenModule)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (ModuleName, OpenModule) -> Doc
dispOpenModuleSubstEntry (OpenModuleSubst -> [(ModuleName, OpenModule)]
forall k a. Map k a -> [(k, a)]
Map.toAscList OpenModuleSubst
subst)

-- | Pretty-print a single entry of a module substitution.
dispOpenModuleSubstEntry :: (ModuleName, OpenModule) -> Disp.Doc
dispOpenModuleSubstEntry :: (ModuleName, OpenModule) -> Doc
dispOpenModuleSubstEntry (ModuleName
k, OpenModule
v) = ModuleName -> Doc
forall a. Pretty a => a -> Doc
External instance of the constraint type Pretty ModuleName
pretty ModuleName
k Doc -> Doc -> Doc
<<>> Char -> Doc
Disp.char Char
'=' Doc -> Doc -> Doc
<<>> OpenModule -> Doc
forall a. Pretty a => a -> Doc
Instance of class: Pretty of the constraint type Pretty OpenModule
pretty OpenModule
v

-- | Inverse to 'dispModSubst'.
--
-- @since 2.2
parsecOpenModuleSubst :: CabalParsing m => m OpenModuleSubst
parsecOpenModuleSubst :: m OpenModuleSubst
parsecOpenModuleSubst = ([(ModuleName, OpenModule)] -> OpenModuleSubst)
-> m [(ModuleName, OpenModule)] -> m OpenModuleSubst
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type forall (f :: * -> *). Applicative f => Functor f
External instance of the constraint type forall (f :: * -> *). Alternative f => Applicative f
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
fmap [(ModuleName, OpenModule)] -> OpenModuleSubst
forall k a. Ord k => [(k, a)] -> Map k a
External instance of the constraint type Ord ModuleName
Map.fromList
      (m [(ModuleName, OpenModule)] -> m OpenModuleSubst)
-> (m (ModuleName, OpenModule) -> m [(ModuleName, OpenModule)])
-> m (ModuleName, OpenModule)
-> m OpenModuleSubst
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (m (ModuleName, OpenModule)
 -> m Char -> m [(ModuleName, OpenModule)])
-> m Char
-> m (ModuleName, OpenModule)
-> m [(ModuleName, OpenModule)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip m (ModuleName, OpenModule)
-> m Char -> m [(ModuleName, OpenModule)]
forall (m :: * -> *) a sep. Alternative m => m a -> m sep -> m [a]
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
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.sepBy (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
',')
      (m (ModuleName, OpenModule) -> m OpenModuleSubst)
-> m (ModuleName, OpenModule) -> m OpenModuleSubst
forall a b. (a -> b) -> a -> b
$ m (ModuleName, OpenModule)
forall (m :: * -> *). CabalParsing m => m (ModuleName, OpenModule)
Evidence bound by a type signature of the constraint type CabalParsing m
parsecOpenModuleSubstEntry

-- | Inverse to 'dispModSubstEntry'.
--
-- @since 2.2
parsecOpenModuleSubstEntry :: CabalParsing m => m (ModuleName, OpenModule)
parsecOpenModuleSubstEntry :: m (ModuleName, OpenModule)
parsecOpenModuleSubstEntry =
    do ModuleName
k <- m ModuleName
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 ModuleName
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
'='
       OpenModule
v <- m OpenModule
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
Evidence bound by a type signature of the constraint type CabalParsing m
Instance of class: Parsec of the constraint type Parsec OpenModule
parsec
       (ModuleName, OpenModule) -> m (ModuleName, OpenModule)
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 (ModuleName
k, OpenModule
v)

-- | Get the set of holes ('ModuleVar') embedded in a 'OpenModuleSubst'.
-- This is NOT the domain of the substitution.
openModuleSubstFreeHoles :: OpenModuleSubst -> Set ModuleName
openModuleSubstFreeHoles :: OpenModuleSubst -> Set ModuleName
openModuleSubstFreeHoles OpenModuleSubst
insts = [Set ModuleName] -> Set ModuleName
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
External instance of the constraint type Ord ModuleName
External instance of the constraint type Foldable []
Set.unions ((OpenModule -> Set ModuleName) -> [OpenModule] -> [Set ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map OpenModule -> Set ModuleName
openModuleFreeHoles (OpenModuleSubst -> [OpenModule]
forall k a. Map k a -> [a]
Map.elems OpenModuleSubst
insts))

-----------------------------------------------------------------------
-- Conversions to UnitId

-- | When typechecking, we don't demand that a freshly instantiated
-- 'IndefFullUnitId' be compiled; instead, we just depend on the
-- installed indefinite unit installed at the 'ComponentId'.
abstractUnitId :: OpenUnitId -> UnitId
abstractUnitId :: OpenUnitId -> UnitId
abstractUnitId (DefiniteUnitId DefUnitId
def_uid) = DefUnitId -> UnitId
unDefUnitId DefUnitId
def_uid
abstractUnitId (IndefFullUnitId ComponentId
cid OpenModuleSubst
_) = ComponentId -> UnitId
newSimpleUnitId ComponentId
cid

-- | Take a module substitution and hash it into a string suitable for
-- 'UnitId'.  Note that since this takes 'Module', not 'OpenModule',
-- you are responsible for recursively converting 'OpenModule'
-- into 'Module'.  See also "Distribution.Backpack.ReadyComponent".
hashModuleSubst :: Map ModuleName Module -> Maybe String
hashModuleSubst :: Map ModuleName Module -> Maybe String
hashModuleSubst Map ModuleName Module
subst
  | Map ModuleName Module -> Bool
forall k a. Map k a -> Bool
Map.null Map ModuleName Module
subst = Maybe String
forall a. Maybe a
Nothing
  | Bool
otherwise =
      String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> ShowS -> String -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
hashToBase62 (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$
        [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
External instance of the constraint type Foldable []
concat [ ModuleName -> String
forall a. Pretty a => a -> String
External instance of the constraint type Pretty ModuleName
prettyShow ModuleName
mod_name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Module -> String
forall a. Pretty a => a -> String
External instance of the constraint type Pretty Module
prettyShow Module
m String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
               | (ModuleName
mod_name, Module
m) <- Map ModuleName Module -> [(ModuleName, Module)]
forall k a. Map k a -> [(k, a)]
Map.toList Map ModuleName Module
subst]