{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveTraversable #-}

-- | 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 Distribution.Compat.Prelude
import Prelude ()

import Distribution.ModuleName
import Distribution.Pretty
import Distribution.Types.ComponentName
import Distribution.Types.IncludeRenaming
import Distribution.Types.LibraryName
import Distribution.Types.PackageName

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 ((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)