{-# 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
$c== :: AllowNewer -> AllowNewer -> Bool
== :: AllowNewer -> AllowNewer -> Bool
$c/= :: AllowNewer -> AllowNewer -> Bool
/= :: 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
$creadsPrec :: Int -> ReadS AllowNewer
readsPrec :: Int -> ReadS AllowNewer
$creadList :: ReadS [AllowNewer]
readList :: ReadS [AllowNewer]
$creadPrec :: ReadPrec AllowNewer
readPrec :: ReadPrec AllowNewer
$creadListPrec :: ReadPrec [AllowNewer]
readListPrec :: ReadPrec [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
$cshowsPrec :: Int -> AllowNewer -> ShowS
showsPrec :: Int -> AllowNewer -> ShowS
$cshow :: AllowNewer -> String
show :: AllowNewer -> String
$cshowList :: [AllowNewer] -> ShowS
showList :: [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
$cfrom :: forall x. AllowNewer -> Rep AllowNewer x
from :: forall x. AllowNewer -> Rep AllowNewer x
$cto :: forall x. Rep AllowNewer x -> AllowNewer
to :: forall x. Rep AllowNewer x -> AllowNewer
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
$c== :: AllowOlder -> AllowOlder -> Bool
== :: AllowOlder -> AllowOlder -> Bool
$c/= :: AllowOlder -> AllowOlder -> Bool
/= :: 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
$creadsPrec :: Int -> ReadS AllowOlder
readsPrec :: Int -> ReadS AllowOlder
$creadList :: ReadS [AllowOlder]
readList :: ReadS [AllowOlder]
$creadPrec :: ReadPrec AllowOlder
readPrec :: ReadPrec AllowOlder
$creadListPrec :: ReadPrec [AllowOlder]
readListPrec :: ReadPrec [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
$cshowsPrec :: Int -> AllowOlder -> ShowS
showsPrec :: Int -> AllowOlder -> ShowS
$cshow :: AllowOlder -> String
show :: AllowOlder -> String
$cshowList :: [AllowOlder] -> ShowS
showList :: [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
$cfrom :: forall x. AllowOlder -> Rep AllowOlder x
from :: forall x. AllowOlder -> Rep AllowOlder x
$cto :: forall x. Rep AllowOlder x -> AllowOlder
to :: forall x. Rep AllowOlder x -> AllowOlder
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
$c== :: RelaxDeps -> RelaxDeps -> Bool
== :: RelaxDeps -> RelaxDeps -> Bool
$c/= :: RelaxDeps -> RelaxDeps -> Bool
/= :: 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
$creadsPrec :: Int -> ReadS RelaxDeps
readsPrec :: Int -> ReadS RelaxDeps
$creadList :: ReadS [RelaxDeps]
readList :: ReadS [RelaxDeps]
$creadPrec :: ReadPrec RelaxDeps
readPrec :: ReadPrec RelaxDeps
$creadListPrec :: ReadPrec [RelaxDeps]
readListPrec :: ReadPrec [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
$cshowsPrec :: Int -> RelaxDeps -> ShowS
showsPrec :: Int -> RelaxDeps -> ShowS
$cshow :: RelaxDeps -> String
show :: RelaxDeps -> String
$cshowList :: [RelaxDeps] -> ShowS
showList :: [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
$cfrom :: forall x. RelaxDeps -> Rep RelaxDeps x
from :: forall x. RelaxDeps -> Rep RelaxDeps x
$cto :: forall x. Rep RelaxDeps x -> RelaxDeps
to :: forall x. Rep RelaxDeps x -> RelaxDeps
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
$c== :: RelaxedDep -> RelaxedDep -> Bool
== :: RelaxedDep -> RelaxedDep -> Bool
$c/= :: RelaxedDep -> RelaxedDep -> Bool
/= :: 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
$creadsPrec :: Int -> ReadS RelaxedDep
readsPrec :: Int -> ReadS RelaxedDep
$creadList :: ReadS [RelaxedDep]
readList :: ReadS [RelaxedDep]
$creadPrec :: ReadPrec RelaxedDep
readPrec :: ReadPrec RelaxedDep
$creadListPrec :: ReadPrec [RelaxedDep]
readListPrec :: ReadPrec [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
$cshowsPrec :: Int -> RelaxedDep -> ShowS
showsPrec :: Int -> RelaxedDep -> ShowS
$cshow :: RelaxedDep -> String
show :: RelaxedDep -> String
$cshowList :: [RelaxedDep] -> ShowS
showList :: [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
$cfrom :: forall x. RelaxedDep -> Rep RelaxedDep x
from :: forall x. RelaxedDep -> Rep RelaxedDep x
$cto :: forall x. Rep RelaxedDep x -> RelaxedDep
to :: forall x. Rep RelaxedDep x -> RelaxedDep
Generic)

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

-- | Modifier for dependency relaxation
data RelaxDepMod
  = -- | Default semantics
    RelaxDepModNone
  | -- | Apply relaxation only to @^>=@ constraints
    RelaxDepModCaret
  deriving (RelaxDepMod -> RelaxDepMod -> Bool
(RelaxDepMod -> RelaxDepMod -> Bool)
-> (RelaxDepMod -> RelaxDepMod -> Bool) -> Eq RelaxDepMod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RelaxDepMod -> RelaxDepMod -> Bool
== :: RelaxDepMod -> RelaxDepMod -> Bool
$c/= :: RelaxDepMod -> RelaxDepMod -> Bool
/= :: 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
$creadsPrec :: Int -> ReadS RelaxDepMod
readsPrec :: Int -> ReadS RelaxDepMod
$creadList :: ReadS [RelaxDepMod]
readList :: ReadS [RelaxDepMod]
$creadPrec :: ReadPrec RelaxDepMod
readPrec :: ReadPrec RelaxDepMod
$creadListPrec :: ReadPrec [RelaxDepMod]
readListPrec :: ReadPrec [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
$cshowsPrec :: Int -> RelaxDepMod -> ShowS
showsPrec :: Int -> RelaxDepMod -> ShowS
$cshow :: RelaxDepMod -> String
show :: RelaxDepMod -> String
$cshowList :: [RelaxDepMod] -> ShowS
showList :: [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
$cfrom :: forall x. RelaxDepMod -> Rep RelaxDepMod x
from :: forall x. RelaxDepMod -> Rep RelaxDepMod x
$cto :: forall x. Rep RelaxDepMod x -> RelaxDepMod
to :: forall x. Rep RelaxDepMod x -> RelaxDepMod
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
$c== :: RelaxDepSubject -> RelaxDepSubject -> Bool
== :: RelaxDepSubject -> RelaxDepSubject -> Bool
$c/= :: RelaxDepSubject -> RelaxDepSubject -> Bool
/= :: 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
$ccompare :: RelaxDepSubject -> RelaxDepSubject -> Ordering
compare :: RelaxDepSubject -> RelaxDepSubject -> Ordering
$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
>= :: RelaxDepSubject -> RelaxDepSubject -> Bool
$cmax :: RelaxDepSubject -> RelaxDepSubject -> RelaxDepSubject
max :: RelaxDepSubject -> RelaxDepSubject -> RelaxDepSubject
$cmin :: RelaxDepSubject -> RelaxDepSubject -> RelaxDepSubject
min :: RelaxDepSubject -> RelaxDepSubject -> 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
$creadsPrec :: Int -> ReadS RelaxDepSubject
readsPrec :: Int -> ReadS RelaxDepSubject
$creadList :: ReadS [RelaxDepSubject]
readList :: ReadS [RelaxDepSubject]
$creadPrec :: ReadPrec RelaxDepSubject
readPrec :: ReadPrec RelaxDepSubject
$creadListPrec :: ReadPrec [RelaxDepSubject]
readListPrec :: ReadPrec [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
$cshowsPrec :: Int -> RelaxDepSubject -> ShowS
showsPrec :: Int -> RelaxDepSubject -> ShowS
$cshow :: RelaxDepSubject -> String
show :: RelaxDepSubject -> String
$cshowList :: [RelaxDepSubject] -> ShowS
showList :: [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
$cfrom :: forall x. RelaxDepSubject -> Rep RelaxDepSubject x
from :: forall x. RelaxDepSubject -> Rep RelaxDepSubject x
$cto :: forall x. Rep RelaxDepSubject x -> RelaxDepSubject
to :: forall x. Rep RelaxDepSubject x -> RelaxDepSubject
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 :: forall (m :: * -> *). CabalParsing m => m RelaxedDep
parsec = Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'*' m Char -> m RelaxedDep -> m RelaxedDep
forall a b. m a -> m b -> m b
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 a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (m PackageId
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m PackageId
parsec m PackageId -> (PackageId -> m RelaxedDep) -> m RelaxedDep
forall a b. m a -> (a -> m b) -> m b
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 :: forall (m :: * -> *). CabalParsing m => m RelaxedDep
relaxedDepStarP =
  RelaxDepScope -> RelaxDepMod -> RelaxDepSubject -> RelaxedDep
RelaxedDep RelaxDepScope
RelaxDepScopeAll (RelaxDepMod -> RelaxDepSubject -> RelaxedDep)
-> m Char -> m (RelaxDepMod -> RelaxDepSubject -> RelaxedDep)
forall a b. a -> m b -> m a
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 a b. m (a -> b) -> m a -> m b
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 a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m RelaxDepSubject
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m RelaxDepSubject
parsec
    m RelaxedDep -> m RelaxedDep -> m RelaxedDep
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RelaxedDep -> m RelaxedDep
forall a. a -> m a
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 :: forall (m :: * -> *). CabalParsing m => 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 a b. a -> m b -> m a
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 a b. m (a -> b) -> m a -> m b
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 a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m RelaxDepSubject
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m RelaxDepSubject
parsec
        m RelaxedDep -> m RelaxedDep -> m RelaxedDep
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RelaxedDep -> m RelaxedDep
forall a. a -> m a
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 a b. a -> m b -> m a
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 a b. m (a -> b) -> m a -> m b
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 a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m RelaxDepSubject
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m RelaxDepSubject
parsec
        m RelaxedDep -> m RelaxedDep -> m RelaxedDep
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RelaxedDep -> m RelaxedDep
forall a. a -> m a
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 a b. a -> m b -> m a
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 a b. m (a -> b) -> m a -> m b
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 a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m RelaxDepSubject
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m RelaxDepSubject
parsec

modP :: P.CharParsing m => m RelaxDepMod
modP :: forall (m :: * -> *). CharParsing m => m RelaxDepMod
modP = RelaxDepMod
RelaxDepModCaret RelaxDepMod -> m Char -> m RelaxDepMod
forall a b. a -> m b -> m a
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 a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RelaxDepMod -> m RelaxDepMod
forall a. a -> m a
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 :: forall (m :: * -> *). CabalParsing m => m RelaxDepSubject
parsec = RelaxDepSubject
RelaxDepSubjectAll RelaxDepSubject -> m Char -> m RelaxDepSubject
forall a b. a -> m b -> m a
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 a. m a -> m a -> m a
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
forall (m :: * -> *). CabalParsing m => m PackageName
parsec
        RelaxDepSubject -> m RelaxDepSubject
forall a. a -> m a
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 :: forall (m :: * -> *). CabalParsing m => 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
forall (m :: * -> *). CabalParsing m => m RelaxedDep
parsec
    RelaxDeps -> m RelaxDeps
forall a. a -> m a
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 a. NonEmpty a -> [a]
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
(<>)