{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE RankNTypes         #-}

module Distribution.Types.ModuleRenaming (
    ModuleRenaming(..),
    interpModuleRenaming,
    defaultRenaming,
    isDefaultRenaming,
) where

import Distribution.CabalSpecVersion
import Distribution.Compat.Prelude hiding (empty)
import Prelude ()

import Distribution.ModuleName
import Distribution.Parsec
import Distribution.Pretty

import qualified Data.Map                   as Map
import qualified Data.Set                   as Set
import qualified Distribution.Compat.CharParsing as P
import           Text.PrettyPrint           (hsep, parens, punctuate, text, comma)

-- | Renaming applied to the modules provided by a package.
-- The boolean indicates whether or not to also include all of the
-- original names of modules.  Thus, @ModuleRenaming False []@ is
-- "don't expose any modules, and @ModuleRenaming True [("Data.Bool", "Bool")]@
-- is, "expose all modules, but also expose @Data.Bool@ as @Bool@".
-- If a renaming is omitted you get the 'DefaultRenaming'.
--
-- (NB: This is a list not a map so that we can preserve order.)
--
data ModuleRenaming
        -- | A module renaming/thinning; e.g., @(A as B, C as C)@
        -- brings @B@ and @C@ into scope.
        = ModuleRenaming [(ModuleName, ModuleName)]
        -- | The default renaming, bringing all exported modules
        -- into scope.
        | DefaultRenaming
        -- | Hiding renaming, e.g., @hiding (A, B)@, bringing all
        -- exported modules into scope except the hidden ones.
        | HidingRenaming [ModuleName]
    deriving (Int -> ModuleRenaming -> ShowS
[ModuleRenaming] -> ShowS
ModuleRenaming -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModuleRenaming] -> ShowS
$cshowList :: [ModuleRenaming] -> ShowS
show :: ModuleRenaming -> String
$cshow :: ModuleRenaming -> String
showsPrec :: Int -> ModuleRenaming -> ShowS
$cshowsPrec :: Int -> ModuleRenaming -> ShowS
Show, ReadPrec [ModuleRenaming]
ReadPrec ModuleRenaming
Int -> ReadS ModuleRenaming
ReadS [ModuleRenaming]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModuleRenaming]
$creadListPrec :: ReadPrec [ModuleRenaming]
readPrec :: ReadPrec ModuleRenaming
$creadPrec :: ReadPrec ModuleRenaming
readList :: ReadS [ModuleRenaming]
$creadList :: ReadS [ModuleRenaming]
readsPrec :: Int -> ReadS ModuleRenaming
$creadsPrec :: Int -> ReadS ModuleRenaming
Read, ModuleRenaming -> ModuleRenaming -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModuleRenaming -> ModuleRenaming -> Bool
$c/= :: ModuleRenaming -> ModuleRenaming -> Bool
== :: ModuleRenaming -> ModuleRenaming -> Bool
$c== :: ModuleRenaming -> ModuleRenaming -> Bool
Eq, Eq ModuleRenaming
ModuleRenaming -> ModuleRenaming -> Bool
ModuleRenaming -> ModuleRenaming -> Ordering
ModuleRenaming -> ModuleRenaming -> ModuleRenaming
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 :: ModuleRenaming -> ModuleRenaming -> ModuleRenaming
$cmin :: ModuleRenaming -> ModuleRenaming -> ModuleRenaming
max :: ModuleRenaming -> ModuleRenaming -> ModuleRenaming
$cmax :: ModuleRenaming -> ModuleRenaming -> ModuleRenaming
>= :: ModuleRenaming -> ModuleRenaming -> Bool
$c>= :: ModuleRenaming -> ModuleRenaming -> Bool
> :: ModuleRenaming -> ModuleRenaming -> Bool
$c> :: ModuleRenaming -> ModuleRenaming -> Bool
<= :: ModuleRenaming -> ModuleRenaming -> Bool
$c<= :: ModuleRenaming -> ModuleRenaming -> Bool
< :: ModuleRenaming -> ModuleRenaming -> Bool
$c< :: ModuleRenaming -> ModuleRenaming -> Bool
compare :: ModuleRenaming -> ModuleRenaming -> Ordering
$ccompare :: ModuleRenaming -> ModuleRenaming -> Ordering
Ord, Typeable, Typeable ModuleRenaming
ModuleRenaming -> DataType
ModuleRenaming -> Constr
(forall b. Data b => b -> b) -> ModuleRenaming -> ModuleRenaming
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) -> ModuleRenaming -> u
forall u. (forall d. Data d => d -> u) -> ModuleRenaming -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ModuleRenaming -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ModuleRenaming -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ModuleRenaming -> m ModuleRenaming
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ModuleRenaming -> m ModuleRenaming
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ModuleRenaming
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ModuleRenaming -> c ModuleRenaming
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ModuleRenaming)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ModuleRenaming)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ModuleRenaming -> m ModuleRenaming
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ModuleRenaming -> m ModuleRenaming
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ModuleRenaming -> m ModuleRenaming
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ModuleRenaming -> m ModuleRenaming
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ModuleRenaming -> m ModuleRenaming
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ModuleRenaming -> m ModuleRenaming
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ModuleRenaming -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ModuleRenaming -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> ModuleRenaming -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ModuleRenaming -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ModuleRenaming -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ModuleRenaming -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ModuleRenaming -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ModuleRenaming -> r
gmapT :: (forall b. Data b => b -> b) -> ModuleRenaming -> ModuleRenaming
$cgmapT :: (forall b. Data b => b -> b) -> ModuleRenaming -> ModuleRenaming
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ModuleRenaming)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ModuleRenaming)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ModuleRenaming)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ModuleRenaming)
dataTypeOf :: ModuleRenaming -> DataType
$cdataTypeOf :: ModuleRenaming -> DataType
toConstr :: ModuleRenaming -> Constr
$ctoConstr :: ModuleRenaming -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ModuleRenaming
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ModuleRenaming
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ModuleRenaming -> c ModuleRenaming
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ModuleRenaming -> c ModuleRenaming
Data, forall x. Rep ModuleRenaming x -> ModuleRenaming
forall x. ModuleRenaming -> Rep ModuleRenaming x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModuleRenaming x -> ModuleRenaming
$cfrom :: forall x. ModuleRenaming -> Rep ModuleRenaming x
Generic)

-- | Interpret a 'ModuleRenaming' as a partial map from 'ModuleName'
-- to 'ModuleName'.  For efficiency, you should partially apply it
-- with 'ModuleRenaming' and then reuse it.
interpModuleRenaming :: ModuleRenaming -> ModuleName -> Maybe ModuleName
interpModuleRenaming :: ModuleRenaming -> ModuleName -> Maybe ModuleName
interpModuleRenaming ModuleRenaming
DefaultRenaming = forall a. a -> Maybe a
Just
interpModuleRenaming (ModuleRenaming [(ModuleName, ModuleName)]
rns) =
    let m :: Map ModuleName ModuleName
m = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(ModuleName, ModuleName)]
rns
    in \ModuleName
k -> forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ModuleName
k Map ModuleName ModuleName
m
interpModuleRenaming (HidingRenaming [ModuleName]
hs) =
    let s :: Set ModuleName
s = forall a. Ord a => [a] -> Set a
Set.fromList [ModuleName]
hs
    in \ModuleName
k -> if ModuleName
k forall a. Ord a => a -> Set a -> Bool
`Set.member` Set ModuleName
s then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just ModuleName
k

-- | The default renaming, if something is specified in @build-depends@
-- only.
defaultRenaming :: ModuleRenaming
defaultRenaming :: ModuleRenaming
defaultRenaming = ModuleRenaming
DefaultRenaming

-- | Tests if its the default renaming; we can use a more compact syntax
-- in 'Distribution.Types.IncludeRenaming.IncludeRenaming' in this case.
isDefaultRenaming :: ModuleRenaming -> Bool
isDefaultRenaming :: ModuleRenaming -> Bool
isDefaultRenaming ModuleRenaming
DefaultRenaming = Bool
True
isDefaultRenaming ModuleRenaming
_ = Bool
False



instance Binary ModuleRenaming where
instance Structured ModuleRenaming where

instance NFData ModuleRenaming where rnf :: ModuleRenaming -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

-- NB: parentheses are mandatory, because later we may extend this syntax
-- to allow "hiding (A, B)" or other modifier words.
instance Pretty ModuleRenaming where
  pretty :: ModuleRenaming -> Doc
pretty ModuleRenaming
DefaultRenaming = forall a. Monoid a => a
mempty
  pretty (HidingRenaming [ModuleName]
hides)
        = String -> Doc
text String
"hiding" Doc -> Doc -> Doc
<+> Doc -> Doc
parens ([Doc] -> Doc
hsep (Doc -> [Doc] -> [Doc]
punctuate Doc
comma (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [ModuleName]
hides)))
  pretty (ModuleRenaming [(ModuleName, ModuleName)]
rns)
        = Doc -> Doc
parens forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
hsep forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
comma (forall a b. (a -> b) -> [a] -> [b]
map forall {a}. (Eq a, Pretty a) => (a, a) -> Doc
dispEntry [(ModuleName, ModuleName)]
rns)
    where dispEntry :: (a, a) -> Doc
dispEntry (a
orig, a
new)
            | a
orig forall a. Eq a => a -> a -> Bool
== a
new = forall a. Pretty a => a -> Doc
pretty a
orig
            | Bool
otherwise = forall a. Pretty a => a -> Doc
pretty a
orig Doc -> Doc -> Doc
<+> String -> Doc
text String
"as" Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
pretty a
new

instance Parsec ModuleRenaming where
    parsec :: forall (m :: * -> *). CabalParsing m => m ModuleRenaming
parsec = do
        CabalSpecVersion
csv <- forall (m :: * -> *). CabalParsing m => m CabalSpecVersion
askCabalSpecVersion
        if CabalSpecVersion
csv forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
CabalSpecV3_0
        then forall (m :: * -> *).
CabalParsing m =>
(forall a. m a -> m a) -> m ModuleName -> m ModuleRenaming
moduleRenamingParsec forall {m :: * -> *} {a}. (Monad m, CharParsing m) => m a -> m a
parensLax    forall (m :: * -> *) a. (CabalParsing m, Parsec a) => m a
lexemeParsec
        else forall (m :: * -> *).
CabalParsing m =>
(forall a. m a -> m a) -> m ModuleName -> m ModuleRenaming
moduleRenamingParsec forall {a}. m a -> m a
parensStrict forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
      where
        -- For cabal spec versions < 3.0 white spaces were not skipped
        -- after the '(' and ')' tokens in the mixin field. This
        -- parser checks the cabal file version and does the correct
        -- skipping of spaces.
        parensLax :: m a -> m a
parensLax    m a
p = forall (m :: * -> *) bra ket a.
Applicative m =>
m bra -> m ket -> m a -> m a
P.between (forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'(' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *). CharParsing m => m ()
P.spaces)   (forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
')' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *). CharParsing m => m ()
P.spaces)   m a
p
        parensStrict :: m a -> m a
parensStrict m a
p = forall (m :: * -> *) bra ket a.
Applicative m =>
m bra -> m ket -> m a -> m a
P.between (forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'(' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall {a}. m (Maybe a)
warnSpaces) (forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
')') m a
p

        warnSpaces :: m (Maybe a)
warnSpaces = forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional forall a b. (a -> b) -> a -> b
$
            forall (m :: * -> *). CharParsing m => m Char
P.space forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"space after parenthesis, use cabal-version: 3.0 or higher"

moduleRenamingParsec
    :: CabalParsing m
    => (forall a. m a -> m a)  -- ^ between parens
    -> m ModuleName            -- ^ module name parser
    -> m ModuleRenaming
moduleRenamingParsec :: forall (m :: * -> *).
CabalParsing m =>
(forall a. m a -> m a) -> m ModuleName -> m ModuleRenaming
moduleRenamingParsec forall a. m a -> m a
bp m ModuleName
mn =
    -- NB: try not necessary as the first token is obvious
    forall (m :: * -> *) a. Alternative m => [m a] -> m a
P.choice [ m ModuleRenaming
parseRename, m ModuleRenaming
parseHiding, forall (m :: * -> *) a. Monad m => a -> m a
return ModuleRenaming
DefaultRenaming ]
  where
    cma :: m ()
cma = forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
',' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *). CharParsing m => m ()
P.spaces
    parseRename :: m ModuleRenaming
parseRename = do
        [(ModuleName, ModuleName)]
rns <- forall a. m a -> m a
bp m [(ModuleName, ModuleName)]
parseList
        forall (m :: * -> *). CharParsing m => m ()
P.spaces
        forall (m :: * -> *) a. Monad m => a -> m a
return ([(ModuleName, ModuleName)] -> ModuleRenaming
ModuleRenaming [(ModuleName, ModuleName)]
rns)
    parseHiding :: m ModuleRenaming
parseHiding = do
        String
_ <- forall (m :: * -> *). CharParsing m => String -> m String
P.string String
"hiding"
        forall (m :: * -> *). CharParsing m => m ()
P.spaces -- space isn't strictly required as next is an open paren
        [ModuleName]
hides <- forall a. m a -> m a
bp (forall (m :: * -> *) a sep. Alternative m => m a -> m sep -> m [a]
P.sepBy m ModuleName
mn m ()
cma)
        forall (m :: * -> *) a. Monad m => a -> m a
return ([ModuleName] -> ModuleRenaming
HidingRenaming [ModuleName]
hides)
    parseList :: m [(ModuleName, ModuleName)]
parseList =
        forall (m :: * -> *) a sep. Alternative m => m a -> m sep -> m [a]
P.sepBy m (ModuleName, ModuleName)
parseEntry m ()
cma
    parseEntry :: m (ModuleName, ModuleName)
parseEntry = do
        ModuleName
orig <- forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
        forall (m :: * -> *). CharParsing m => m ()
P.spaces
        forall (m :: * -> *) a. Alternative m => a -> m a -> m a
P.option (ModuleName
orig, ModuleName
orig) forall a b. (a -> b) -> a -> b
$ do
            String
_ <- forall (m :: * -> *). CharParsing m => String -> m String
P.string String
"as"
            forall (m :: * -> *). CharParsing m => m ()
P.skipSpaces1 -- require space after "as"
            ModuleName
new <- forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
            forall (m :: * -> *). CharParsing m => m ()
P.spaces
            forall (m :: * -> *) a. Monad m => a -> m a
return (ModuleName
orig, ModuleName
new)