{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DeriveFoldable #-}
module Distribution.Backpack.ModuleScope (
ModuleScope(..),
ModuleProvides,
ModuleRequires,
ModuleSource(..),
dispModuleSource,
WithSource(..),
unWithSource,
getSource,
ModuleWithSource,
emptyModuleScope,
) where
import Prelude ()
import Distribution.Compat.Prelude
import Distribution.ModuleName
import Distribution.Types.IncludeRenaming
import Distribution.Types.PackageName
import Distribution.Types.ComponentName
import Distribution.Types.LibraryName
import Distribution.Pretty
import Distribution.Backpack
import Distribution.Backpack.ModSubst
import qualified Data.Map as Map
import Text.PrettyPrint
data ModuleScope = ModuleScope {
ModuleScope -> ModuleProvides
modScopeProvides :: ModuleProvides,
ModuleScope -> ModuleProvides
modScopeRequires :: ModuleRequires
}
emptyModuleScope :: ModuleScope
emptyModuleScope :: ModuleScope
emptyModuleScope = ModuleProvides -> ModuleProvides -> ModuleScope
ModuleScope ModuleProvides
forall k a. Map k a
Map.empty ModuleProvides
forall k a. Map k a
Map.empty
type ModuleProvides = Map ModuleName [ModuleWithSource]
type ModuleRequires = Map ModuleName [ModuleWithSource]
data ModuleSource
= FromMixins PackageName ComponentName IncludeRenaming
| FromBuildDepends PackageName ComponentName
| FromExposedModules ModuleName
| FromOtherModules ModuleName
| FromSignatures ModuleName
dispModuleSource :: ModuleSource -> Doc
dispModuleSource :: ModuleSource -> Doc
dispModuleSource (FromMixins PackageName
pn ComponentName
cn IncludeRenaming
incls)
= String -> Doc
text String
"mixins:" Doc -> Doc -> Doc
<+> PackageName -> ComponentName -> Doc
dispComponent PackageName
pn ComponentName
cn Doc -> Doc -> Doc
<+> IncludeRenaming -> Doc
forall a. Pretty a => a -> Doc
pretty IncludeRenaming
incls
dispModuleSource (FromBuildDepends PackageName
pn ComponentName
cn)
= String -> Doc
text String
"build-depends:" Doc -> Doc -> Doc
<+> PackageName -> ComponentName -> Doc
dispComponent PackageName
pn ComponentName
cn
dispModuleSource (FromExposedModules ModuleName
m)
= String -> Doc
text String
"exposed-modules:" Doc -> Doc -> Doc
<+> ModuleName -> Doc
forall a. Pretty a => a -> Doc
pretty ModuleName
m
dispModuleSource (FromOtherModules ModuleName
m)
= String -> Doc
text String
"other-modules:" Doc -> Doc -> Doc
<+> ModuleName -> Doc
forall a. Pretty a => a -> Doc
pretty ModuleName
m
dispModuleSource (FromSignatures ModuleName
m)
= String -> Doc
text String
"signatures:" Doc -> Doc -> Doc
<+> ModuleName -> Doc
forall a. Pretty a => a -> Doc
pretty ModuleName
m
dispComponent :: PackageName -> ComponentName -> Doc
dispComponent :: PackageName -> ComponentName -> Doc
dispComponent PackageName
pn ComponentName
cn =
case ComponentName
cn of
CLibName LibraryName
LMainLibName -> PackageName -> Doc
forall a. Pretty a => a -> Doc
pretty PackageName
pn
CLibName (LSubLibName UnqualComponentName
ucn) -> PackageName -> Doc
forall a. Pretty a => a -> Doc
pretty PackageName
pn Doc -> Doc -> Doc
<<>> Doc
colon Doc -> Doc -> Doc
<<>> UnqualComponentName -> Doc
forall a. Pretty a => a -> Doc
pretty UnqualComponentName
ucn
ComponentName
_ -> PackageName -> Doc
forall a. Pretty a => a -> Doc
pretty PackageName
pn Doc -> Doc -> Doc
<+> Doc -> Doc
parens (ComponentName -> Doc
forall a. Pretty a => a -> Doc
pretty ComponentName
cn)
data WithSource a = WithSource ModuleSource a
deriving ((forall a b. (a -> b) -> WithSource a -> WithSource b)
-> (forall a b. a -> WithSource b -> WithSource a)
-> Functor WithSource
forall a b. a -> WithSource b -> WithSource a
forall a b. (a -> b) -> WithSource a -> WithSource b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> WithSource a -> WithSource b
fmap :: forall a b. (a -> b) -> WithSource a -> WithSource b
$c<$ :: forall a b. a -> WithSource b -> WithSource a
<$ :: forall a b. a -> WithSource b -> WithSource a
Functor, (forall m. Monoid m => WithSource m -> m)
-> (forall m a. Monoid m => (a -> m) -> WithSource a -> m)
-> (forall m a. Monoid m => (a -> m) -> WithSource a -> m)
-> (forall a b. (a -> b -> b) -> b -> WithSource a -> b)
-> (forall a b. (a -> b -> b) -> b -> WithSource a -> b)
-> (forall b a. (b -> a -> b) -> b -> WithSource a -> b)
-> (forall b a. (b -> a -> b) -> b -> WithSource a -> b)
-> (forall a. (a -> a -> a) -> WithSource a -> a)
-> (forall a. (a -> a -> a) -> WithSource a -> a)
-> (forall a. WithSource a -> [a])
-> (forall a. WithSource a -> Bool)
-> (forall a. WithSource a -> Int)
-> (forall a. Eq a => a -> WithSource a -> Bool)
-> (forall a. Ord a => WithSource a -> a)
-> (forall a. Ord a => WithSource a -> a)
-> (forall a. Num a => WithSource a -> a)
-> (forall a. Num a => WithSource a -> a)
-> Foldable WithSource
forall a. Eq a => a -> WithSource a -> Bool
forall a. Num a => WithSource a -> a
forall a. Ord a => WithSource a -> a
forall m. Monoid m => WithSource m -> m
forall a. WithSource a -> Bool
forall a. WithSource a -> Int
forall a. WithSource a -> [a]
forall a. (a -> a -> a) -> WithSource a -> a
forall m a. Monoid m => (a -> m) -> WithSource a -> m
forall b a. (b -> a -> b) -> b -> WithSource a -> b
forall a b. (a -> b -> b) -> b -> WithSource a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => WithSource m -> m
fold :: forall m. Monoid m => WithSource m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> WithSource a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> WithSource a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> WithSource a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> WithSource a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> WithSource a -> b
foldr :: forall a b. (a -> b -> b) -> b -> WithSource a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> WithSource a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> WithSource a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> WithSource a -> b
foldl :: forall b a. (b -> a -> b) -> b -> WithSource a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> WithSource a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> WithSource a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> WithSource a -> a
foldr1 :: forall a. (a -> a -> a) -> WithSource a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> WithSource a -> a
foldl1 :: forall a. (a -> a -> a) -> WithSource a -> a
$ctoList :: forall a. WithSource a -> [a]
toList :: forall a. WithSource a -> [a]
$cnull :: forall a. WithSource a -> Bool
null :: forall a. WithSource a -> Bool
$clength :: forall a. WithSource a -> Int
length :: forall a. WithSource a -> Int
$celem :: forall a. Eq a => a -> WithSource a -> Bool
elem :: forall a. Eq a => a -> WithSource a -> Bool
$cmaximum :: forall a. Ord a => WithSource a -> a
maximum :: forall a. Ord a => WithSource a -> a
$cminimum :: forall a. Ord a => WithSource a -> a
minimum :: forall a. Ord a => WithSource a -> a
$csum :: forall a. Num a => WithSource a -> a
sum :: forall a. Num a => WithSource a -> a
$cproduct :: forall a. Num a => WithSource a -> a
product :: forall a. Num a => WithSource a -> a
Foldable, Functor WithSource
Foldable WithSource
Functor WithSource
-> Foldable WithSource
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> WithSource a -> f (WithSource b))
-> (forall (f :: * -> *) a.
Applicative f =>
WithSource (f a) -> f (WithSource a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> WithSource a -> m (WithSource b))
-> (forall (m :: * -> *) a.
Monad m =>
WithSource (m a) -> m (WithSource a))
-> Traversable WithSource
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
WithSource (m a) -> m (WithSource a)
forall (f :: * -> *) a.
Applicative f =>
WithSource (f a) -> f (WithSource a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> WithSource a -> m (WithSource b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> WithSource a -> f (WithSource b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> WithSource a -> f (WithSource b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> WithSource a -> f (WithSource b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
WithSource (f a) -> f (WithSource a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
WithSource (f a) -> f (WithSource a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> WithSource a -> m (WithSource b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> WithSource a -> m (WithSource b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
WithSource (m a) -> m (WithSource a)
sequence :: forall (m :: * -> *) a.
Monad m =>
WithSource (m a) -> m (WithSource a)
Traversable)
unWithSource :: WithSource a -> a
unWithSource :: forall a. WithSource a -> a
unWithSource (WithSource ModuleSource
_ a
x) = a
x
getSource :: WithSource a -> ModuleSource
getSource :: forall a. WithSource a -> ModuleSource
getSource (WithSource ModuleSource
s a
_) = ModuleSource
s
type ModuleWithSource = WithSource OpenModule
instance ModSubst a => ModSubst (WithSource a) where
modSubst :: OpenModuleSubst -> WithSource a -> WithSource a
modSubst OpenModuleSubst
subst (WithSource ModuleSource
s a
m) = ModuleSource -> a -> WithSource a
forall a. ModuleSource -> a -> WithSource a
WithSource ModuleSource
s (OpenModuleSubst -> a -> a
forall a. ModSubst a => OpenModuleSubst -> a -> a
modSubst OpenModuleSubst
subst a
m)