{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
module Distribution.Types.Dependency
( Dependency(..)
, mkDependency
, depPkgName
, depVerRange
, depLibraries
, simplifyDependency
, mainLibSet
) where
import Distribution.Compat.Prelude
import Prelude ()
import Distribution.Types.VersionRange (isAnyVersionLight)
import Distribution.Version (VersionRange, anyVersion, simplifyVersionRange)
import Distribution.CabalSpecVersion
import Distribution.Compat.CharParsing (char, spaces)
import Distribution.Compat.Parsing (between, option)
import Distribution.Parsec
import Distribution.Pretty
import Distribution.Types.LibraryName
import Distribution.Types.PackageName
import Distribution.Types.UnqualComponentName
import qualified Distribution.Compat.NonEmptySet as NES
import qualified Text.PrettyPrint as PP
data Dependency = Dependency
PackageName
VersionRange
(NonEmptySet LibraryName)
deriving ((forall x. Dependency -> Rep Dependency x)
-> (forall x. Rep Dependency x -> Dependency) -> Generic Dependency
forall x. Rep Dependency x -> Dependency
forall x. Dependency -> Rep Dependency x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Dependency x -> Dependency
$cfrom :: forall x. Dependency -> Rep Dependency x
Generic, ReadPrec [Dependency]
ReadPrec Dependency
Int -> ReadS Dependency
ReadS [Dependency]
(Int -> ReadS Dependency)
-> ReadS [Dependency]
-> ReadPrec Dependency
-> ReadPrec [Dependency]
-> Read Dependency
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Dependency]
$creadListPrec :: ReadPrec [Dependency]
readPrec :: ReadPrec Dependency
$creadPrec :: ReadPrec Dependency
readList :: ReadS [Dependency]
$creadList :: ReadS [Dependency]
readsPrec :: Int -> ReadS Dependency
$creadsPrec :: Int -> ReadS Dependency
Read, Int -> Dependency -> ShowS
[Dependency] -> ShowS
Dependency -> String
(Int -> Dependency -> ShowS)
-> (Dependency -> String)
-> ([Dependency] -> ShowS)
-> Show Dependency
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Dependency] -> ShowS
$cshowList :: [Dependency] -> ShowS
show :: Dependency -> String
$cshow :: Dependency -> String
showsPrec :: Int -> Dependency -> ShowS
$cshowsPrec :: Int -> Dependency -> ShowS
Show, Dependency -> Dependency -> Bool
(Dependency -> Dependency -> Bool)
-> (Dependency -> Dependency -> Bool) -> Eq Dependency
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Dependency -> Dependency -> Bool
$c/= :: Dependency -> Dependency -> Bool
== :: Dependency -> Dependency -> Bool
$c== :: Dependency -> Dependency -> Bool
Eq, Typeable, Typeable Dependency
Typeable Dependency
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Dependency -> c Dependency)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Dependency)
-> (Dependency -> Constr)
-> (Dependency -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Dependency))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Dependency))
-> ((forall b. Data b => b -> b) -> Dependency -> Dependency)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Dependency -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Dependency -> r)
-> (forall u. (forall d. Data d => d -> u) -> Dependency -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> Dependency -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Dependency -> m Dependency)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Dependency -> m Dependency)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Dependency -> m Dependency)
-> Data Dependency
Dependency -> DataType
Dependency -> Constr
(forall b. Data b => b -> b) -> Dependency -> Dependency
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) -> Dependency -> u
forall u. (forall d. Data d => d -> u) -> Dependency -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Dependency -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Dependency -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Dependency -> m Dependency
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Dependency -> m Dependency
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Dependency
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Dependency -> c Dependency
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Dependency)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Dependency)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Dependency -> m Dependency
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Dependency -> m Dependency
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Dependency -> m Dependency
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Dependency -> m Dependency
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Dependency -> m Dependency
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Dependency -> m Dependency
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Dependency -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Dependency -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Dependency -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Dependency -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Dependency -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Dependency -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Dependency -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Dependency -> r
gmapT :: (forall b. Data b => b -> b) -> Dependency -> Dependency
$cgmapT :: (forall b. Data b => b -> b) -> Dependency -> Dependency
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Dependency)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Dependency)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Dependency)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Dependency)
dataTypeOf :: Dependency -> DataType
$cdataTypeOf :: Dependency -> DataType
toConstr :: Dependency -> Constr
$ctoConstr :: Dependency -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Dependency
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Dependency
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Dependency -> c Dependency
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Dependency -> c Dependency
Data)
depPkgName :: Dependency -> PackageName
depPkgName :: Dependency -> PackageName
depPkgName (Dependency PackageName
pn VersionRange
_ NonEmptySet LibraryName
_) = PackageName
pn
depVerRange :: Dependency -> VersionRange
depVerRange :: Dependency -> VersionRange
depVerRange (Dependency PackageName
_ VersionRange
vr NonEmptySet LibraryName
_) = VersionRange
vr
depLibraries :: Dependency -> NonEmptySet LibraryName
depLibraries :: Dependency -> NonEmptySet LibraryName
depLibraries (Dependency PackageName
_ VersionRange
_ NonEmptySet LibraryName
cs) = NonEmptySet LibraryName
cs
mkDependency :: PackageName -> VersionRange -> NonEmptySet LibraryName -> Dependency
mkDependency :: PackageName
-> VersionRange -> NonEmptySet LibraryName -> Dependency
mkDependency PackageName
pn VersionRange
vr NonEmptySet LibraryName
lb = PackageName
-> VersionRange -> NonEmptySet LibraryName -> Dependency
Dependency PackageName
pn VersionRange
vr ((LibraryName -> LibraryName)
-> NonEmptySet LibraryName -> NonEmptySet LibraryName
forall b a. Ord b => (a -> b) -> NonEmptySet a -> NonEmptySet b
NES.map LibraryName -> LibraryName
conv NonEmptySet LibraryName
lb)
where
pn' :: UnqualComponentName
pn' = PackageName -> UnqualComponentName
packageNameToUnqualComponentName PackageName
pn
conv :: LibraryName -> LibraryName
conv l :: LibraryName
l@LibraryName
LMainLibName = LibraryName
l
conv l :: LibraryName
l@(LSubLibName UnqualComponentName
ln) | UnqualComponentName
ln UnqualComponentName -> UnqualComponentName -> Bool
forall a. Eq a => a -> a -> Bool
== UnqualComponentName
pn' = LibraryName
LMainLibName
| Bool
otherwise = LibraryName
l
instance Binary Dependency
instance Structured Dependency
instance NFData Dependency where rnf :: Dependency -> ()
rnf = Dependency -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf
instance Pretty Dependency where
pretty :: Dependency -> Doc
pretty (Dependency PackageName
name VersionRange
ver NonEmptySet LibraryName
sublibs) = Doc -> Doc
withSubLibs (PackageName -> Doc
forall a. Pretty a => a -> Doc
pretty PackageName
name) Doc -> Doc -> Doc
<+> Doc
pver
where
pver :: Doc
pver | VersionRange -> Bool
isAnyVersionLight VersionRange
ver = Doc
PP.empty
| Bool
otherwise = VersionRange -> Doc
forall a. Pretty a => a -> Doc
pretty VersionRange
ver
withSubLibs :: Doc -> Doc
withSubLibs Doc
doc = case NonEmptySet LibraryName -> [LibraryName]
forall a. NonEmptySet a -> [a]
NES.toList NonEmptySet LibraryName
sublibs of
[LibraryName
LMainLibName] -> Doc
doc
[LSubLibName UnqualComponentName
uq] -> Doc
doc Doc -> Doc -> Doc
<<>> Doc
PP.colon Doc -> Doc -> Doc
<<>> UnqualComponentName -> Doc
forall a. Pretty a => a -> Doc
pretty UnqualComponentName
uq
[LibraryName]
_ -> Doc
doc Doc -> Doc -> Doc
<<>> Doc
PP.colon Doc -> Doc -> Doc
<<>> Doc -> Doc
PP.braces Doc
prettySublibs
prettySublibs :: Doc
prettySublibs = [Doc] -> Doc
PP.hsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
PP.punctuate Doc
PP.comma ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ LibraryName -> Doc
prettySublib (LibraryName -> Doc) -> [LibraryName] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmptySet LibraryName -> [LibraryName]
forall a. NonEmptySet a -> [a]
NES.toList NonEmptySet LibraryName
sublibs
prettySublib :: LibraryName -> Doc
prettySublib LibraryName
LMainLibName = String -> Doc
PP.text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ PackageName -> String
unPackageName PackageName
name
prettySublib (LSubLibName UnqualComponentName
un) = String -> Doc
PP.text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
un
instance Parsec Dependency where
parsec :: forall (m :: * -> *). CabalParsing m => m Dependency
parsec = do
PackageName
name <- m PackageName
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
NonEmptySet LibraryName
libs <- NonEmptySet LibraryName
-> m (NonEmptySet LibraryName) -> m (NonEmptySet LibraryName)
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option NonEmptySet LibraryName
mainLibSet (m (NonEmptySet LibraryName) -> m (NonEmptySet LibraryName))
-> m (NonEmptySet LibraryName) -> m (NonEmptySet LibraryName)
forall a b. (a -> b) -> a -> b
$ do
Char
_ <- Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
':'
m ()
forall (m :: * -> *). CabalParsing m => m ()
versionGuardMultilibs
PWarnType -> String -> m ()
forall (m :: * -> *). CabalParsing m => PWarnType -> String -> m ()
parsecWarning PWarnType
PWTExperimental String
"colon specifier is experimental feature (issue #5660)"
LibraryName -> NonEmptySet LibraryName
forall a. a -> NonEmptySet a
NES.singleton (LibraryName -> NonEmptySet LibraryName)
-> m LibraryName -> m (NonEmptySet LibraryName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m LibraryName
parseLib m (NonEmptySet LibraryName)
-> m (NonEmptySet LibraryName) -> m (NonEmptySet LibraryName)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (NonEmptySet LibraryName)
parseMultipleLibs
m ()
forall (m :: * -> *). CharParsing m => m ()
spaces
VersionRange
ver <- m VersionRange
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec m VersionRange -> m VersionRange -> m VersionRange
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> VersionRange -> m VersionRange
forall (f :: * -> *) a. Applicative f => a -> f a
pure VersionRange
anyVersion
Dependency -> m Dependency
forall (m :: * -> *) a. Monad m => a -> m a
return (Dependency -> m Dependency) -> Dependency -> m Dependency
forall a b. (a -> b) -> a -> b
$ PackageName
-> VersionRange -> NonEmptySet LibraryName -> Dependency
mkDependency PackageName
name VersionRange
ver NonEmptySet LibraryName
libs
where
parseLib :: m LibraryName
parseLib = UnqualComponentName -> LibraryName
LSubLibName (UnqualComponentName -> LibraryName)
-> m UnqualComponentName -> m LibraryName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m UnqualComponentName
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
parseMultipleLibs :: m (NonEmptySet LibraryName)
parseMultipleLibs = m ()
-> m Char
-> m (NonEmptySet LibraryName)
-> m (NonEmptySet LibraryName)
forall (m :: * -> *) bra ket a.
Applicative m =>
m bra -> m ket -> m a -> m a
between
(Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'{' m Char -> m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m ()
forall (m :: * -> *). CharParsing m => m ()
spaces)
(m ()
forall (m :: * -> *). CharParsing m => m ()
spaces m () -> m Char -> m Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'}')
(NonEmpty LibraryName -> NonEmptySet LibraryName
forall a. Ord a => NonEmpty a -> NonEmptySet a
NES.fromNonEmpty (NonEmpty LibraryName -> NonEmptySet LibraryName)
-> m (NonEmpty LibraryName) -> m (NonEmptySet LibraryName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m LibraryName -> m (NonEmpty LibraryName)
forall (m :: * -> *) a. CabalParsing m => m a -> m (NonEmpty a)
parsecCommaNonEmpty m LibraryName
parseLib)
versionGuardMultilibs :: CabalParsing m => m ()
versionGuardMultilibs :: forall (m :: * -> *). CabalParsing m => m ()
versionGuardMultilibs = do
CabalSpecVersion
csv <- m CabalSpecVersion
forall (m :: * -> *). CabalParsing m => m CabalSpecVersion
askCabalSpecVersion
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CabalSpecVersion
csv CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
< CabalSpecVersion
CabalSpecV3_0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords
[ String
"Sublibrary dependency syntax used."
, String
"To use this syntax the package needs to specify at least 'cabal-version: 3.0'."
, String
"Alternatively, if you are depending on an internal library, you can write"
, String
"directly the library name as it were a package."
]
mainLibSet :: NonEmptySet LibraryName
mainLibSet :: NonEmptySet LibraryName
mainLibSet = LibraryName -> NonEmptySet LibraryName
forall a. a -> NonEmptySet a
NES.singleton LibraryName
LMainLibName
simplifyDependency :: Dependency -> Dependency
simplifyDependency :: Dependency -> Dependency
simplifyDependency (Dependency PackageName
name VersionRange
range NonEmptySet LibraryName
comps) =
PackageName
-> VersionRange -> NonEmptySet LibraryName -> Dependency
Dependency PackageName
name (VersionRange -> VersionRange
simplifyVersionRange VersionRange
range) NonEmptySet LibraryName
comps