{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DeriveFoldable #-}
-- | See <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst>
module Distribution.Backpack.ModuleScope (
    -- * Module scopes
    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


-----------------------------------------------------------------------
-- Module scopes

-- Why is ModuleProvides so complicated?  The basic problem is that
-- we want to support this:
--
--  package p where
--      include q (A)
--      include r (A)
--      module B where
--          import "q" A
--          import "r" A
--
-- Specifically, in Cabal today it is NOT an error have two modules in
-- scope with the same identifier.  So we need to preserve this for
-- Backpack.  The modification is that an ambiguous module name is
-- OK... as long as it is NOT used to fill a requirement!
--
-- So as a first try, we might try deferring unifying provisions that
-- are being glommed together, and check for equality after the fact.
-- But this doesn't work, because what if a multi-module provision
-- is used to fill a requirement?!  So you do the equality test
-- IMMEDIATELY before a requirement fill happens... or never at all.
--
-- Alternate strategy: go ahead and unify, and then if it is revealed
-- that some requirements got filled "out-of-thin-air", error.


-- | A 'ModuleScope' describes the modules and requirements that
-- are in-scope as we are processing a Cabal package.  Unlike
-- a 'ModuleShape', there may be multiple modules in scope at
-- the same 'ModuleName'; this is only an error if we attempt
-- to use those modules to fill a requirement.  A 'ModuleScope'
-- can influence the 'ModuleShape' via a reexport.
data ModuleScope = ModuleScope {
    ModuleScope -> ModuleProvides
modScopeProvides :: ModuleProvides,
    ModuleScope -> ModuleProvides
modScopeRequires :: ModuleRequires
    }

-- | An empty 'ModuleScope'.
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

-- | Every 'Module' in scope at a 'ModuleName' is annotated with
-- the 'PackageName' it comes from.
type ModuleProvides = Map ModuleName [ModuleWithSource]
-- | INVARIANT: entries for ModuleName m, have msrc_module is OpenModuleVar m
type ModuleRequires = Map ModuleName [ModuleWithSource]
-- TODO: consider newtping the two types above.

-- | Description of where a module participating in mixin linking came
-- from.
data ModuleSource
    = FromMixins         PackageName ComponentName IncludeRenaming
    | FromBuildDepends   PackageName ComponentName
    | FromExposedModules ModuleName
    | FromOtherModules   ModuleName
    | FromSignatures     ModuleName
-- We don't have line numbers, but if we did, we'd want to record that
-- too

-- TODO: Deduplicate this with Distribution.Backpack.UnifyM.ci_msg
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

-- Dependency
dispComponent :: PackageName -> ComponentName -> Doc
dispComponent :: PackageName -> ComponentName -> Doc
dispComponent PackageName
pn ComponentName
cn =
    -- NB: This syntax isn't quite the source syntax, but it
    -- should be clear enough.  To do source syntax, we'd
    -- need to know what the package we're linking is.
    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
        -- Case below shouldn't happen
        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)

-- | An 'OpenModule', annotated with where it came from in a Cabal file.
data WithSource a = WithSource ModuleSource a
    deriving (a -> WithSource b -> WithSource a
(a -> b) -> WithSource a -> WithSource b
(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
<$ :: a -> WithSource b -> WithSource a
$c<$ :: forall a b. a -> WithSource b -> WithSource a
fmap :: (a -> b) -> WithSource a -> WithSource b
$cfmap :: forall a b. (a -> b) -> WithSource a -> WithSource b
Functor, WithSource a -> Bool
(a -> m) -> WithSource a -> m
(a -> b -> b) -> b -> WithSource a -> b
(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
product :: WithSource a -> a
$cproduct :: forall a. Num a => WithSource a -> a
sum :: WithSource a -> a
$csum :: forall a. Num a => WithSource a -> a
minimum :: WithSource a -> a
$cminimum :: forall a. Ord a => WithSource a -> a
maximum :: WithSource a -> a
$cmaximum :: forall a. Ord a => WithSource a -> a
elem :: a -> WithSource a -> Bool
$celem :: forall a. Eq a => a -> WithSource a -> Bool
length :: WithSource a -> Int
$clength :: forall a. WithSource a -> Int
null :: WithSource a -> Bool
$cnull :: forall a. WithSource a -> Bool
toList :: WithSource a -> [a]
$ctoList :: forall a. WithSource a -> [a]
foldl1 :: (a -> a -> a) -> WithSource a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> WithSource a -> a
foldr1 :: (a -> a -> a) -> WithSource a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> WithSource a -> a
foldl' :: (b -> a -> b) -> b -> WithSource a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> WithSource a -> b
foldl :: (b -> a -> b) -> b -> WithSource a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> WithSource a -> b
foldr' :: (a -> b -> b) -> b -> WithSource a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> WithSource a -> b
foldr :: (a -> b -> b) -> b -> WithSource a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> WithSource a -> b
foldMap' :: (a -> m) -> WithSource a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> WithSource a -> m
foldMap :: (a -> m) -> WithSource a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> WithSource a -> m
fold :: WithSource m -> m
$cfold :: forall m. Monoid m => WithSource m -> m
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
(a -> f b) -> WithSource a -> f (WithSource b)
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)
sequence :: WithSource (m a) -> m (WithSource a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
WithSource (m a) -> m (WithSource a)
mapM :: (a -> m b) -> WithSource a -> m (WithSource b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> WithSource a -> m (WithSource b)
sequenceA :: WithSource (f a) -> f (WithSource a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
WithSource (f a) -> f (WithSource a)
traverse :: (a -> f b) -> WithSource a -> f (WithSource b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> WithSource a -> f (WithSource b)
$cp2Traversable :: Foldable WithSource
$cp1Traversable :: Functor WithSource
Traversable)
unWithSource :: WithSource a -> a
unWithSource :: WithSource a -> a
unWithSource (WithSource ModuleSource
_ a
x) = a
x
getSource :: WithSource a -> ModuleSource
getSource :: 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)