{-# LANGUAGE DeriveGeneric #-}
module Distribution.Solver.Types.PackageConstraint (
ConstraintScope(..),
scopeToplevel,
scopeToPackageName,
constraintScopeMatches,
PackageProperty(..),
dispPackageProperty,
PackageConstraint(..),
dispPackageConstraint,
showPackageConstraint,
packageConstraintToDependency
) where
import Distribution.Solver.Compat.Prelude
import Prelude ()
import Distribution.Package (PackageName)
import Distribution.PackageDescription (FlagAssignment, dispFlagAssignment)
import Distribution.Pretty (flatStyle, pretty)
import Distribution.Types.PackageVersionConstraint (PackageVersionConstraint (..))
import Distribution.Version (VersionRange, simplifyVersionRange)
import Distribution.Solver.Types.OptionalStanza
import Distribution.Solver.Types.PackagePath
import qualified Text.PrettyPrint as Disp
data ConstraintScope
= ScopeTarget PackageName
| ScopeQualified Qualifier PackageName
| ScopeAnySetupQualifier PackageName
| ScopeAnyQualifier PackageName
deriving (ConstraintScope -> ConstraintScope -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConstraintScope -> ConstraintScope -> Bool
$c/= :: ConstraintScope -> ConstraintScope -> Bool
== :: ConstraintScope -> ConstraintScope -> Bool
$c== :: ConstraintScope -> ConstraintScope -> Bool
Eq, Int -> ConstraintScope -> ShowS
[ConstraintScope] -> ShowS
ConstraintScope -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConstraintScope] -> ShowS
$cshowList :: [ConstraintScope] -> ShowS
show :: ConstraintScope -> String
$cshow :: ConstraintScope -> String
showsPrec :: Int -> ConstraintScope -> ShowS
$cshowsPrec :: Int -> ConstraintScope -> ShowS
Show)
scopeToplevel :: PackageName -> ConstraintScope
scopeToplevel :: PackageName -> ConstraintScope
scopeToplevel = Qualifier -> PackageName -> ConstraintScope
ScopeQualified Qualifier
QualToplevel
scopeToPackageName :: ConstraintScope -> PackageName
scopeToPackageName :: ConstraintScope -> PackageName
scopeToPackageName (ScopeTarget PackageName
pn) = PackageName
pn
scopeToPackageName (ScopeQualified Qualifier
_ PackageName
pn) = PackageName
pn
scopeToPackageName (ScopeAnySetupQualifier PackageName
pn) = PackageName
pn
scopeToPackageName (ScopeAnyQualifier PackageName
pn) = PackageName
pn
constraintScopeMatches :: ConstraintScope -> QPN -> Bool
constraintScopeMatches :: ConstraintScope -> QPN -> Bool
constraintScopeMatches (ScopeTarget PackageName
pn) (Q (PackagePath Namespace
ns Qualifier
q) PackageName
pn') =
let namespaceMatches :: Namespace -> Bool
namespaceMatches Namespace
DefaultNamespace = Bool
True
namespaceMatches (Independent PackageName
namespacePn) = PackageName
pn forall a. Eq a => a -> a -> Bool
== PackageName
namespacePn
in Namespace -> Bool
namespaceMatches Namespace
ns Bool -> Bool -> Bool
&& Qualifier
q forall a. Eq a => a -> a -> Bool
== Qualifier
QualToplevel Bool -> Bool -> Bool
&& PackageName
pn forall a. Eq a => a -> a -> Bool
== PackageName
pn'
constraintScopeMatches (ScopeQualified Qualifier
q PackageName
pn) (Q (PackagePath Namespace
_ Qualifier
q') PackageName
pn') =
Qualifier
q forall a. Eq a => a -> a -> Bool
== Qualifier
q' Bool -> Bool -> Bool
&& PackageName
pn forall a. Eq a => a -> a -> Bool
== PackageName
pn'
constraintScopeMatches (ScopeAnySetupQualifier PackageName
pn) (Q PackagePath
pp PackageName
pn') =
let setup :: PackagePath -> Bool
setup (PackagePath Namespace
_ (QualSetup PackageName
_)) = Bool
True
setup PackagePath
_ = Bool
False
in PackagePath -> Bool
setup PackagePath
pp Bool -> Bool -> Bool
&& PackageName
pn forall a. Eq a => a -> a -> Bool
== PackageName
pn'
constraintScopeMatches (ScopeAnyQualifier PackageName
pn) (Q PackagePath
_ PackageName
pn') = PackageName
pn forall a. Eq a => a -> a -> Bool
== PackageName
pn'
dispConstraintScope :: ConstraintScope -> Disp.Doc
dispConstraintScope :: ConstraintScope -> Doc
dispConstraintScope (ScopeTarget PackageName
pn) = forall a. Pretty a => a -> Doc
pretty PackageName
pn Doc -> Doc -> Doc
<<>> String -> Doc
Disp.text String
"." Doc -> Doc -> Doc
<<>> forall a. Pretty a => a -> Doc
pretty PackageName
pn
dispConstraintScope (ScopeQualified Qualifier
q PackageName
pn) = Qualifier -> Doc
dispQualifier Qualifier
q Doc -> Doc -> Doc
<<>> forall a. Pretty a => a -> Doc
pretty PackageName
pn
dispConstraintScope (ScopeAnySetupQualifier PackageName
pn) = String -> Doc
Disp.text String
"setup." Doc -> Doc -> Doc
<<>> forall a. Pretty a => a -> Doc
pretty PackageName
pn
dispConstraintScope (ScopeAnyQualifier PackageName
pn) = String -> Doc
Disp.text String
"any." Doc -> Doc -> Doc
<<>> forall a. Pretty a => a -> Doc
pretty PackageName
pn
data PackageProperty
= PackagePropertyVersion VersionRange
| PackagePropertyInstalled
| PackagePropertySource
| PackagePropertyFlags FlagAssignment
| PackagePropertyStanzas [OptionalStanza]
deriving (PackageProperty -> PackageProperty -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PackageProperty -> PackageProperty -> Bool
$c/= :: PackageProperty -> PackageProperty -> Bool
== :: PackageProperty -> PackageProperty -> Bool
$c== :: PackageProperty -> PackageProperty -> Bool
Eq, Int -> PackageProperty -> ShowS
[PackageProperty] -> ShowS
PackageProperty -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PackageProperty] -> ShowS
$cshowList :: [PackageProperty] -> ShowS
show :: PackageProperty -> String
$cshow :: PackageProperty -> String
showsPrec :: Int -> PackageProperty -> ShowS
$cshowsPrec :: Int -> PackageProperty -> ShowS
Show, forall x. Rep PackageProperty x -> PackageProperty
forall x. PackageProperty -> Rep PackageProperty x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PackageProperty x -> PackageProperty
$cfrom :: forall x. PackageProperty -> Rep PackageProperty x
Generic)
instance Binary PackageProperty
instance Structured PackageProperty
dispPackageProperty :: PackageProperty -> Disp.Doc
dispPackageProperty :: PackageProperty -> Doc
dispPackageProperty (PackagePropertyVersion VersionRange
verrange) = forall a. Pretty a => a -> Doc
pretty VersionRange
verrange
dispPackageProperty PackageProperty
PackagePropertyInstalled = String -> Doc
Disp.text String
"installed"
dispPackageProperty PackageProperty
PackagePropertySource = String -> Doc
Disp.text String
"source"
dispPackageProperty (PackagePropertyFlags FlagAssignment
flags) = FlagAssignment -> Doc
dispFlagAssignment FlagAssignment
flags
dispPackageProperty (PackagePropertyStanzas [OptionalStanza]
stanzas) =
[Doc] -> Doc
Disp.hsep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (String -> Doc
Disp.text forall b c a. (b -> c) -> (a -> b) -> a -> c
. OptionalStanza -> String
showStanza) [OptionalStanza]
stanzas
data PackageConstraint = PackageConstraint ConstraintScope PackageProperty
deriving (PackageConstraint -> PackageConstraint -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PackageConstraint -> PackageConstraint -> Bool
$c/= :: PackageConstraint -> PackageConstraint -> Bool
== :: PackageConstraint -> PackageConstraint -> Bool
$c== :: PackageConstraint -> PackageConstraint -> Bool
Eq, Int -> PackageConstraint -> ShowS
[PackageConstraint] -> ShowS
PackageConstraint -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PackageConstraint] -> ShowS
$cshowList :: [PackageConstraint] -> ShowS
show :: PackageConstraint -> String
$cshow :: PackageConstraint -> String
showsPrec :: Int -> PackageConstraint -> ShowS
$cshowsPrec :: Int -> PackageConstraint -> ShowS
Show)
dispPackageConstraint :: PackageConstraint -> Disp.Doc
dispPackageConstraint :: PackageConstraint -> Doc
dispPackageConstraint (PackageConstraint ConstraintScope
scope PackageProperty
prop) =
ConstraintScope -> Doc
dispConstraintScope ConstraintScope
scope Doc -> Doc -> Doc
<+> PackageProperty -> Doc
dispPackageProperty PackageProperty
prop
showPackageConstraint :: PackageConstraint -> String
showPackageConstraint :: PackageConstraint -> String
showPackageConstraint pc :: PackageConstraint
pc@(PackageConstraint ConstraintScope
scope PackageProperty
prop) =
Style -> Doc -> String
Disp.renderStyle Style
flatStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
postprocess forall a b. (a -> b) -> a -> b
$ PackageConstraint -> Doc
dispPackageConstraint PackageConstraint
pc2
where
pc2 :: PackageConstraint
pc2 = case PackageProperty
prop of
PackagePropertyVersion VersionRange
vr ->
ConstraintScope -> PackageProperty -> PackageConstraint
PackageConstraint ConstraintScope
scope forall a b. (a -> b) -> a -> b
$ VersionRange -> PackageProperty
PackagePropertyVersion (VersionRange -> VersionRange
simplifyVersionRange VersionRange
vr)
PackageProperty
_ -> PackageConstraint
pc
postprocess :: Doc -> Doc
postprocess = case PackageProperty
prop of
PackagePropertyFlags FlagAssignment
_ -> (String -> Doc
Disp.text String
"flags" Doc -> Doc -> Doc
<+>)
PackagePropertyStanzas [OptionalStanza]
_ -> (String -> Doc
Disp.text String
"stanzas" Doc -> Doc -> Doc
<+>)
PackageProperty
_ -> forall a. a -> a
id
packageConstraintToDependency :: PackageConstraint -> Maybe PackageVersionConstraint
packageConstraintToDependency :: PackageConstraint -> Maybe PackageVersionConstraint
packageConstraintToDependency (PackageConstraint ConstraintScope
scope PackageProperty
prop) = PackageProperty -> Maybe PackageVersionConstraint
toDep PackageProperty
prop
where
toDep :: PackageProperty -> Maybe PackageVersionConstraint
toDep (PackagePropertyVersion VersionRange
vr) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ PackageName -> VersionRange -> PackageVersionConstraint
PackageVersionConstraint (ConstraintScope -> PackageName
scopeToPackageName ConstraintScope
scope) VersionRange
vr
toDep (PackageProperty
PackagePropertyInstalled) = forall a. Maybe a
Nothing
toDep (PackageProperty
PackagePropertySource) = forall a. Maybe a
Nothing
toDep (PackagePropertyFlags FlagAssignment
_) = forall a. Maybe a
Nothing
toDep (PackagePropertyStanzas [OptionalStanza]
_) = forall a. Maybe a
Nothing