{-# LANGUAGE DeriveGeneric #-}
module Distribution.Solver.Types.ConstraintSource
    ( ConstraintSource(..)
    , showConstraintSource
    ) where

import Distribution.Solver.Compat.Prelude
import Distribution.Solver.Types.ProjectConfigPath (ProjectConfigPath, docProjectConfigPath)
import Distribution.Pretty (Pretty(pretty), prettyShow)
import Text.PrettyPrint (text)

-- | Source of a 'PackageConstraint'.
data ConstraintSource =

  -- | Main config file, which is ~/.cabal/config by default.
  ConstraintSourceMainConfig FilePath

  -- | Local cabal.project file
  | ConstraintSourceProjectConfig ProjectConfigPath

  -- | User config file, which is ./cabal.config by default.
  | ConstraintSourceUserConfig FilePath

  -- | Flag specified on the command line.
  | ConstraintSourceCommandlineFlag

  -- | Target specified by the user, e.g., @cabal install package-0.1.0.0@
  -- implies @package==0.1.0.0@.
  | ConstraintSourceUserTarget

  -- | Internal requirement to use installed versions of packages like ghc-prim.
  | ConstraintSourceNonReinstallablePackage

  -- | Internal constraint used by @cabal freeze@.
  | ConstraintSourceFreeze

  -- | Constraint specified by a config file, a command line flag, or a user
  -- target, when a more specific source is not known.
  | ConstraintSourceConfigFlagOrTarget

  -- | Constraint introduced by --enable-multi-repl, which requires features
  -- from Cabal >= 3.11
  | ConstraintSourceMultiRepl

  -- | Constraint introduced by --with-repl, which requires features
  -- from Cabal >= 3.15
  | ConstraintSourceWithRepl

  -- | Constraint introduced by --enable-profiling-shared, which requires features
  -- from Cabal >= 3.13
  | ConstraintSourceProfiledDynamic

  -- | The source of the constraint is not specified.
  | ConstraintSourceUnknown

  -- | An internal constraint due to compatibility issues with the Setup.hs
  -- command line interface requires a minimum lower bound on Cabal
  | ConstraintSetupCabalMinVersion

  -- | An internal constraint due to compatibility issues with the Setup.hs
  -- command line interface requires a maximum upper bound on Cabal
  | ConstraintSetupCabalMaxVersion
  deriving (Int -> ConstraintSource -> ShowS
[ConstraintSource] -> ShowS
ConstraintSource -> String
(Int -> ConstraintSource -> ShowS)
-> (ConstraintSource -> String)
-> ([ConstraintSource] -> ShowS)
-> Show ConstraintSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConstraintSource -> ShowS
showsPrec :: Int -> ConstraintSource -> ShowS
$cshow :: ConstraintSource -> String
show :: ConstraintSource -> String
$cshowList :: [ConstraintSource] -> ShowS
showList :: [ConstraintSource] -> ShowS
Show, ConstraintSource -> ConstraintSource -> Bool
(ConstraintSource -> ConstraintSource -> Bool)
-> (ConstraintSource -> ConstraintSource -> Bool)
-> Eq ConstraintSource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConstraintSource -> ConstraintSource -> Bool
== :: ConstraintSource -> ConstraintSource -> Bool
$c/= :: ConstraintSource -> ConstraintSource -> Bool
/= :: ConstraintSource -> ConstraintSource -> Bool
Eq, (forall x. ConstraintSource -> Rep ConstraintSource x)
-> (forall x. Rep ConstraintSource x -> ConstraintSource)
-> Generic ConstraintSource
forall x. Rep ConstraintSource x -> ConstraintSource
forall x. ConstraintSource -> Rep ConstraintSource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ConstraintSource -> Rep ConstraintSource x
from :: forall x. ConstraintSource -> Rep ConstraintSource x
$cto :: forall x. Rep ConstraintSource x -> ConstraintSource
to :: forall x. Rep ConstraintSource x -> ConstraintSource
Generic)

instance Binary ConstraintSource
instance Structured ConstraintSource

-- | Description of a 'ConstraintSource'.
showConstraintSource :: ConstraintSource -> String
showConstraintSource :: ConstraintSource -> String
showConstraintSource = ConstraintSource -> String
forall a. Pretty a => a -> String
prettyShow

instance Pretty ConstraintSource where
  pretty :: ConstraintSource -> Doc
pretty ConstraintSource
constraintSource = case ConstraintSource
constraintSource of
    (ConstraintSourceMainConfig String
path) ->
      String -> Doc
text String
"main config" Doc -> Doc -> Doc
<+> String -> Doc
text String
path
    (ConstraintSourceProjectConfig ProjectConfigPath
path) ->
      String -> Doc
text String
"project config" Doc -> Doc -> Doc
<+> ProjectConfigPath -> Doc
docProjectConfigPath ProjectConfigPath
path
    (ConstraintSourceUserConfig String
path)-> String -> Doc
text String
"user config " Doc -> Doc -> Doc
<+> String -> Doc
text String
path
    ConstraintSource
ConstraintSourceCommandlineFlag -> String -> Doc
text String
"command line flag"
    ConstraintSource
ConstraintSourceUserTarget -> String -> Doc
text String
"user target"
    ConstraintSource
ConstraintSourceNonReinstallablePackage ->
      String -> Doc
text String
"non-reinstallable package"
    ConstraintSource
ConstraintSourceFreeze -> String -> Doc
text String
"cabal freeze"
    ConstraintSource
ConstraintSourceConfigFlagOrTarget ->
      String -> Doc
text String
"config file, command line flag, or user target"
    ConstraintSource
ConstraintSourceMultiRepl ->
      String -> Doc
text String
"--enable-multi-repl"
    ConstraintSource
ConstraintSourceWithRepl ->
      String -> Doc
text String
"--with-repl"
    ConstraintSource
ConstraintSourceProfiledDynamic ->
      String -> Doc
text String
"--enable-profiling-shared"
    ConstraintSource
ConstraintSourceUnknown -> String -> Doc
text String
"unknown source"
    ConstraintSource
ConstraintSetupCabalMinVersion ->
      String -> Doc
text String
"minimum version of Cabal used by Setup.hs"
    ConstraintSource
ConstraintSetupCabalMaxVersion ->
      String -> Doc
text String
"maximum version of Cabal used by Setup.hs"