{-# LANGUAGE DeriveFunctor #-}
module Distribution.Solver.Modular.Package
  ( I(..)
  , Loc(..)
  , PackageId
  , PackageIdentifier(..)
  , PackageName, mkPackageName, unPackageName
  , PkgconfigName, mkPkgconfigName, unPkgconfigName
  , PI(..)
  , PN
  , QPV
  , instI
  , makeIndependent
  , primaryPP
  , setupPP
  , showI
  , showPI
  , unPN
  ) where

import Prelude ()
import Distribution.Solver.Compat.Prelude

import Distribution.Package -- from Cabal
import Distribution.Pretty (prettyShow)

import Distribution.Solver.Modular.Version
import Distribution.Solver.Types.PackagePath

-- | A package name.
type PN = PackageName

-- | Unpacking a package name.
unPN :: PN -> String
unPN :: PN -> String
unPN = PN -> String
unPackageName

-- | Package version. A package name plus a version number.
type PV = PackageId

-- | Qualified package version.
type QPV = Qualified PV

-- | Package id. Currently just a black-box string.
type PId = UnitId

-- | Location. Info about whether a package is installed or not, and where
-- exactly it is located. For installed packages, uniquely identifies the
-- package instance via its 'PId'.
--
-- TODO: More information is needed about the repo.
data Loc = Inst PId | InRepo
  deriving (Loc -> Loc -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Loc -> Loc -> Bool
$c/= :: Loc -> Loc -> Bool
== :: Loc -> Loc -> Bool
$c== :: Loc -> Loc -> Bool
Eq, Eq Loc
Loc -> Loc -> Bool
Loc -> Loc -> Ordering
Loc -> Loc -> Loc
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
min :: Loc -> Loc -> Loc
$cmin :: Loc -> Loc -> Loc
max :: Loc -> Loc -> Loc
$cmax :: Loc -> Loc -> Loc
>= :: Loc -> Loc -> Bool
$c>= :: Loc -> Loc -> Bool
> :: Loc -> Loc -> Bool
$c> :: Loc -> Loc -> Bool
<= :: Loc -> Loc -> Bool
$c<= :: Loc -> Loc -> Bool
< :: Loc -> Loc -> Bool
$c< :: Loc -> Loc -> Bool
compare :: Loc -> Loc -> Ordering
$ccompare :: Loc -> Loc -> Ordering
Ord, Int -> Loc -> ShowS
[Loc] -> ShowS
Loc -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Loc] -> ShowS
$cshowList :: [Loc] -> ShowS
show :: Loc -> String
$cshow :: Loc -> String
showsPrec :: Int -> Loc -> ShowS
$cshowsPrec :: Int -> Loc -> ShowS
Show)

-- | Instance. A version number and a location.
data I = I Ver Loc
  deriving (I -> I -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: I -> I -> Bool
$c/= :: I -> I -> Bool
== :: I -> I -> Bool
$c== :: I -> I -> Bool
Eq, Eq I
I -> I -> Bool
I -> I -> Ordering
I -> I -> I
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
min :: I -> I -> I
$cmin :: I -> I -> I
max :: I -> I -> I
$cmax :: I -> I -> I
>= :: I -> I -> Bool
$c>= :: I -> I -> Bool
> :: I -> I -> Bool
$c> :: I -> I -> Bool
<= :: I -> I -> Bool
$c<= :: I -> I -> Bool
< :: I -> I -> Bool
$c< :: I -> I -> Bool
compare :: I -> I -> Ordering
$ccompare :: I -> I -> Ordering
Ord, Int -> I -> ShowS
[I] -> ShowS
I -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [I] -> ShowS
$cshowList :: [I] -> ShowS
show :: I -> String
$cshow :: I -> String
showsPrec :: Int -> I -> ShowS
$cshowsPrec :: Int -> I -> ShowS
Show)

-- | String representation of an instance.
showI :: I -> String
showI :: I -> String
showI (I Ver
v Loc
InRepo)   = Ver -> String
showVer Ver
v
showI (I Ver
v (Inst PId
uid)) = Ver -> String
showVer Ver
v forall a. [a] -> [a] -> [a]
++ String
"/installed" forall a. [a] -> [a] -> [a]
++ forall {a}. Pretty a => a -> String
extractPackageAbiHash PId
uid
  where
    extractPackageAbiHash :: a -> String
extractPackageAbiHash a
xs =
      case forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
==Char
'-') forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse (forall {a}. Pretty a => a -> String
prettyShow a
xs) of
        (String
ys, []) -> String
ys
        (String
ys, String
_)  -> Char
'-' forall a. a -> [a] -> [a]
: String
ys

-- | Package instance. A package name and an instance.
data PI qpn = PI qpn I
  deriving (PI qpn -> PI qpn -> Bool
forall qpn. Eq qpn => PI qpn -> PI qpn -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PI qpn -> PI qpn -> Bool
$c/= :: forall qpn. Eq qpn => PI qpn -> PI qpn -> Bool
== :: PI qpn -> PI qpn -> Bool
$c== :: forall qpn. Eq qpn => PI qpn -> PI qpn -> Bool
Eq, PI qpn -> PI qpn -> Bool
PI qpn -> PI qpn -> Ordering
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
forall {qpn}. Ord qpn => Eq (PI qpn)
forall qpn. Ord qpn => PI qpn -> PI qpn -> Bool
forall qpn. Ord qpn => PI qpn -> PI qpn -> Ordering
forall qpn. Ord qpn => PI qpn -> PI qpn -> PI qpn
min :: PI qpn -> PI qpn -> PI qpn
$cmin :: forall qpn. Ord qpn => PI qpn -> PI qpn -> PI qpn
max :: PI qpn -> PI qpn -> PI qpn
$cmax :: forall qpn. Ord qpn => PI qpn -> PI qpn -> PI qpn
>= :: PI qpn -> PI qpn -> Bool
$c>= :: forall qpn. Ord qpn => PI qpn -> PI qpn -> Bool
> :: PI qpn -> PI qpn -> Bool
$c> :: forall qpn. Ord qpn => PI qpn -> PI qpn -> Bool
<= :: PI qpn -> PI qpn -> Bool
$c<= :: forall qpn. Ord qpn => PI qpn -> PI qpn -> Bool
< :: PI qpn -> PI qpn -> Bool
$c< :: forall qpn. Ord qpn => PI qpn -> PI qpn -> Bool
compare :: PI qpn -> PI qpn -> Ordering
$ccompare :: forall qpn. Ord qpn => PI qpn -> PI qpn -> Ordering
Ord, Int -> PI qpn -> ShowS
forall qpn. Show qpn => Int -> PI qpn -> ShowS
forall qpn. Show qpn => [PI qpn] -> ShowS
forall qpn. Show qpn => PI qpn -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PI qpn] -> ShowS
$cshowList :: forall qpn. Show qpn => [PI qpn] -> ShowS
show :: PI qpn -> String
$cshow :: forall qpn. Show qpn => PI qpn -> String
showsPrec :: Int -> PI qpn -> ShowS
$cshowsPrec :: forall qpn. Show qpn => Int -> PI qpn -> ShowS
Show, forall a b. a -> PI b -> PI a
forall a b. (a -> b) -> PI a -> PI b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> PI b -> PI a
$c<$ :: forall a b. a -> PI b -> PI a
fmap :: forall a b. (a -> b) -> PI a -> PI b
$cfmap :: forall a b. (a -> b) -> PI a -> PI b
Functor)

-- | String representation of a package instance.
showPI :: PI QPN -> String
showPI :: PI QPN -> String
showPI (PI QPN
qpn I
i) = QPN -> String
showQPN QPN
qpn forall a. [a] -> [a] -> [a]
++ String
"-" forall a. [a] -> [a] -> [a]
++ I -> String
showI I
i

instI :: I -> Bool
instI :: I -> Bool
instI (I Ver
_ (Inst PId
_)) = Bool
True
instI I
_              = Bool
False

-- | Is the package in the primary group of packages.  This is used to
-- determine (1) if we should try to establish stanza preferences
-- for this goal, and (2) whether or not a user specified @--constraint@
-- should apply to this dependency (grep 'primaryPP' to see the
-- use sites).  In particular this does not include packages pulled in
-- as setup deps.
--
primaryPP :: PackagePath -> Bool
primaryPP :: PackagePath -> Bool
primaryPP (PackagePath Namespace
_ns Qualifier
q) = Qualifier -> Bool
go Qualifier
q
  where
    go :: Qualifier -> Bool
go Qualifier
QualToplevel    = Bool
True
    go (QualBase  PN
_)   = Bool
True
    go (QualSetup PN
_)   = Bool
False
    go (QualExe PN
_ PN
_)   = Bool
False

-- | Is the package a dependency of a setup script.  This is used to
-- establish whether or not certain constraints should apply to this
-- dependency (grep 'setupPP' to see the use sites).
--
setupPP :: PackagePath -> Bool
setupPP :: PackagePath -> Bool
setupPP (PackagePath Namespace
_ns (QualSetup PN
_)) = Bool
True
setupPP (PackagePath Namespace
_ns Qualifier
_)         = Bool
False

-- | Qualify a target package with its own name so that its dependencies are not
-- required to be consistent with other targets.
makeIndependent :: PN -> QPN
makeIndependent :: PN -> QPN
makeIndependent PN
pn = forall a. PackagePath -> a -> Qualified a
Q (Namespace -> Qualifier -> PackagePath
PackagePath (PN -> Namespace
Independent PN
pn) Qualifier
QualToplevel) PN
pn