{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE RankNTypes #-}
module Distribution.Backpack
(
OpenUnitId (..)
, openUnitIdFreeHoles
, mkOpenUnitId
, DefUnitId
, unDefUnitId
, mkDefUnitId
, OpenModule (..)
, openModuleFreeHoles
, OpenModuleSubst
, dispOpenModuleSubst
, dispOpenModuleSubstEntry
, parsecOpenModuleSubst
, parsecOpenModuleSubstEntry
, openModuleSubstFreeHoles
, abstractUnitId
, hashModuleSubst
) where
import Distribution.Compat.Prelude hiding (mod)
import Distribution.Parsec
import Distribution.Pretty
import Text.PrettyPrint (hcat)
import Prelude ()
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
data OpenUnitId
=
IndefFullUnitId ComponentId OpenModuleSubst
|
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
$cfrom :: forall x. OpenUnitId -> Rep OpenUnitId x
from :: forall x. OpenUnitId -> Rep OpenUnitId x
$cto :: forall x. Rep OpenUnitId x -> OpenUnitId
to :: forall x. Rep OpenUnitId x -> OpenUnitId
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
$creadsPrec :: Int -> ReadS OpenUnitId
readsPrec :: Int -> ReadS OpenUnitId
$creadList :: ReadS [OpenUnitId]
readList :: ReadS [OpenUnitId]
$creadPrec :: ReadPrec OpenUnitId
readPrec :: ReadPrec OpenUnitId
$creadListPrec :: ReadPrec [OpenUnitId]
readListPrec :: ReadPrec [OpenUnitId]
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
$cshowsPrec :: Int -> OpenUnitId -> ShowS
showsPrec :: Int -> OpenUnitId -> ShowS
$cshow :: OpenUnitId -> String
show :: OpenUnitId -> String
$cshowList :: [OpenUnitId] -> ShowS
showList :: [OpenUnitId] -> ShowS
Show, OpenUnitId -> OpenUnitId -> Bool
(OpenUnitId -> OpenUnitId -> Bool)
-> (OpenUnitId -> OpenUnitId -> Bool) -> Eq OpenUnitId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OpenUnitId -> OpenUnitId -> Bool
== :: OpenUnitId -> OpenUnitId -> Bool
$c/= :: OpenUnitId -> OpenUnitId -> Bool
/= :: OpenUnitId -> OpenUnitId -> Bool
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
$ccompare :: OpenUnitId -> OpenUnitId -> Ordering
compare :: OpenUnitId -> OpenUnitId -> Ordering
$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
>= :: OpenUnitId -> OpenUnitId -> Bool
$cmax :: OpenUnitId -> OpenUnitId -> OpenUnitId
max :: OpenUnitId -> OpenUnitId -> OpenUnitId
$cmin :: OpenUnitId -> OpenUnitId -> OpenUnitId
min :: OpenUnitId -> OpenUnitId -> OpenUnitId
Ord, Typeable, Typeable OpenUnitId
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 -> Constr
OpenUnitId -> DataType
(forall b. Data b => b -> b) -> OpenUnitId -> 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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OpenUnitId -> c OpenUnitId
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OpenUnitId -> c OpenUnitId
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OpenUnitId
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OpenUnitId
$ctoConstr :: OpenUnitId -> Constr
toConstr :: OpenUnitId -> Constr
$cdataTypeOf :: OpenUnitId -> DataType
dataTypeOf :: OpenUnitId -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OpenUnitId)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OpenUnitId)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OpenUnitId)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OpenUnitId)
$cgmapT :: (forall b. Data b => b -> b) -> OpenUnitId -> OpenUnitId
gmapT :: (forall b. Data b => b -> b) -> OpenUnitId -> OpenUnitId
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OpenUnitId -> r
gmapQl :: forall r r'.
(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
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OpenUnitId -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> OpenUnitId -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> OpenUnitId -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> OpenUnitId -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> OpenUnitId -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OpenUnitId -> m OpenUnitId
gmapM :: forall (m :: * -> *).
Monad m =>
(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
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(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
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OpenUnitId -> m OpenUnitId
Data)
instance Binary OpenUnitId
instance Structured OpenUnitId
instance NFData OpenUnitId where
rnf :: OpenUnitId -> ()
rnf (IndefFullUnitId ComponentId
cid OpenModuleSubst
subst) = ComponentId -> ()
forall a. NFData a => a -> ()
rnf ComponentId
cid () -> () -> ()
forall a b. a -> b -> b
`seq` OpenModuleSubst -> ()
forall a. NFData a => a -> ()
rnf OpenModuleSubst
subst
rnf (DefiniteUnitId DefUnitId
uid) = DefUnitId -> ()
forall a. NFData a => a -> ()
rnf DefUnitId
uid
instance Pretty OpenUnitId where
pretty :: OpenUnitId -> Doc
pretty (IndefFullUnitId ComponentId
cid OpenModuleSubst
insts)
| OpenModuleSubst -> Bool
forall k a. Map k a -> Bool
Map.null OpenModuleSubst
insts = ComponentId -> Doc
forall a. Pretty a => a -> Doc
pretty ComponentId
cid
| Bool
otherwise = ComponentId -> Doc
forall a. Pretty a => a -> Doc
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
pretty DefUnitId
uid
instance Parsec OpenUnitId where
parsec :: forall (m :: * -> *). CabalParsing m => m OpenUnitId
parsec = m OpenUnitId -> m OpenUnitId
forall a. m a -> m a
forall (m :: * -> *) a. Parsing m => m a -> m a
P.try m OpenUnitId
parseOpenUnitId m OpenUnitId -> m OpenUnitId -> m OpenUnitId
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (DefUnitId -> OpenUnitId) -> m DefUnitId -> m OpenUnitId
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DefUnitId -> OpenUnitId
DefiniteUnitId m DefUnitId
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m DefUnitId
parsec
where
parseOpenUnitId :: m OpenUnitId
parseOpenUnitId = do
cid <- m ComponentId
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m ComponentId
parsec
insts <-
P.between
(P.char '[')
(P.char ']')
parsecOpenModuleSubst
return (IndefFullUnitId cid insts)
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
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)
else ComponentId -> OpenModuleSubst -> OpenUnitId
IndefFullUnitId ComponentId
cid OpenModuleSubst
insts
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))
)
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
$cfrom :: forall x. OpenModule -> Rep OpenModule x
from :: forall x. OpenModule -> Rep OpenModule x
$cto :: forall x. Rep OpenModule x -> OpenModule
to :: forall x. Rep OpenModule x -> OpenModule
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
$creadsPrec :: Int -> ReadS OpenModule
readsPrec :: Int -> ReadS OpenModule
$creadList :: ReadS [OpenModule]
readList :: ReadS [OpenModule]
$creadPrec :: ReadPrec OpenModule
readPrec :: ReadPrec OpenModule
$creadListPrec :: ReadPrec [OpenModule]
readListPrec :: ReadPrec [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
$cshowsPrec :: Int -> OpenModule -> ShowS
showsPrec :: Int -> OpenModule -> ShowS
$cshow :: OpenModule -> String
show :: OpenModule -> String
$cshowList :: [OpenModule] -> ShowS
showList :: [OpenModule] -> ShowS
Show, OpenModule -> OpenModule -> Bool
(OpenModule -> OpenModule -> Bool)
-> (OpenModule -> OpenModule -> Bool) -> Eq OpenModule
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OpenModule -> OpenModule -> Bool
== :: OpenModule -> OpenModule -> Bool
$c/= :: OpenModule -> OpenModule -> Bool
/= :: OpenModule -> OpenModule -> Bool
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
$ccompare :: OpenModule -> OpenModule -> Ordering
compare :: OpenModule -> OpenModule -> Ordering
$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
>= :: OpenModule -> OpenModule -> Bool
$cmax :: OpenModule -> OpenModule -> OpenModule
max :: OpenModule -> OpenModule -> OpenModule
$cmin :: OpenModule -> OpenModule -> OpenModule
min :: OpenModule -> OpenModule -> OpenModule
Ord, Typeable, Typeable OpenModule
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 -> Constr
OpenModule -> DataType
(forall b. Data b => b -> b) -> OpenModule -> 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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OpenModule -> c OpenModule
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OpenModule -> c OpenModule
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OpenModule
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OpenModule
$ctoConstr :: OpenModule -> Constr
toConstr :: OpenModule -> Constr
$cdataTypeOf :: OpenModule -> DataType
dataTypeOf :: OpenModule -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OpenModule)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OpenModule)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OpenModule)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OpenModule)
$cgmapT :: (forall b. Data b => b -> b) -> OpenModule -> OpenModule
gmapT :: (forall b. Data b => b -> b) -> OpenModule -> OpenModule
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OpenModule -> r
gmapQl :: forall r r'.
(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
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OpenModule -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> OpenModule -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> OpenModule -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> OpenModule -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> OpenModule -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OpenModule -> m OpenModule
gmapM :: forall (m :: * -> *).
Monad m =>
(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
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(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
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OpenModule -> m OpenModule
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 -> ()
rnf OpenUnitId
uid () -> () -> ()
forall a b. a -> b -> b
`seq` ModuleName -> ()
forall a. NFData a => a -> ()
rnf ModuleName
mod_name
rnf (OpenModuleVar ModuleName
mod_name) = ModuleName -> ()
forall a. NFData a => a -> ()
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
pretty OpenUnitId
uid, String -> Doc
Disp.text String
":", ModuleName -> Doc
forall a. Pretty a => a -> Doc
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
pretty ModuleName
mod_name, Char -> Doc
Disp.char Char
'>']
instance Parsec OpenModule where
parsec :: forall (m :: * -> *). CabalParsing m => m OpenModule
parsec = m OpenModule
parsecModuleVar m OpenModule -> m OpenModule -> m OpenModule
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m OpenModule
parsecOpenModule
where
parsecOpenModule :: m OpenModule
parsecOpenModule = do
uid <- m OpenUnitId
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m OpenUnitId
parsec
_ <- P.char ':'
mod_name <- parsec
return (OpenModule uid mod_name)
parsecModuleVar :: m OpenModule
parsecModuleVar = do
_ <- Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'<'
mod_name <- parsec
_ <- P.char '>'
return (OpenModuleVar mod_name)
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
type OpenModuleSubst = Map ModuleName OpenModule
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)
dispOpenModuleSubstEntry :: (ModuleName, OpenModule) -> Disp.Doc
dispOpenModuleSubstEntry :: (ModuleName, OpenModule) -> Doc
dispOpenModuleSubstEntry (ModuleName
k, OpenModule
v) = ModuleName -> Doc
forall a. Pretty a => a -> Doc
pretty ModuleName
k Doc -> Doc -> Doc
<<>> Char -> Doc
Disp.char Char
'=' Doc -> Doc -> Doc
<<>> OpenModule -> Doc
forall a. Pretty a => a -> Doc
pretty OpenModule
v
parsecOpenModuleSubst :: CabalParsing m => m OpenModuleSubst
parsecOpenModuleSubst :: forall (m :: * -> *). CabalParsing m => m OpenModuleSubst
parsecOpenModuleSubst =
([(ModuleName, OpenModule)] -> OpenModuleSubst)
-> m [(ModuleName, OpenModule)] -> m OpenModuleSubst
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(ModuleName, OpenModule)] -> OpenModuleSubst
forall k a. Ord k => [(k, a)] -> Map k a
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]
P.sepBy (Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
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)
parsecOpenModuleSubstEntry
parsecOpenModuleSubstEntry :: CabalParsing m => m (ModuleName, OpenModule)
parsecOpenModuleSubstEntry :: forall (m :: * -> *). CabalParsing m => m (ModuleName, OpenModule)
parsecOpenModuleSubstEntry =
do
k <- m ModuleName
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m ModuleName
parsec
_ <- P.char '='
v <- parsec
return (k, v)
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
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))
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
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]
concat
[ ModuleName -> String
forall a. Pretty a => a -> String
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
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
]