    {-# LANGUAGE DeriveGeneric #-}

    -- | Per-package constraints. Package constraints must be respected by the
    -- solver. Multiple constraints for each package can be given, though obviously
    -- it is possible to construct conflicting constraints (eg impossible version
    -- range or inconsistent flag assignment).
    --
    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

    -- | Determines to what packages and in what contexts a
    -- constraint applies.
    data ConstraintScope
         -- | A scope that applies when the given package is used as a build target.
         -- In other words, the scope applies iff a goal has a top-level qualifier
         -- and its namespace matches the given package name. A namespace is
         -- considered to match a package name when it is either the default
         -- namespace (for --no-independent-goals) or it is an independent namespace
         -- with the given package name (for --independent-goals).

         -- TODO: Try to generalize the ConstraintScopes once component-based
         -- solving is implemented, and remove this special case for targets.
       = ScopeTarget PackageName
         -- | The package with the specified name and qualifier.
       | ScopeQualified Qualifier PackageName
         -- | The package with the specified name when it has a
         -- setup qualifier.
       | ScopeAnySetupQualifier PackageName
         -- | The package with the specified name regardless of
         -- qualifier.
       | ScopeAnyQualifier PackageName
      deriving (ConstraintScope -> ConstraintScope -> Bool
    (ConstraintScope -> ConstraintScope -> Bool)
    -> (ConstraintScope -> ConstraintScope -> Bool)
    -> Eq ConstraintScope
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ConstraintScope -> ConstraintScope -> Bool
    == :: ConstraintScope -> ConstraintScope -> Bool
    $c/= :: ConstraintScope -> ConstraintScope -> Bool
    /= :: ConstraintScope -> ConstraintScope -> Bool
    Eq, Int -> ConstraintScope -> ShowS
    [ConstraintScope] -> ShowS
    ConstraintScope -> String
    (Int -> ConstraintScope -> ShowS)
    -> (ConstraintScope -> String)
    -> ([ConstraintScope] -> ShowS)
    -> Show ConstraintScope
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> ConstraintScope -> ShowS
    showsPrec :: Int -> ConstraintScope -> ShowS
    $cshow :: ConstraintScope -> String
    show :: ConstraintScope -> String
    $cshowList :: [ConstraintScope] -> ShowS
    showList :: [ConstraintScope] -> ShowS
    Show)

    -- | Constructor for a common use case: the constraint applies to
    -- the package with the specified name when that package is a
    -- top-level dependency in the default namespace.
    scopeToplevel :: PackageName -> ConstraintScope
    scopeToplevel :: PackageName -> ConstraintScope
    scopeToplevel = Qualifier -> PackageName -> ConstraintScope
    ScopeQualified Qualifier
    QualToplevel

    -- | Returns the package name associated with a constraint scope.
    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 PackageName -> PackageName -> Bool
    forall a. Eq a => a -> a -> Bool
    == PackageName
    namespacePn
      in Namespace -> Bool
    namespaceMatches Namespace
    ns Bool -> Bool -> Bool
    && Qualifier
    q Qualifier -> Qualifier -> Bool
    forall a. Eq a => a -> a -> Bool
    == Qualifier
    QualToplevel Bool -> Bool -> Bool
    && PackageName
    pn PackageName -> PackageName -> Bool
    forall a. Eq a => a -> a -> Bool
    == PackageName
    pn'
    constraintScopeMatches (ScopeQualified Qualifier
    q PackageName
    pn) (Q (PackagePath Namespace
    _ Qualifier
    q') PackageName
    pn') =
        Qualifier
    q Qualifier -> Qualifier -> Bool
    forall a. Eq a => a -> a -> Bool
    == Qualifier
    q' Bool -> Bool -> Bool
    && PackageName
    pn PackageName -> PackageName -> Bool
    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 PackageName -> PackageName -> Bool
    forall a. Eq a => a -> a -> Bool
    == PackageName
    pn'
    constraintScopeMatches (ScopeAnyQualifier PackageName
    pn) (Q PackagePath
    _ PackageName
    pn') = PackageName
    pn PackageName -> PackageName -> Bool
    forall a. Eq a => a -> a -> Bool
    == PackageName
    pn'

    -- | Pretty-prints a constraint scope.
    dispConstraintScope :: ConstraintScope -> Disp.Doc
    dispConstraintScope :: ConstraintScope -> Doc
    dispConstraintScope (ScopeTarget PackageName
    pn) = PackageName -> Doc
    forall a. Pretty a => a -> Doc
    pretty PackageName
    pn Doc -> Doc -> Doc
    <<>> String -> Doc
    Disp.text String
    "." Doc -> Doc -> Doc
    <<>> PackageName -> Doc
    forall a. Pretty a => a -> Doc
    pretty PackageName
    pn
    dispConstraintScope (ScopeQualified Qualifier
    q PackageName
    pn) = Qualifier -> Doc
    dispQualifier Qualifier
    q Doc -> Doc -> Doc
    <<>> PackageName -> Doc
    forall a. Pretty a => a -> Doc
    pretty PackageName
    pn
    dispConstraintScope (ScopeAnySetupQualifier PackageName
    pn) = String -> Doc
    Disp.text String
    "setup." Doc -> Doc -> Doc
    <<>> PackageName -> Doc
    forall a. Pretty a => a -> Doc
    pretty PackageName
    pn
    dispConstraintScope (ScopeAnyQualifier PackageName
    pn) = String -> Doc
    Disp.text String
    "any." Doc -> Doc -> Doc
    <<>> PackageName -> Doc
    forall a. Pretty a => a -> Doc
    pretty PackageName
    pn

    -- | A package property is a logical predicate on packages.
    data PackageProperty
       = PackagePropertyVersion   VersionRange
       | PackagePropertyInstalled
       | PackagePropertySource
       | PackagePropertyFlags     FlagAssignment
       | PackagePropertyStanzas   [OptionalStanza]
      deriving (PackageProperty -> PackageProperty -> Bool
    (PackageProperty -> PackageProperty -> Bool)
    -> (PackageProperty -> PackageProperty -> Bool)
    -> Eq PackageProperty
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: PackageProperty -> PackageProperty -> Bool
    == :: PackageProperty -> PackageProperty -> Bool
    $c/= :: PackageProperty -> PackageProperty -> Bool
    /= :: PackageProperty -> PackageProperty -> Bool
    Eq, Int -> PackageProperty -> ShowS
    [PackageProperty] -> ShowS
    PackageProperty -> String
    (Int -> PackageProperty -> ShowS)
    -> (PackageProperty -> String)
    -> ([PackageProperty] -> ShowS)
    -> Show PackageProperty
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> PackageProperty -> ShowS
    showsPrec :: Int -> PackageProperty -> ShowS
    $cshow :: PackageProperty -> String
    show :: PackageProperty -> String
    $cshowList :: [PackageProperty] -> ShowS
    showList :: [PackageProperty] -> ShowS
    Show, (forall x. PackageProperty -> Rep PackageProperty x)
    -> (forall x. Rep PackageProperty x -> PackageProperty)
    -> Generic PackageProperty
    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
    $cfrom :: forall x. PackageProperty -> Rep PackageProperty x
    from :: forall x. PackageProperty -> Rep PackageProperty x
    $cto :: forall x. Rep PackageProperty x -> PackageProperty
    to :: forall x. Rep PackageProperty x -> PackageProperty
    Generic)

    instance Binary PackageProperty
    instance Structured PackageProperty

    -- | Pretty-prints a package property.
    dispPackageProperty :: PackageProperty -> Disp.Doc
    dispPackageProperty :: PackageProperty -> Doc
    dispPackageProperty (PackagePropertyVersion VersionRange
    verrange) = VersionRange -> Doc
    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 ([Doc] -> Doc) -> [Doc] -> Doc
    forall a b. (a -> b) -> a -> b
    $ (OptionalStanza -> Doc) -> [OptionalStanza] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> Doc
    Disp.text (String -> Doc)
    -> (OptionalStanza -> String) -> OptionalStanza -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . OptionalStanza -> String
    showStanza) [OptionalStanza]
    stanzas

    -- | A package constraint consists of a scope plus a property
    -- that must hold for all packages within that scope.
    data PackageConstraint = PackageConstraint ConstraintScope PackageProperty
      deriving (PackageConstraint -> PackageConstraint -> Bool
    (PackageConstraint -> PackageConstraint -> Bool)
    -> (PackageConstraint -> PackageConstraint -> Bool)
    -> Eq PackageConstraint
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: PackageConstraint -> PackageConstraint -> Bool
    == :: PackageConstraint -> PackageConstraint -> Bool
    $c/= :: PackageConstraint -> PackageConstraint -> Bool
    /= :: PackageConstraint -> PackageConstraint -> Bool
    Eq, Int -> PackageConstraint -> ShowS
    [PackageConstraint] -> ShowS
    PackageConstraint -> String
    (Int -> PackageConstraint -> ShowS)
    -> (PackageConstraint -> String)
    -> ([PackageConstraint] -> ShowS)
    -> Show PackageConstraint
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> PackageConstraint -> ShowS
    showsPrec :: Int -> PackageConstraint -> ShowS
    $cshow :: PackageConstraint -> String
    show :: PackageConstraint -> String
    $cshowList :: [PackageConstraint] -> ShowS
    showList :: [PackageConstraint] -> ShowS
    Show)

    -- | Pretty-prints a package constraint.
    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

    -- | Alternative textual representation of a package constraint
    -- for debugging purposes (slightly more verbose than that
    -- produced by 'dispPackageConstraint').
    --
    showPackageConstraint :: PackageConstraint -> String
    showPackageConstraint :: PackageConstraint -> String
    showPackageConstraint pc :: PackageConstraint
    pc@(PackageConstraint ConstraintScope
    scope PackageProperty
    prop) =
      Style -> Doc -> String
    Disp.renderStyle Style
    flatStyle (Doc -> String) -> (Doc -> Doc) -> Doc -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc -> Doc
    postprocess (Doc -> String) -> Doc -> String
    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 (PackageProperty -> PackageConstraint)
    -> PackageProperty -> PackageConstraint
    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
    _ -> Doc -> Doc
    forall a. a -> a
    id

    -- | Lossily convert a 'PackageConstraint' to a 'Dependency'.
    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) = PackageVersionConstraint -> Maybe PackageVersionConstraint
    forall a. a -> Maybe a
    Just (PackageVersionConstraint -> Maybe PackageVersionConstraint)
    -> PackageVersionConstraint -> Maybe PackageVersionConstraint
    forall a b. (a -> b) -> a -> b
    $ PackageName -> VersionRange -> PackageVersionConstraint
    PackageVersionConstraint (ConstraintScope -> PackageName
    scopeToPackageName ConstraintScope
    scope) VersionRange
    vr
        toDep (PackageProperty
    PackagePropertyInstalled)  = Maybe PackageVersionConstraint
    forall a. Maybe a
    Nothing
        toDep (PackageProperty
    PackagePropertySource)     = Maybe PackageVersionConstraint
    forall a. Maybe a
    Nothing
        toDep (PackagePropertyFlags FlagAssignment
    _)    = Maybe PackageVersionConstraint
    forall a. Maybe a
    Nothing
        toDep (PackagePropertyStanzas [OptionalStanza]
    _)  = Maybe PackageVersionConstraint
    forall a. Maybe a
    Nothing