{-# LANGUAGE DeriveGeneric #-}
module Distribution.Client.Types.AllowNewer (
    AllowNewer (..),
    AllowOlder (..),
    RelaxDeps (..),
    mkRelaxDepSome,
    RelaxDepMod (..),
    RelaxDepScope (..),
    RelaxDepSubject (..),
    RelaxedDep (..),
    isRelaxDeps,
) where

import Distribution.Client.Compat.Prelude
import Prelude ()

import Distribution.Parsec            (parsecLeadingCommaNonEmpty)
import Distribution.Types.PackageId   (PackageId, PackageIdentifier (..))
import Distribution.Types.PackageName (PackageName, mkPackageName)
import Distribution.Types.Version     (nullVersion)

import qualified Distribution.Compat.CharParsing as P
import qualified Text.PrettyPrint                as Disp

-- $setup
-- >>> import Distribution.Parsec

-- TODO: When https://github.com/haskell/cabal/issues/4203 gets tackled,
-- it may make sense to move these definitions to the Solver.Types
-- module

-- | 'RelaxDeps' in the context of upper bounds (i.e. for @--allow-newer@ flag)
newtype AllowNewer = AllowNewer { AllowNewer -> RelaxDeps
unAllowNewer :: RelaxDeps }
                   deriving (AllowNewer -> AllowNewer -> Bool
(AllowNewer -> AllowNewer -> Bool)
-> (AllowNewer -> AllowNewer -> Bool) -> Eq AllowNewer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AllowNewer -> AllowNewer -> Bool
$c/= :: AllowNewer -> AllowNewer -> Bool
== :: AllowNewer -> AllowNewer -> Bool
$c== :: AllowNewer -> AllowNewer -> Bool
Eq, ReadPrec [AllowNewer]
ReadPrec AllowNewer
Int -> ReadS AllowNewer
ReadS [AllowNewer]
(Int -> ReadS AllowNewer)
-> ReadS [AllowNewer]
-> ReadPrec AllowNewer
-> ReadPrec [AllowNewer]
-> Read AllowNewer
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AllowNewer]
$creadListPrec :: ReadPrec [AllowNewer]
readPrec :: ReadPrec AllowNewer
$creadPrec :: ReadPrec AllowNewer
readList :: ReadS [AllowNewer]
$creadList :: ReadS [AllowNewer]
readsPrec :: Int -> ReadS AllowNewer
$creadsPrec :: Int -> ReadS AllowNewer
Read, Int -> AllowNewer -> ShowS
[AllowNewer] -> ShowS
AllowNewer -> String
(Int -> AllowNewer -> ShowS)
-> (AllowNewer -> String)
-> ([AllowNewer] -> ShowS)
-> Show AllowNewer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AllowNewer] -> ShowS
$cshowList :: [AllowNewer] -> ShowS
show :: AllowNewer -> String
$cshow :: AllowNewer -> String
showsPrec :: Int -> AllowNewer -> ShowS
$cshowsPrec :: Int -> AllowNewer -> ShowS
Show, (forall x. AllowNewer -> Rep AllowNewer x)
-> (forall x. Rep AllowNewer x -> AllowNewer) -> Generic AllowNewer
forall x. Rep AllowNewer x -> AllowNewer
forall x. AllowNewer -> Rep AllowNewer x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AllowNewer x -> AllowNewer
$cfrom :: forall x. AllowNewer -> Rep AllowNewer x
Generic)

-- | 'RelaxDeps' in the context of lower bounds (i.e. for @--allow-older@ flag)
newtype AllowOlder = AllowOlder { AllowOlder -> RelaxDeps
unAllowOlder :: RelaxDeps }
                   deriving (AllowOlder -> AllowOlder -> Bool
(AllowOlder -> AllowOlder -> Bool)
-> (AllowOlder -> AllowOlder -> Bool) -> Eq AllowOlder
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AllowOlder -> AllowOlder -> Bool
$c/= :: AllowOlder -> AllowOlder -> Bool
== :: AllowOlder -> AllowOlder -> Bool
$c== :: AllowOlder -> AllowOlder -> Bool
Eq, ReadPrec [AllowOlder]
ReadPrec AllowOlder
Int -> ReadS AllowOlder
ReadS [AllowOlder]
(Int -> ReadS AllowOlder)
-> ReadS [AllowOlder]
-> ReadPrec AllowOlder
-> ReadPrec [AllowOlder]
-> Read AllowOlder
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AllowOlder]
$creadListPrec :: ReadPrec [AllowOlder]
readPrec :: ReadPrec AllowOlder
$creadPrec :: ReadPrec AllowOlder
readList :: ReadS [AllowOlder]
$creadList :: ReadS [AllowOlder]
readsPrec :: Int -> ReadS AllowOlder
$creadsPrec :: Int -> ReadS AllowOlder
Read, Int -> AllowOlder -> ShowS
[AllowOlder] -> ShowS
AllowOlder -> String
(Int -> AllowOlder -> ShowS)
-> (AllowOlder -> String)
-> ([AllowOlder] -> ShowS)
-> Show AllowOlder
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AllowOlder] -> ShowS
$cshowList :: [AllowOlder] -> ShowS
show :: AllowOlder -> String
$cshow :: AllowOlder -> String
showsPrec :: Int -> AllowOlder -> ShowS
$cshowsPrec :: Int -> AllowOlder -> ShowS
Show, (forall x. AllowOlder -> Rep AllowOlder x)
-> (forall x. Rep AllowOlder x -> AllowOlder) -> Generic AllowOlder
forall x. Rep AllowOlder x -> AllowOlder
forall x. AllowOlder -> Rep AllowOlder x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AllowOlder x -> AllowOlder
$cfrom :: forall x. AllowOlder -> Rep AllowOlder x
Generic)

-- | Generic data type for policy when relaxing bounds in dependencies.
-- Don't use this directly: use 'AllowOlder' or 'AllowNewer' depending
-- on whether or not you are relaxing an lower or upper bound
-- (respectively).
data RelaxDeps =

  -- | Ignore upper (resp. lower) bounds in some (or no) dependencies on the given packages.
  --
  -- @RelaxDepsSome []@ is the default, i.e. honor the bounds in all
  -- dependencies, never choose versions newer (resp. older) than allowed.
    RelaxDepsSome [RelaxedDep]

  -- | Ignore upper (resp. lower) bounds in dependencies on all packages.
  --
  -- __Note__: This is should be semantically equivalent to
  --
  -- > RelaxDepsSome [RelaxedDep RelaxDepScopeAll RelaxDepModNone RelaxDepSubjectAll]
  --
  -- (TODO: consider normalising 'RelaxDeps' and/or 'RelaxedDep')
  | RelaxDepsAll
  deriving (RelaxDeps -> RelaxDeps -> Bool
(RelaxDeps -> RelaxDeps -> Bool)
-> (RelaxDeps -> RelaxDeps -> Bool) -> Eq RelaxDeps
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RelaxDeps -> RelaxDeps -> Bool
$c/= :: RelaxDeps -> RelaxDeps -> Bool
== :: RelaxDeps -> RelaxDeps -> Bool
$c== :: RelaxDeps -> RelaxDeps -> Bool
Eq, ReadPrec [RelaxDeps]
ReadPrec RelaxDeps
Int -> ReadS RelaxDeps
ReadS [RelaxDeps]
(Int -> ReadS RelaxDeps)
-> ReadS [RelaxDeps]
-> ReadPrec RelaxDeps
-> ReadPrec [RelaxDeps]
-> Read RelaxDeps
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RelaxDeps]
$creadListPrec :: ReadPrec [RelaxDeps]
readPrec :: ReadPrec RelaxDeps
$creadPrec :: ReadPrec RelaxDeps
readList :: ReadS [RelaxDeps]
$creadList :: ReadS [RelaxDeps]
readsPrec :: Int -> ReadS RelaxDeps
$creadsPrec :: Int -> ReadS RelaxDeps
Read, Int -> RelaxDeps -> ShowS
[RelaxDeps] -> ShowS
RelaxDeps -> String
(Int -> RelaxDeps -> ShowS)
-> (RelaxDeps -> String)
-> ([RelaxDeps] -> ShowS)
-> Show RelaxDeps
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RelaxDeps] -> ShowS
$cshowList :: [RelaxDeps] -> ShowS
show :: RelaxDeps -> String
$cshow :: RelaxDeps -> String
showsPrec :: Int -> RelaxDeps -> ShowS
$cshowsPrec :: Int -> RelaxDeps -> ShowS
Show, (forall x. RelaxDeps -> Rep RelaxDeps x)
-> (forall x. Rep RelaxDeps x -> RelaxDeps) -> Generic RelaxDeps
forall x. Rep RelaxDeps x -> RelaxDeps
forall x. RelaxDeps -> Rep RelaxDeps x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RelaxDeps x -> RelaxDeps
$cfrom :: forall x. RelaxDeps -> Rep RelaxDeps x
Generic)

-- | Dependencies can be relaxed either for all packages in the install plan, or
-- only for some packages.
data RelaxedDep = RelaxedDep !RelaxDepScope !RelaxDepMod !RelaxDepSubject
                deriving (RelaxedDep -> RelaxedDep -> Bool
(RelaxedDep -> RelaxedDep -> Bool)
-> (RelaxedDep -> RelaxedDep -> Bool) -> Eq RelaxedDep
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RelaxedDep -> RelaxedDep -> Bool
$c/= :: RelaxedDep -> RelaxedDep -> Bool
== :: RelaxedDep -> RelaxedDep -> Bool
$c== :: RelaxedDep -> RelaxedDep -> Bool
Eq, ReadPrec [RelaxedDep]
ReadPrec RelaxedDep
Int -> ReadS RelaxedDep
ReadS [RelaxedDep]
(Int -> ReadS RelaxedDep)
-> ReadS [RelaxedDep]
-> ReadPrec RelaxedDep
-> ReadPrec [RelaxedDep]
-> Read RelaxedDep
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RelaxedDep]
$creadListPrec :: ReadPrec [RelaxedDep]
readPrec :: ReadPrec RelaxedDep
$creadPrec :: ReadPrec RelaxedDep
readList :: ReadS [RelaxedDep]
$creadList :: ReadS [RelaxedDep]
readsPrec :: Int -> ReadS RelaxedDep
$creadsPrec :: Int -> ReadS RelaxedDep
Read, Int -> RelaxedDep -> ShowS
[RelaxedDep] -> ShowS
RelaxedDep -> String
(Int -> RelaxedDep -> ShowS)
-> (RelaxedDep -> String)
-> ([RelaxedDep] -> ShowS)
-> Show RelaxedDep
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RelaxedDep] -> ShowS
$cshowList :: [RelaxedDep] -> ShowS
show :: RelaxedDep -> String
$cshow :: RelaxedDep -> String
showsPrec :: Int -> RelaxedDep -> ShowS
$cshowsPrec :: Int -> RelaxedDep -> ShowS
Show, (forall x. RelaxedDep -> Rep RelaxedDep x)
-> (forall x. Rep RelaxedDep x -> RelaxedDep) -> Generic RelaxedDep
forall x. Rep RelaxedDep x -> RelaxedDep
forall x. RelaxedDep -> Rep RelaxedDep x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RelaxedDep x -> RelaxedDep
$cfrom :: forall x. RelaxedDep -> Rep RelaxedDep x
Generic)

-- | Specify the scope of a relaxation, i.e. limit which depending
-- packages are allowed to have their version constraints relaxed.
data RelaxDepScope = RelaxDepScopeAll
                     -- ^ Apply relaxation in any package
                   | RelaxDepScopePackage !PackageName
                     -- ^ Apply relaxation to in all versions of a package
                   | RelaxDepScopePackageId !PackageId
                     -- ^ Apply relaxation to a specific version of a package only
                   deriving (RelaxDepScope -> RelaxDepScope -> Bool
(RelaxDepScope -> RelaxDepScope -> Bool)
-> (RelaxDepScope -> RelaxDepScope -> Bool) -> Eq RelaxDepScope
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RelaxDepScope -> RelaxDepScope -> Bool
$c/= :: RelaxDepScope -> RelaxDepScope -> Bool
== :: RelaxDepScope -> RelaxDepScope -> Bool
$c== :: RelaxDepScope -> RelaxDepScope -> Bool
Eq, ReadPrec [RelaxDepScope]
ReadPrec RelaxDepScope
Int -> ReadS RelaxDepScope
ReadS [RelaxDepScope]
(Int -> ReadS RelaxDepScope)
-> ReadS [RelaxDepScope]
-> ReadPrec RelaxDepScope
-> ReadPrec [RelaxDepScope]
-> Read RelaxDepScope
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RelaxDepScope]
$creadListPrec :: ReadPrec [RelaxDepScope]
readPrec :: ReadPrec RelaxDepScope
$creadPrec :: ReadPrec RelaxDepScope
readList :: ReadS [RelaxDepScope]
$creadList :: ReadS [RelaxDepScope]
readsPrec :: Int -> ReadS RelaxDepScope
$creadsPrec :: Int -> ReadS RelaxDepScope
Read, Int -> RelaxDepScope -> ShowS
[RelaxDepScope] -> ShowS
RelaxDepScope -> String
(Int -> RelaxDepScope -> ShowS)
-> (RelaxDepScope -> String)
-> ([RelaxDepScope] -> ShowS)
-> Show RelaxDepScope
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RelaxDepScope] -> ShowS
$cshowList :: [RelaxDepScope] -> ShowS
show :: RelaxDepScope -> String
$cshow :: RelaxDepScope -> String
showsPrec :: Int -> RelaxDepScope -> ShowS
$cshowsPrec :: Int -> RelaxDepScope -> ShowS
Show, (forall x. RelaxDepScope -> Rep RelaxDepScope x)
-> (forall x. Rep RelaxDepScope x -> RelaxDepScope)
-> Generic RelaxDepScope
forall x. Rep RelaxDepScope x -> RelaxDepScope
forall x. RelaxDepScope -> Rep RelaxDepScope x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RelaxDepScope x -> RelaxDepScope
$cfrom :: forall x. RelaxDepScope -> Rep RelaxDepScope x
Generic)

-- | Modifier for dependency relaxation
data RelaxDepMod = RelaxDepModNone  -- ^ Default semantics
                 | RelaxDepModCaret -- ^ Apply relaxation only to @^>=@ constraints
                 deriving (RelaxDepMod -> RelaxDepMod -> Bool
(RelaxDepMod -> RelaxDepMod -> Bool)
-> (RelaxDepMod -> RelaxDepMod -> Bool) -> Eq RelaxDepMod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RelaxDepMod -> RelaxDepMod -> Bool
$c/= :: RelaxDepMod -> RelaxDepMod -> Bool
== :: RelaxDepMod -> RelaxDepMod -> Bool
$c== :: RelaxDepMod -> RelaxDepMod -> Bool
Eq, ReadPrec [RelaxDepMod]
ReadPrec RelaxDepMod
Int -> ReadS RelaxDepMod
ReadS [RelaxDepMod]
(Int -> ReadS RelaxDepMod)
-> ReadS [RelaxDepMod]
-> ReadPrec RelaxDepMod
-> ReadPrec [RelaxDepMod]
-> Read RelaxDepMod
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RelaxDepMod]
$creadListPrec :: ReadPrec [RelaxDepMod]
readPrec :: ReadPrec RelaxDepMod
$creadPrec :: ReadPrec RelaxDepMod
readList :: ReadS [RelaxDepMod]
$creadList :: ReadS [RelaxDepMod]
readsPrec :: Int -> ReadS RelaxDepMod
$creadsPrec :: Int -> ReadS RelaxDepMod
Read, Int -> RelaxDepMod -> ShowS
[RelaxDepMod] -> ShowS
RelaxDepMod -> String
(Int -> RelaxDepMod -> ShowS)
-> (RelaxDepMod -> String)
-> ([RelaxDepMod] -> ShowS)
-> Show RelaxDepMod
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RelaxDepMod] -> ShowS
$cshowList :: [RelaxDepMod] -> ShowS
show :: RelaxDepMod -> String
$cshow :: RelaxDepMod -> String
showsPrec :: Int -> RelaxDepMod -> ShowS
$cshowsPrec :: Int -> RelaxDepMod -> ShowS
Show, (forall x. RelaxDepMod -> Rep RelaxDepMod x)
-> (forall x. Rep RelaxDepMod x -> RelaxDepMod)
-> Generic RelaxDepMod
forall x. Rep RelaxDepMod x -> RelaxDepMod
forall x. RelaxDepMod -> Rep RelaxDepMod x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RelaxDepMod x -> RelaxDepMod
$cfrom :: forall x. RelaxDepMod -> Rep RelaxDepMod x
Generic)

-- | Express whether to relax bounds /on/ @all@ packages, or a single package
data RelaxDepSubject = RelaxDepSubjectAll
                     | RelaxDepSubjectPkg !PackageName
                     deriving (RelaxDepSubject -> RelaxDepSubject -> Bool
(RelaxDepSubject -> RelaxDepSubject -> Bool)
-> (RelaxDepSubject -> RelaxDepSubject -> Bool)
-> Eq RelaxDepSubject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RelaxDepSubject -> RelaxDepSubject -> Bool
$c/= :: RelaxDepSubject -> RelaxDepSubject -> Bool
== :: RelaxDepSubject -> RelaxDepSubject -> Bool
$c== :: RelaxDepSubject -> RelaxDepSubject -> Bool
Eq, Eq RelaxDepSubject
Eq RelaxDepSubject
-> (RelaxDepSubject -> RelaxDepSubject -> Ordering)
-> (RelaxDepSubject -> RelaxDepSubject -> Bool)
-> (RelaxDepSubject -> RelaxDepSubject -> Bool)
-> (RelaxDepSubject -> RelaxDepSubject -> Bool)
-> (RelaxDepSubject -> RelaxDepSubject -> Bool)
-> (RelaxDepSubject -> RelaxDepSubject -> RelaxDepSubject)
-> (RelaxDepSubject -> RelaxDepSubject -> RelaxDepSubject)
-> Ord RelaxDepSubject
RelaxDepSubject -> RelaxDepSubject -> Bool
RelaxDepSubject -> RelaxDepSubject -> Ordering
RelaxDepSubject -> RelaxDepSubject -> RelaxDepSubject
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 :: RelaxDepSubject -> RelaxDepSubject -> RelaxDepSubject
$cmin :: RelaxDepSubject -> RelaxDepSubject -> RelaxDepSubject
max :: RelaxDepSubject -> RelaxDepSubject -> RelaxDepSubject
$cmax :: RelaxDepSubject -> RelaxDepSubject -> RelaxDepSubject
>= :: RelaxDepSubject -> RelaxDepSubject -> Bool
$c>= :: RelaxDepSubject -> RelaxDepSubject -> Bool
> :: RelaxDepSubject -> RelaxDepSubject -> Bool
$c> :: RelaxDepSubject -> RelaxDepSubject -> Bool
<= :: RelaxDepSubject -> RelaxDepSubject -> Bool
$c<= :: RelaxDepSubject -> RelaxDepSubject -> Bool
< :: RelaxDepSubject -> RelaxDepSubject -> Bool
$c< :: RelaxDepSubject -> RelaxDepSubject -> Bool
compare :: RelaxDepSubject -> RelaxDepSubject -> Ordering
$ccompare :: RelaxDepSubject -> RelaxDepSubject -> Ordering
$cp1Ord :: Eq RelaxDepSubject
Ord, ReadPrec [RelaxDepSubject]
ReadPrec RelaxDepSubject
Int -> ReadS RelaxDepSubject
ReadS [RelaxDepSubject]
(Int -> ReadS RelaxDepSubject)
-> ReadS [RelaxDepSubject]
-> ReadPrec RelaxDepSubject
-> ReadPrec [RelaxDepSubject]
-> Read RelaxDepSubject
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RelaxDepSubject]
$creadListPrec :: ReadPrec [RelaxDepSubject]
readPrec :: ReadPrec RelaxDepSubject
$creadPrec :: ReadPrec RelaxDepSubject
readList :: ReadS [RelaxDepSubject]
$creadList :: ReadS [RelaxDepSubject]
readsPrec :: Int -> ReadS RelaxDepSubject
$creadsPrec :: Int -> ReadS RelaxDepSubject
Read, Int -> RelaxDepSubject -> ShowS
[RelaxDepSubject] -> ShowS
RelaxDepSubject -> String
(Int -> RelaxDepSubject -> ShowS)
-> (RelaxDepSubject -> String)
-> ([RelaxDepSubject] -> ShowS)
-> Show RelaxDepSubject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RelaxDepSubject] -> ShowS
$cshowList :: [RelaxDepSubject] -> ShowS
show :: RelaxDepSubject -> String
$cshow :: RelaxDepSubject -> String
showsPrec :: Int -> RelaxDepSubject -> ShowS
$cshowsPrec :: Int -> RelaxDepSubject -> ShowS
Show, (forall x. RelaxDepSubject -> Rep RelaxDepSubject x)
-> (forall x. Rep RelaxDepSubject x -> RelaxDepSubject)
-> Generic RelaxDepSubject
forall x. Rep RelaxDepSubject x -> RelaxDepSubject
forall x. RelaxDepSubject -> Rep RelaxDepSubject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RelaxDepSubject x -> RelaxDepSubject
$cfrom :: forall x. RelaxDepSubject -> Rep RelaxDepSubject x
Generic)

instance Pretty RelaxedDep where
  pretty :: RelaxedDep -> Doc
pretty (RelaxedDep RelaxDepScope
scope RelaxDepMod
rdmod RelaxDepSubject
subj) = case RelaxDepScope
scope of
      RelaxDepScope
RelaxDepScopeAll          -> String -> Doc
Disp.text String
"*:"               Doc -> Doc -> Doc
Disp.<> Doc
modDep
      RelaxDepScopePackage   PackageName
p0 -> PackageName -> Doc
forall a. Pretty a => a -> Doc
pretty PackageName
p0 Doc -> Doc -> Doc
Disp.<> Doc
Disp.colon Doc -> Doc -> Doc
Disp.<> Doc
modDep
      RelaxDepScopePackageId PackageId
p0 -> PackageId -> Doc
forall a. Pretty a => a -> Doc
pretty PackageId
p0 Doc -> Doc -> Doc
Disp.<> Doc
Disp.colon Doc -> Doc -> Doc
Disp.<> Doc
modDep
    where
      modDep :: Doc
modDep = case RelaxDepMod
rdmod of
               RelaxDepMod
RelaxDepModNone  -> RelaxDepSubject -> Doc
forall a. Pretty a => a -> Doc
pretty RelaxDepSubject
subj
               RelaxDepMod
RelaxDepModCaret -> Char -> Doc
Disp.char Char
'^' Doc -> Doc -> Doc
Disp.<> RelaxDepSubject -> Doc
forall a. Pretty a => a -> Doc
pretty RelaxDepSubject
subj

instance Parsec RelaxedDep where
    parsec :: m RelaxedDep
parsec = Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'*' m Char -> m RelaxedDep -> m RelaxedDep
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m RelaxedDep
forall (m :: * -> *). CabalParsing m => m RelaxedDep
relaxedDepStarP m RelaxedDep -> m RelaxedDep -> m RelaxedDep
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (m PackageId
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec m PackageId -> (PackageId -> m RelaxedDep) -> m RelaxedDep
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PackageId -> m RelaxedDep
forall (m :: * -> *). CabalParsing m => PackageId -> m RelaxedDep
relaxedDepPkgidP)

-- continuation after *
relaxedDepStarP :: CabalParsing m => m RelaxedDep
relaxedDepStarP :: m RelaxedDep
relaxedDepStarP =
    RelaxDepScope -> RelaxDepMod -> RelaxDepSubject -> RelaxedDep
RelaxedDep RelaxDepScope
RelaxDepScopeAll (RelaxDepMod -> RelaxDepSubject -> RelaxedDep)
-> m Char -> m (RelaxDepMod -> RelaxDepSubject -> RelaxedDep)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
':' m (RelaxDepMod -> RelaxDepSubject -> RelaxedDep)
-> m RelaxDepMod -> m (RelaxDepSubject -> RelaxedDep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m RelaxDepMod
forall (m :: * -> *). CharParsing m => m RelaxDepMod
modP m (RelaxDepSubject -> RelaxedDep)
-> m RelaxDepSubject -> m RelaxedDep
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m RelaxDepSubject
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
    m RelaxedDep -> m RelaxedDep -> m RelaxedDep
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RelaxedDep -> m RelaxedDep
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelaxDepScope -> RelaxDepMod -> RelaxDepSubject -> RelaxedDep
RelaxedDep RelaxDepScope
RelaxDepScopeAll RelaxDepMod
RelaxDepModNone RelaxDepSubject
RelaxDepSubjectAll)

-- continuation after package identifier
relaxedDepPkgidP :: CabalParsing m => PackageIdentifier -> m RelaxedDep
relaxedDepPkgidP :: PackageId -> m RelaxedDep
relaxedDepPkgidP pid :: PackageId
pid@(PackageIdentifier PackageName
pn Version
v)
    | PackageName
pn PackageName -> PackageName -> Bool
forall a. Eq a => a -> a -> Bool
== String -> PackageName
mkPackageName String
"all"
    , Version
v Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version
nullVersion
    =  RelaxDepScope -> RelaxDepMod -> RelaxDepSubject -> RelaxedDep
RelaxedDep RelaxDepScope
RelaxDepScopeAll (RelaxDepMod -> RelaxDepSubject -> RelaxedDep)
-> m Char -> m (RelaxDepMod -> RelaxDepSubject -> RelaxedDep)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
':' m (RelaxDepMod -> RelaxDepSubject -> RelaxedDep)
-> m RelaxDepMod -> m (RelaxDepSubject -> RelaxedDep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m RelaxDepMod
forall (m :: * -> *). CharParsing m => m RelaxDepMod
modP m (RelaxDepSubject -> RelaxedDep)
-> m RelaxDepSubject -> m RelaxedDep
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m RelaxDepSubject
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
    m RelaxedDep -> m RelaxedDep -> m RelaxedDep
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RelaxedDep -> m RelaxedDep
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelaxDepScope -> RelaxDepMod -> RelaxDepSubject -> RelaxedDep
RelaxedDep RelaxDepScope
RelaxDepScopeAll RelaxDepMod
RelaxDepModNone RelaxDepSubject
RelaxDepSubjectAll)

    | Version
v Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version
nullVersion
    = RelaxDepScope -> RelaxDepMod -> RelaxDepSubject -> RelaxedDep
RelaxedDep (PackageName -> RelaxDepScope
RelaxDepScopePackage PackageName
pn) (RelaxDepMod -> RelaxDepSubject -> RelaxedDep)
-> m Char -> m (RelaxDepMod -> RelaxDepSubject -> RelaxedDep)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
':' m (RelaxDepMod -> RelaxDepSubject -> RelaxedDep)
-> m RelaxDepMod -> m (RelaxDepSubject -> RelaxedDep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m RelaxDepMod
forall (m :: * -> *). CharParsing m => m RelaxDepMod
modP m (RelaxDepSubject -> RelaxedDep)
-> m RelaxDepSubject -> m RelaxedDep
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m RelaxDepSubject
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
    m RelaxedDep -> m RelaxedDep -> m RelaxedDep
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RelaxedDep -> m RelaxedDep
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelaxDepScope -> RelaxDepMod -> RelaxDepSubject -> RelaxedDep
RelaxedDep RelaxDepScope
RelaxDepScopeAll RelaxDepMod
RelaxDepModNone (PackageName -> RelaxDepSubject
RelaxDepSubjectPkg PackageName
pn))

    | Bool
otherwise
    = RelaxDepScope -> RelaxDepMod -> RelaxDepSubject -> RelaxedDep
RelaxedDep (PackageId -> RelaxDepScope
RelaxDepScopePackageId PackageId
pid) (RelaxDepMod -> RelaxDepSubject -> RelaxedDep)
-> m Char -> m (RelaxDepMod -> RelaxDepSubject -> RelaxedDep)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
':' m (RelaxDepMod -> RelaxDepSubject -> RelaxedDep)
-> m RelaxDepMod -> m (RelaxDepSubject -> RelaxedDep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m RelaxDepMod
forall (m :: * -> *). CharParsing m => m RelaxDepMod
modP m (RelaxDepSubject -> RelaxedDep)
-> m RelaxDepSubject -> m RelaxedDep
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m RelaxDepSubject
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec

modP :: P.CharParsing m => m RelaxDepMod
modP :: m RelaxDepMod
modP = RelaxDepMod
RelaxDepModCaret RelaxDepMod -> m Char -> m RelaxDepMod
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'^' m RelaxDepMod -> m RelaxDepMod -> m RelaxDepMod
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RelaxDepMod -> m RelaxDepMod
forall (f :: * -> *) a. Applicative f => a -> f a
pure RelaxDepMod
RelaxDepModNone

instance Pretty RelaxDepSubject where
  pretty :: RelaxDepSubject -> Doc
pretty RelaxDepSubject
RelaxDepSubjectAll      = String -> Doc
Disp.text String
"*"
  pretty (RelaxDepSubjectPkg PackageName
pn) = PackageName -> Doc
forall a. Pretty a => a -> Doc
pretty PackageName
pn

instance Parsec RelaxDepSubject where
  parsec :: m RelaxDepSubject
parsec = RelaxDepSubject
RelaxDepSubjectAll RelaxDepSubject -> m Char -> m RelaxDepSubject
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'*' m RelaxDepSubject -> m RelaxDepSubject -> m RelaxDepSubject
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m RelaxDepSubject
pkgn
    where
      pkgn :: m RelaxDepSubject
pkgn = do
          PackageName
pn <- m PackageName
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
          RelaxDepSubject -> m RelaxDepSubject
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelaxDepSubject -> m RelaxDepSubject)
-> RelaxDepSubject -> m RelaxDepSubject
forall a b. (a -> b) -> a -> b
$ if PackageName
pn PackageName -> PackageName -> Bool
forall a. Eq a => a -> a -> Bool
== String -> PackageName
mkPackageName String
"all"
              then RelaxDepSubject
RelaxDepSubjectAll
              else PackageName -> RelaxDepSubject
RelaxDepSubjectPkg PackageName
pn

instance Pretty RelaxDeps where
  pretty :: RelaxDeps -> Doc
pretty RelaxDeps
rd | Bool -> Bool
not (RelaxDeps -> Bool
isRelaxDeps RelaxDeps
rd) = String -> Doc
Disp.text String
"none"
  pretty (RelaxDepsSome [RelaxedDep]
pkgs)      = [Doc] -> Doc
Disp.fsep ([Doc] -> Doc) -> ([RelaxedDep] -> [Doc]) -> [RelaxedDep] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                   Doc -> [Doc] -> [Doc]
Disp.punctuate Doc
Disp.comma ([Doc] -> [Doc])
-> ([RelaxedDep] -> [Doc]) -> [RelaxedDep] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                   (RelaxedDep -> Doc) -> [RelaxedDep] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map RelaxedDep -> Doc
forall a. Pretty a => a -> Doc
pretty ([RelaxedDep] -> Doc) -> [RelaxedDep] -> Doc
forall a b. (a -> b) -> a -> b
$ [RelaxedDep]
pkgs
  pretty RelaxDeps
RelaxDepsAll              = String -> Doc
Disp.text String
"all"

-- |
--
-- >>> simpleParsec "all" :: Maybe RelaxDeps
-- Just RelaxDepsAll
--
-- >>> simpleParsec "none" :: Maybe RelaxDeps
-- Just (RelaxDepsSome [])
--
-- >>> simpleParsec "*, *" :: Maybe RelaxDeps
-- Just RelaxDepsAll
--
-- >>> simpleParsec "*:*" :: Maybe RelaxDeps
-- Just RelaxDepsAll
--
-- >>> simpleParsec "foo:bar, quu:puu" :: Maybe RelaxDeps
-- Just (RelaxDepsSome [RelaxedDep (RelaxDepScopePackage (PackageName "foo")) RelaxDepModNone (RelaxDepSubjectPkg (PackageName "bar")),RelaxedDep (RelaxDepScopePackage (PackageName "quu")) RelaxDepModNone (RelaxDepSubjectPkg (PackageName "puu"))])
--
-- This is not a glitch, even it looks like:
--
-- >>> simpleParsec ", all" :: Maybe RelaxDeps
-- Just RelaxDepsAll
--
-- >>> simpleParsec "" :: Maybe RelaxDeps
-- Nothing
--
instance Parsec RelaxDeps where
    parsec :: m RelaxDeps
parsec = do
        NonEmpty RelaxedDep
xs <- m RelaxedDep -> m (NonEmpty RelaxedDep)
forall (m :: * -> *) a. CabalParsing m => m a -> m (NonEmpty a)
parsecLeadingCommaNonEmpty m RelaxedDep
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
        RelaxDeps -> m RelaxDeps
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelaxDeps -> m RelaxDeps) -> RelaxDeps -> m RelaxDeps
forall a b. (a -> b) -> a -> b
$ case NonEmpty RelaxedDep -> [RelaxedDep]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty RelaxedDep
xs of
            [RelaxedDep RelaxDepScope
RelaxDepScopeAll RelaxDepMod
RelaxDepModNone RelaxDepSubject
RelaxDepSubjectAll]
                -> RelaxDeps
RelaxDepsAll
            [RelaxedDep RelaxDepScope
RelaxDepScopeAll RelaxDepMod
RelaxDepModNone (RelaxDepSubjectPkg PackageName
pn)]
                | PackageName
pn PackageName -> PackageName -> Bool
forall a. Eq a => a -> a -> Bool
== String -> PackageName
mkPackageName String
"none"
                -> RelaxDeps
forall a. Monoid a => a
mempty
            [RelaxedDep]
xs' -> [RelaxedDep] -> RelaxDeps
mkRelaxDepSome [RelaxedDep]
xs'

instance Binary RelaxDeps
instance Binary RelaxDepMod
instance Binary RelaxDepScope
instance Binary RelaxDepSubject
instance Binary RelaxedDep
instance Binary AllowNewer
instance Binary AllowOlder

instance Structured RelaxDeps
instance Structured RelaxDepMod
instance Structured RelaxDepScope
instance Structured RelaxDepSubject
instance Structured RelaxedDep
instance Structured AllowNewer
instance Structured AllowOlder

-- | Return 'True' if 'RelaxDeps' specifies a non-empty set of relaxations
--
-- Equivalent to @isRelaxDeps = (/= 'mempty')@
isRelaxDeps :: RelaxDeps -> Bool
isRelaxDeps :: RelaxDeps -> Bool
isRelaxDeps (RelaxDepsSome [])    = Bool
False
isRelaxDeps (RelaxDepsSome (RelaxedDep
_:[RelaxedDep]
_)) = Bool
True
isRelaxDeps RelaxDeps
RelaxDepsAll          = Bool
True

-- | A smarter 'RelaxedDepsSome', @*:*@ is the same as @all@.
mkRelaxDepSome :: [RelaxedDep] -> RelaxDeps
mkRelaxDepSome :: [RelaxedDep] -> RelaxDeps
mkRelaxDepSome [RelaxedDep]
xs
    | (RelaxedDep -> Bool) -> [RelaxedDep] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (RelaxedDep -> RelaxedDep -> Bool
forall a. Eq a => a -> a -> Bool
== RelaxDepScope -> RelaxDepMod -> RelaxDepSubject -> RelaxedDep
RelaxedDep RelaxDepScope
RelaxDepScopeAll RelaxDepMod
RelaxDepModNone RelaxDepSubject
RelaxDepSubjectAll) [RelaxedDep]
xs
    = RelaxDeps
RelaxDepsAll

    | Bool
otherwise
    = [RelaxedDep] -> RelaxDeps
RelaxDepsSome [RelaxedDep]
xs

-- | 'RelaxDepsAll' is the /absorbing element/
instance Semigroup RelaxDeps where
    -- identity element
    RelaxDepsSome []    <> :: RelaxDeps -> RelaxDeps -> RelaxDeps
<> RelaxDeps
r                   = RelaxDeps
r
    l :: RelaxDeps
l@(RelaxDepsSome [RelaxedDep]
_) <> RelaxDepsSome []    = RelaxDeps
l
    -- absorbing element
    l :: RelaxDeps
l@RelaxDeps
RelaxDepsAll      <> RelaxDeps
_                   = RelaxDeps
l
    (RelaxDepsSome   [RelaxedDep]
_) <> r :: RelaxDeps
r@RelaxDeps
RelaxDepsAll      = RelaxDeps
r
    -- combining non-{identity,absorbing} elements
    (RelaxDepsSome   [RelaxedDep]
a) <> (RelaxDepsSome [RelaxedDep]
b)   = [RelaxedDep] -> RelaxDeps
RelaxDepsSome ([RelaxedDep]
a [RelaxedDep] -> [RelaxedDep] -> [RelaxedDep]
forall a. [a] -> [a] -> [a]
++ [RelaxedDep]
b)

-- | @'RelaxDepsSome' []@ is the /identity element/
instance Monoid RelaxDeps where
  mempty :: RelaxDeps
mempty  = [RelaxedDep] -> RelaxDeps
RelaxDepsSome []
  mappend :: RelaxDeps -> RelaxDeps -> RelaxDeps
mappend = RelaxDeps -> RelaxDeps -> RelaxDeps
forall a. Semigroup a => a -> a -> a
(<>)

instance Semigroup AllowNewer where
  AllowNewer RelaxDeps
x <> :: AllowNewer -> AllowNewer -> AllowNewer
<> AllowNewer RelaxDeps
y = RelaxDeps -> AllowNewer
AllowNewer (RelaxDeps
x RelaxDeps -> RelaxDeps -> RelaxDeps
forall a. Semigroup a => a -> a -> a
<> RelaxDeps
y)

instance Semigroup AllowOlder where
  AllowOlder RelaxDeps
x <> :: AllowOlder -> AllowOlder -> AllowOlder
<> AllowOlder RelaxDeps
y = RelaxDeps -> AllowOlder
AllowOlder (RelaxDeps
x RelaxDeps -> RelaxDeps -> RelaxDeps
forall a. Semigroup a => a -> a -> a
<> RelaxDeps
y)

instance Monoid AllowNewer where
  mempty :: AllowNewer
mempty  = RelaxDeps -> AllowNewer
AllowNewer RelaxDeps
forall a. Monoid a => a
mempty
  mappend :: AllowNewer -> AllowNewer -> AllowNewer
mappend = AllowNewer -> AllowNewer -> AllowNewer
forall a. Semigroup a => a -> a -> a
(<>)

instance Monoid AllowOlder where
  mempty :: AllowOlder
mempty  = RelaxDeps -> AllowOlder
AllowOlder RelaxDeps
forall a. Monoid a => a
mempty
  mappend :: AllowOlder -> AllowOlder -> AllowOlder
mappend = AllowOlder -> AllowOlder -> AllowOlder
forall a. Semigroup a => a -> a -> a
(<>)