{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
module Distribution.Types.Dependency
  ( Dependency(..)
  , depPkgName
  , depVerRange
  , depLibraries
  , thisPackageVersion
  , notThisPackageVersion
  , simplifyDependency
  ) where

import Prelude ()
import Distribution.Compat.Prelude

import Distribution.Version ( VersionRange, thisVersion
                            , notThisVersion, anyVersion
                            , simplifyVersionRange )

import Distribution.CabalSpecVersion
import Distribution.Pretty
import qualified Text.PrettyPrint as PP
import Distribution.Parsec
import Distribution.Compat.CharParsing (char, spaces)
import Distribution.Compat.Parsing (between, option)
import Distribution.Types.PackageId
import Distribution.Types.PackageName
import Distribution.Types.LibraryName
import Distribution.Types.UnqualComponentName

import Text.PrettyPrint ((<+>))
import qualified Data.Set as Set

-- | Describes a dependency on a source package (API)
--
data Dependency = Dependency
                    PackageName
                    VersionRange
                    (Set LibraryName)
                    -- ^ The set of libraries required from the package.
                    -- Only the selected libraries will be built.
                    -- It does not affect the cabal-install solver yet.
                  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
External instance of the constraint type Ord LibraryName
External instance of the constraint type Read LibraryName
External instance of the constraint type Ord LibraryName
External instance of the constraint type Read LibraryName
External instance of the constraint type forall a. (Read a, Ord a) => Read (Set a)
External instance of the constraint type Read VersionRange
External instance of the constraint type Read PackageName
External instance of the constraint type Monad ReadPrec
External instance of the constraint type Monad ReadPrec
Instance of class: Read of the constraint type Read 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
External instance of the constraint type Show LibraryName
External instance of the constraint type Show LibraryName
External instance of the constraint type forall a. Show a => Show (Set a)
External instance of the constraint type Show VersionRange
External instance of the constraint type Show PackageName
External instance of the constraint type Ord Int
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
External instance of the constraint type Eq LibraryName
External instance of the constraint type Eq LibraryName
External instance of the constraint type forall a. Eq a => Eq (Set a)
External instance of the constraint type Eq VersionRange
External instance of the constraint type Eq PackageName
Eq, Typeable, Typeable Dependency
DataType
Constr
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 d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Dependency -> c Dependency
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cDependency :: Constr
$tDependency :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> Dependency -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Dependency -> u
gmapQ :: (forall d. Data d => d -> u) -> Dependency -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Dependency -> [u]
gmapQr :: (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 :: (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 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 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 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 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
External instance of the constraint type Data LibraryName
External instance of the constraint type Ord LibraryName
External instance of the constraint type Data LibraryName
External instance of the constraint type Data PackageName
External instance of the constraint type Data VersionRange
External instance of the constraint type Ord LibraryName
External instance of the constraint type Data LibraryName
External instance of the constraint type forall a. (Data a, Ord a) => Data (Set a)
External instance of the constraint type Ord LibraryName
Data)

depPkgName :: Dependency -> PackageName
depPkgName :: Dependency -> PackageName
depPkgName (Dependency PackageName
pn VersionRange
_ Set LibraryName
_) = PackageName
pn

depVerRange :: Dependency -> VersionRange
depVerRange :: Dependency -> VersionRange
depVerRange (Dependency PackageName
_ VersionRange
vr Set LibraryName
_) = VersionRange
vr

depLibraries :: Dependency -> Set LibraryName
depLibraries :: Dependency -> Set LibraryName
depLibraries (Dependency PackageName
_ VersionRange
_ Set LibraryName
cs) = Set LibraryName
cs

instance Binary Dependency
instance Structured Dependency
instance NFData Dependency where rnf :: Dependency -> ()
rnf = Dependency -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
External instance of the constraint type forall (a :: * -> *) i (c :: Meta). GNFData a => GNFData (M1 i c a)
External instance of the constraint type forall (a :: * -> *) i (c :: Meta). GNFData a => GNFData (M1 i c a)
External instance of the constraint type forall (a :: * -> *) (b :: * -> *).
(GNFData a, GNFData b) =>
GNFData (a :*: b)
External instance of the constraint type forall (a :: * -> *) i (c :: Meta). GNFData a => GNFData (M1 i c a)
External instance of the constraint type forall a i. NFData a => GNFData (K1 i a)
External instance of the constraint type NFData PackageName
External instance of the constraint type forall (a :: * -> *) (b :: * -> *).
(GNFData a, GNFData b) =>
GNFData (a :*: b)
External instance of the constraint type forall (a :: * -> *) i (c :: Meta). GNFData a => GNFData (M1 i c a)
External instance of the constraint type forall a i. NFData a => GNFData (K1 i a)
External instance of the constraint type NFData VersionRange
External instance of the constraint type forall (a :: * -> *) i (c :: Meta). GNFData a => GNFData (M1 i c a)
External instance of the constraint type forall a i. NFData a => GNFData (K1 i a)
External instance of the constraint type forall a. NFData a => NFData (Set a)
External instance of the constraint type NFData LibraryName
Instance of class: Generic of the constraint type Generic Dependency
genericRnf

instance Pretty Dependency where
    pretty :: Dependency -> Doc
pretty (Dependency PackageName
name VersionRange
ver Set LibraryName
sublibs) = PackageName -> Doc
forall a. Pretty a => a -> Doc
External instance of the constraint type Pretty PackageName
pretty PackageName
name
                                       Doc -> Doc -> Doc
<+> Bool -> Doc -> Doc
forall {p}. Monoid p => Bool -> p -> p
External instance of the constraint type Monoid Doc
optionalMonoid
                                             (Set LibraryName
sublibs Set LibraryName -> Set LibraryName -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type forall a. Eq a => Eq (Set a)
External instance of the constraint type Eq LibraryName
/= LibraryName -> Set LibraryName
forall a. a -> Set a
Set.singleton LibraryName
LMainLibName)
                                             (Doc
PP.colon Doc -> Doc -> Doc
<+> Doc -> Doc
PP.braces Doc
prettySublibs)
                                       Doc -> Doc -> Doc
<+> VersionRange -> Doc
forall a. Pretty a => a -> Doc
External instance of the constraint type Pretty VersionRange
pretty VersionRange
ver
      where
        optionalMonoid :: Bool -> p -> p
optionalMonoid Bool
True p
x = p
x
        optionalMonoid Bool
False p
_ = p
forall a. Monoid a => a
Evidence bound by a type signature of the constraint type Monoid p
mempty
        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
External instance of the constraint type Functor []
<$> Set LibraryName -> [LibraryName]
forall a. Set a -> [a]
Set.toList Set 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

versionGuardMultilibs :: (Monad m, CabalParsing m) => m a -> m a
versionGuardMultilibs :: m a -> m a
versionGuardMultilibs m a
expr = do
  CabalSpecVersion
csv <- m CabalSpecVersion
forall (m :: * -> *). CabalParsing m => m CabalSpecVersion
Evidence bound by a type signature of the constraint type CabalParsing m
askCabalSpecVersion
  if CabalSpecVersion
csv CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord CabalSpecVersion
< CabalSpecVersion
CabalSpecV3_0
  then String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
External instance of the constraint type forall (m :: * -> *). CabalParsing m => MonadFail m
Evidence bound by a type signature of the constraint type CabalParsing m
fail (String -> m a) -> String -> m a
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."
    ]
  else
    m a
expr

instance Parsec Dependency where
    parsec :: m Dependency
parsec = do
        PackageName
name <- m PackageName
forall (m :: * -> *) a. (CabalParsing m, Parsec a) => m a
External instance of the constraint type Parsec PackageName
Evidence bound by a type signature of the constraint type CabalParsing m
lexemeParsec

        [LibraryName]
libs <- [LibraryName] -> m [LibraryName] -> m [LibraryName]
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
option [LibraryName
LMainLibName]
              (m [LibraryName] -> m [LibraryName])
-> m [LibraryName] -> m [LibraryName]
forall a b. (a -> b) -> a -> b
$ (Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
char Char
':' m Char -> m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
External instance of the constraint type forall (f :: * -> *). Alternative f => Applicative f
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
*> m ()
forall (m :: * -> *). CharParsing m => m ()
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
spaces m () -> m [LibraryName] -> m [LibraryName]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
External instance of the constraint type forall (f :: * -> *). Alternative f => Applicative f
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
*>)
              (m [LibraryName] -> m [LibraryName])
-> m [LibraryName] -> m [LibraryName]
forall a b. (a -> b) -> a -> b
$ m [LibraryName] -> m [LibraryName]
forall (m :: * -> *) a. (Monad m, CabalParsing m) => m a -> m a
Evidence bound by a type signature of the constraint type CabalParsing m
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => MonadPlus m
Evidence bound by a type signature of the constraint type CabalParsing m
versionGuardMultilibs
              (m [LibraryName] -> m [LibraryName])
-> m [LibraryName] -> m [LibraryName]
forall a b. (a -> b) -> a -> b
$ LibraryName -> [LibraryName]
forall (f :: * -> *) a. Applicative f => a -> f a
External instance of the constraint type Applicative []
pure (LibraryName -> [LibraryName]) -> m LibraryName -> m [LibraryName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type forall (f :: * -> *). Applicative f => Functor f
External instance of the constraint type forall (f :: * -> *). Alternative f => Applicative f
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
<$> PackageName -> m LibraryName
forall {f :: * -> *}.
CabalParsing f =>
PackageName -> f LibraryName
Evidence bound by a type signature of the constraint type CabalParsing m
parseLib PackageName
name m [LibraryName] -> m [LibraryName] -> m [LibraryName]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
<|> PackageName -> m [LibraryName]
forall {m :: * -> *}.
CabalParsing m =>
PackageName -> m [LibraryName]
Evidence bound by a type signature of the constraint type CabalParsing m
parseMultipleLibs PackageName
name

        m ()
forall (m :: * -> *). CharParsing m => m ()
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
spaces -- https://github.com/haskell/cabal/issues/5846

        VersionRange
ver  <- m VersionRange
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
Evidence bound by a type signature of the constraint type CabalParsing m
External instance of the constraint type Parsec VersionRange
parsec m VersionRange -> m VersionRange -> m VersionRange
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
<|> VersionRange -> m VersionRange
forall (f :: * -> *) a. Applicative f => a -> f a
External instance of the constraint type forall (f :: * -> *). Alternative f => Applicative f
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
pure VersionRange
anyVersion
        Dependency -> m Dependency
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => MonadPlus m
Evidence bound by a type signature of the constraint type CabalParsing m
return (Dependency -> m Dependency) -> Dependency -> m Dependency
forall a b. (a -> b) -> a -> b
$ PackageName -> VersionRange -> Set LibraryName -> Dependency
Dependency PackageName
name VersionRange
ver (Set LibraryName -> Dependency) -> Set LibraryName -> Dependency
forall a b. (a -> b) -> a -> b
$ [LibraryName] -> Set LibraryName
forall a. Ord a => [a] -> Set a
External instance of the constraint type Ord LibraryName
Set.fromList [LibraryName]
libs
      where makeLib :: PackageName -> String -> LibraryName
makeLib PackageName
pn String
ln | PackageName -> String
unPackageName PackageName
pn String -> String -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type Eq Char
== String
ln = LibraryName
LMainLibName
                          | Bool
otherwise = UnqualComponentName -> LibraryName
LSubLibName (UnqualComponentName -> LibraryName)
-> UnqualComponentName -> LibraryName
forall a b. (a -> b) -> a -> b
$ String -> UnqualComponentName
mkUnqualComponentName String
ln
            parseLib :: PackageName -> f LibraryName
parseLib PackageName
pn = PackageName -> String -> LibraryName
makeLib PackageName
pn (String -> LibraryName) -> f String -> f LibraryName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type forall (f :: * -> *). Applicative f => Functor f
External instance of the constraint type forall (f :: * -> *). Alternative f => Applicative f
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing f
<$> f String
forall (m :: * -> *). CabalParsing m => m String
Evidence bound by a type signature of the constraint type CabalParsing f
parsecUnqualComponentName
            parseMultipleLibs :: PackageName -> m [LibraryName]
parseMultipleLibs PackageName
pn = m () -> m () -> m [LibraryName] -> m [LibraryName]
forall (m :: * -> *) bra ket a.
Applicative m =>
m bra -> m ket -> m a -> m a
External instance of the constraint type forall (f :: * -> *). Alternative f => Applicative f
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
between (Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
char Char
'{' m Char -> m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
External instance of the constraint type forall (f :: * -> *). Alternative f => Applicative f
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
*> m ()
forall (m :: * -> *). CharParsing m => m ()
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
spaces)
                                           (m ()
forall (m :: * -> *). CharParsing m => m ()
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
spaces m () -> m Char -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
External instance of the constraint type forall (f :: * -> *). Alternative f => Applicative f
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
<* Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
char Char
'}')
                                           (m [LibraryName] -> m [LibraryName])
-> m [LibraryName] -> m [LibraryName]
forall a b. (a -> b) -> a -> b
$ m LibraryName -> m [LibraryName]
forall (m :: * -> *) a. CabalParsing m => m a -> m [a]
Evidence bound by a type signature of the constraint type CabalParsing m
parsecCommaList (m LibraryName -> m [LibraryName])
-> m LibraryName -> m [LibraryName]
forall a b. (a -> b) -> a -> b
$ PackageName -> m LibraryName
forall {f :: * -> *}.
CabalParsing f =>
PackageName -> f LibraryName
Evidence bound by a type signature of the constraint type CabalParsing m
parseLib PackageName
pn

-- mempty should never be in a Dependency-as-dependency.
-- This is only here until the Dependency-as-constraint problem is solved #5570.
-- Same for below.
thisPackageVersion :: PackageIdentifier -> Dependency
thisPackageVersion :: PackageIdentifier -> Dependency
thisPackageVersion (PackageIdentifier PackageName
n Version
v) =
  PackageName -> VersionRange -> Set LibraryName -> Dependency
Dependency PackageName
n (Version -> VersionRange
thisVersion Version
v) Set LibraryName
forall a. Set a
Set.empty

notThisPackageVersion :: PackageIdentifier -> Dependency
notThisPackageVersion :: PackageIdentifier -> Dependency
notThisPackageVersion (PackageIdentifier PackageName
n Version
v) =
  PackageName -> VersionRange -> Set LibraryName -> Dependency
Dependency PackageName
n (Version -> VersionRange
notThisVersion Version
v) Set LibraryName
forall a. Set a
Set.empty

-- | Simplify the 'VersionRange' expression in a 'Dependency'.
-- See 'simplifyVersionRange'.
--
simplifyDependency :: Dependency -> Dependency
simplifyDependency :: Dependency -> Dependency
simplifyDependency (Dependency PackageName
name VersionRange
range Set LibraryName
comps) =
  PackageName -> VersionRange -> Set LibraryName -> Dependency
Dependency PackageName
name (VersionRange -> VersionRange
simplifyVersionRange VersionRange
range) Set LibraryName
comps