{-# 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 (comma, hsep, parens, punctuate, text)
data ModuleRenaming
=
ModuleRenaming [(ModuleName, ModuleName)]
|
DefaultRenaming
|
HidingRenaming [ModuleName]
deriving (Int -> ModuleRenaming -> ShowS
[ModuleRenaming] -> ShowS
ModuleRenaming -> String
(Int -> ModuleRenaming -> ShowS)
-> (ModuleRenaming -> String)
-> ([ModuleRenaming] -> ShowS)
-> Show ModuleRenaming
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ModuleRenaming -> ShowS
showsPrec :: Int -> ModuleRenaming -> ShowS
$cshow :: ModuleRenaming -> String
show :: ModuleRenaming -> String
$cshowList :: [ModuleRenaming] -> ShowS
showList :: [ModuleRenaming] -> ShowS
Show, ReadPrec [ModuleRenaming]
ReadPrec ModuleRenaming
Int -> ReadS ModuleRenaming
ReadS [ModuleRenaming]
(Int -> ReadS ModuleRenaming)
-> ReadS [ModuleRenaming]
-> ReadPrec ModuleRenaming
-> ReadPrec [ModuleRenaming]
-> Read ModuleRenaming
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ModuleRenaming
readsPrec :: Int -> ReadS ModuleRenaming
$creadList :: ReadS [ModuleRenaming]
readList :: ReadS [ModuleRenaming]
$creadPrec :: ReadPrec ModuleRenaming
readPrec :: ReadPrec ModuleRenaming
$creadListPrec :: ReadPrec [ModuleRenaming]
readListPrec :: ReadPrec [ModuleRenaming]
Read, ModuleRenaming -> ModuleRenaming -> Bool
(ModuleRenaming -> ModuleRenaming -> Bool)
-> (ModuleRenaming -> ModuleRenaming -> Bool) -> Eq ModuleRenaming
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ModuleRenaming -> ModuleRenaming -> Bool
== :: ModuleRenaming -> ModuleRenaming -> Bool
$c/= :: ModuleRenaming -> ModuleRenaming -> Bool
/= :: ModuleRenaming -> ModuleRenaming -> Bool
Eq, Eq ModuleRenaming
Eq ModuleRenaming =>
(ModuleRenaming -> ModuleRenaming -> Ordering)
-> (ModuleRenaming -> ModuleRenaming -> Bool)
-> (ModuleRenaming -> ModuleRenaming -> Bool)
-> (ModuleRenaming -> ModuleRenaming -> Bool)
-> (ModuleRenaming -> ModuleRenaming -> Bool)
-> (ModuleRenaming -> ModuleRenaming -> ModuleRenaming)
-> (ModuleRenaming -> ModuleRenaming -> ModuleRenaming)
-> Ord 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
$ccompare :: ModuleRenaming -> ModuleRenaming -> Ordering
compare :: ModuleRenaming -> ModuleRenaming -> Ordering
$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
>= :: ModuleRenaming -> ModuleRenaming -> Bool
$cmax :: ModuleRenaming -> ModuleRenaming -> ModuleRenaming
max :: ModuleRenaming -> ModuleRenaming -> ModuleRenaming
$cmin :: ModuleRenaming -> ModuleRenaming -> ModuleRenaming
min :: ModuleRenaming -> ModuleRenaming -> ModuleRenaming
Ord, Typeable, Typeable ModuleRenaming
Typeable ModuleRenaming =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ModuleRenaming -> c ModuleRenaming)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ModuleRenaming)
-> (ModuleRenaming -> Constr)
-> (ModuleRenaming -> DataType)
-> (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))
-> ((forall b. Data b => b -> b)
-> ModuleRenaming -> ModuleRenaming)
-> (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 u.
(forall d. Data d => d -> u) -> ModuleRenaming -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> ModuleRenaming -> u)
-> (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 (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ModuleRenaming -> m ModuleRenaming)
-> Data ModuleRenaming
ModuleRenaming -> Constr
ModuleRenaming -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ModuleRenaming -> c ModuleRenaming
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ModuleRenaming -> c ModuleRenaming
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ModuleRenaming
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ModuleRenaming
$ctoConstr :: ModuleRenaming -> Constr
toConstr :: ModuleRenaming -> Constr
$cdataTypeOf :: ModuleRenaming -> DataType
dataTypeOf :: ModuleRenaming -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ModuleRenaming)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ModuleRenaming)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ModuleRenaming)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ModuleRenaming)
$cgmapT :: (forall b. Data b => b -> b) -> ModuleRenaming -> ModuleRenaming
gmapT :: (forall b. Data b => b -> b) -> ModuleRenaming -> ModuleRenaming
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ModuleRenaming -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ModuleRenaming -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ModuleRenaming -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ModuleRenaming -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ModuleRenaming -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ModuleRenaming -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ModuleRenaming -> m ModuleRenaming
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ModuleRenaming -> m ModuleRenaming
Data, (forall x. ModuleRenaming -> Rep ModuleRenaming x)
-> (forall x. Rep ModuleRenaming x -> ModuleRenaming)
-> Generic ModuleRenaming
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
$cfrom :: forall x. ModuleRenaming -> Rep ModuleRenaming x
from :: forall x. ModuleRenaming -> Rep ModuleRenaming x
$cto :: forall x. Rep ModuleRenaming x -> ModuleRenaming
to :: forall x. Rep ModuleRenaming x -> ModuleRenaming
Generic)
interpModuleRenaming :: ModuleRenaming -> ModuleName -> Maybe ModuleName
interpModuleRenaming :: ModuleRenaming -> ModuleName -> Maybe ModuleName
interpModuleRenaming ModuleRenaming
DefaultRenaming = ModuleName -> Maybe ModuleName
forall a. a -> Maybe a
Just
interpModuleRenaming (ModuleRenaming [(ModuleName, ModuleName)]
rns) =
let m :: Map ModuleName ModuleName
m = [(ModuleName, ModuleName)] -> Map ModuleName ModuleName
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(ModuleName, ModuleName)]
rns
in \ModuleName
k -> ModuleName -> Map ModuleName ModuleName -> Maybe ModuleName
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 = [ModuleName] -> Set ModuleName
forall a. Ord a => [a] -> Set a
Set.fromList [ModuleName]
hs
in \ModuleName
k -> if ModuleName
k ModuleName -> Set ModuleName -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set ModuleName
s then Maybe ModuleName
forall a. Maybe a
Nothing else ModuleName -> Maybe ModuleName
forall a. a -> Maybe a
Just ModuleName
k
defaultRenaming :: ModuleRenaming
defaultRenaming :: ModuleRenaming
defaultRenaming = ModuleRenaming
DefaultRenaming
isDefaultRenaming :: ModuleRenaming -> Bool
isDefaultRenaming :: ModuleRenaming -> Bool
isDefaultRenaming ModuleRenaming
DefaultRenaming = Bool
True
isDefaultRenaming ModuleRenaming
_ = Bool
False
instance Binary ModuleRenaming
instance Structured ModuleRenaming
instance NFData ModuleRenaming where rnf :: ModuleRenaming -> ()
rnf = ModuleRenaming -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf
instance Pretty ModuleRenaming where
pretty :: ModuleRenaming -> Doc
pretty ModuleRenaming
DefaultRenaming = Doc
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 ((ModuleName -> Doc) -> [ModuleName] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> Doc
forall a. Pretty a => a -> Doc
pretty [ModuleName]
hides)))
pretty (ModuleRenaming [(ModuleName, ModuleName)]
rns) =
Doc -> Doc
parens (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
hsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
comma (((ModuleName, ModuleName) -> Doc)
-> [(ModuleName, ModuleName)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (ModuleName, ModuleName) -> Doc
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 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
new = a -> Doc
forall a. Pretty a => a -> Doc
pretty a
orig
| Bool
otherwise = a -> Doc
forall a. Pretty a => a -> Doc
pretty a
orig Doc -> Doc -> Doc
<+> String -> Doc
text String
"as" Doc -> Doc -> Doc
<+> a -> Doc
forall a. Pretty a => a -> Doc
pretty a
new
instance Parsec ModuleRenaming where
parsec :: forall (m :: * -> *). CabalParsing m => m ModuleRenaming
parsec = do
csv <- m CabalSpecVersion
forall (m :: * -> *). CabalParsing m => m CabalSpecVersion
askCabalSpecVersion
if csv >= CabalSpecV3_0
then moduleRenamingParsec parensLax lexemeParsec
else moduleRenamingParsec parensStrict parsec
where
parensLax :: m a -> m a
parensLax m a
p = m () -> m () -> m a -> m a
forall (m :: * -> *) bra ket a.
Applicative m =>
m bra -> m ket -> m a -> m a
P.between (Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'(' m Char -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m ()
forall (m :: * -> *). CharParsing m => m ()
P.spaces) (Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
')' m Char -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m ()
forall (m :: * -> *). CharParsing m => m ()
P.spaces) m a
p
parensStrict :: m a -> m a
parensStrict m a
p = m (Maybe Any) -> m Char -> m a -> m a
forall (m :: * -> *) bra ket a.
Applicative m =>
m bra -> m ket -> m a -> m a
P.between (Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'(' m Char -> m (Maybe Any) -> m (Maybe Any)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m (Maybe Any)
forall {a}. m (Maybe a)
warnSpaces) (Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
')') m a
p
warnSpaces :: m (Maybe a)
warnSpaces =
m a -> m (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (m a -> m (Maybe a)) -> m a -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$
m Char
forall (m :: * -> *). CharParsing m => m Char
P.space m Char -> m a -> m a
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> m a
forall a. String -> m a
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)
-> m ModuleName
-> 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 =
[m ModuleRenaming] -> m ModuleRenaming
forall (m :: * -> *) a. Alternative m => [m a] -> m a
P.choice [m ModuleRenaming
parseRename, m ModuleRenaming
parseHiding, ModuleRenaming -> m ModuleRenaming
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ModuleRenaming
DefaultRenaming]
where
cma :: m ()
cma = Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
',' m Char -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m ()
forall (m :: * -> *). CharParsing m => m ()
P.spaces
parseRename :: m ModuleRenaming
parseRename = do
rns <- m [(ModuleName, ModuleName)] -> m [(ModuleName, ModuleName)]
forall a. m a -> m a
bp m [(ModuleName, ModuleName)]
parseList
P.spaces
return (ModuleRenaming rns)
parseHiding :: m ModuleRenaming
parseHiding = do
_ <- String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
P.string String
"hiding"
P.spaces
hides <- bp (P.sepBy mn cma)
return (HidingRenaming hides)
parseList :: m [(ModuleName, ModuleName)]
parseList =
m (ModuleName, ModuleName) -> m () -> m [(ModuleName, ModuleName)]
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
orig <- m ModuleName
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m ModuleName
parsec
P.spaces
P.option (orig, orig) $ do
_ <- P.string "as"
P.skipSpaces1
new <- parsec
P.spaces
return (orig, new)