{-# LANGUAGE DeriveGeneric #-}
module Distribution.Solver.Types.PackageConstraint (
    PackageConstraint(..),
    showPackageConstraint,
  ) where

import Distribution.Compat.Binary (Binary(..))
import Distribution.PackageDescription (FlagAssignment, unFlagName)
import Distribution.Package (PackageName)
import Distribution.Solver.Types.OptionalStanza
import Distribution.Text (display)
import Distribution.Version (VersionRange, simplifyVersionRange)
import GHC.Generics (Generic)

-- | 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).
--
data PackageConstraint
   = PackageConstraintVersion   PackageName VersionRange
   | PackageConstraintInstalled PackageName
   | PackageConstraintSource    PackageName
   | PackageConstraintFlags     PackageName FlagAssignment
   | PackageConstraintStanzas   PackageName [OptionalStanza]
  deriving (Eq, Show, Generic)

instance Binary PackageConstraint

-- | Provide a textual representation of a package constraint
-- for debugging purposes.
--
showPackageConstraint :: PackageConstraint -> String
showPackageConstraint (PackageConstraintVersion pn vr) =
  display pn ++ " " ++ display (simplifyVersionRange vr)
showPackageConstraint (PackageConstraintInstalled pn) =
  display pn ++ " installed"
showPackageConstraint (PackageConstraintSource pn) =
  display pn ++ " source"
showPackageConstraint (PackageConstraintFlags pn fs) =
  "flags " ++ display pn ++ " " ++ unwords (map (uncurry showFlag) fs)
  where
    showFlag f True  = "+" ++ unFlagName f
    showFlag f False = "-" ++ unFlagName f
showPackageConstraint (PackageConstraintStanzas pn ss) =
  "stanzas " ++ display pn ++ " " ++ unwords (map showStanza ss)
  where
    showStanza TestStanzas  = "test"
    showStanza BenchStanzas = "bench"