{-# 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
(Loc -> Loc -> Bool) -> (Loc -> Loc -> Bool) -> Eq Loc
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
Eq Loc
-> (Loc -> Loc -> Ordering)
-> (Loc -> Loc -> Bool)
-> (Loc -> Loc -> Bool)
-> (Loc -> Loc -> Bool)
-> (Loc -> Loc -> Bool)
-> (Loc -> Loc -> Loc)
-> (Loc -> Loc -> Loc)
-> Ord 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
$cp1Ord :: Eq Loc
Ord, Int -> Loc -> ShowS
[Loc] -> ShowS
Loc -> String
(Int -> Loc -> ShowS)
-> (Loc -> String) -> ([Loc] -> ShowS) -> Show Loc
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
(I -> I -> Bool) -> (I -> I -> Bool) -> Eq I
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
Eq I
-> (I -> I -> Ordering)
-> (I -> I -> Bool)
-> (I -> I -> Bool)
-> (I -> I -> Bool)
-> (I -> I -> Bool)
-> (I -> I -> I)
-> (I -> I -> I)
-> Ord 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
$cp1Ord :: Eq I
Ord, Int -> I -> ShowS
[I] -> ShowS
I -> String
(Int -> I -> ShowS) -> (I -> String) -> ([I] -> ShowS) -> Show I
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 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/installed" String -> ShowS
forall a. [a] -> [a] -> [a]
++ PId -> String
forall a. Pretty a => a -> String
extractPackageAbiHash PId
uid
  where
    extractPackageAbiHash :: a -> String
extractPackageAbiHash a
xs =
      case ShowS -> (String, String) -> (String, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ShowS
forall a. [a] -> [a]
reverse ((String, String) -> (String, String))
-> (String, String) -> (String, String)
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'-') (String -> (String, String)) -> String -> (String, String)
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. [a] -> [a]
reverse (a -> String
forall a. Pretty a => a -> String
prettyShow a
xs) of
        (String
ys, []) -> String
ys
        (String
ys, String
_)  -> Char
'-' Char -> ShowS
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
(PI qpn -> PI qpn -> Bool)
-> (PI qpn -> PI qpn -> Bool) -> Eq (PI qpn)
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, Eq (PI qpn)
Eq (PI qpn)
-> (PI qpn -> PI qpn -> Ordering)
-> (PI qpn -> PI qpn -> Bool)
-> (PI qpn -> PI qpn -> Bool)
-> (PI qpn -> PI qpn -> Bool)
-> (PI qpn -> PI qpn -> Bool)
-> (PI qpn -> PI qpn -> PI qpn)
-> (PI qpn -> PI qpn -> PI qpn)
-> Ord (PI qpn)
PI qpn -> PI qpn -> Bool
PI qpn -> PI qpn -> Ordering
PI qpn -> PI qpn -> PI qpn
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
$cp1Ord :: forall qpn. Ord qpn => Eq (PI qpn)
Ord, Int -> PI qpn -> ShowS
[PI qpn] -> ShowS
PI qpn -> String
(Int -> PI qpn -> ShowS)
-> (PI qpn -> String) -> ([PI qpn] -> ShowS) -> Show (PI qpn)
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, a -> PI b -> PI a
(a -> b) -> PI a -> PI b
(forall a b. (a -> b) -> PI a -> PI b)
-> (forall a b. a -> PI b -> PI a) -> Functor PI
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
<$ :: a -> PI b -> PI a
$c<$ :: forall a b. a -> PI b -> PI a
fmap :: (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 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"-" String -> ShowS
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 = PackagePath -> PN -> QPN
forall a. PackagePath -> a -> Qualified a
Q (Namespace -> Qualifier -> PackagePath
PackagePath (PN -> Namespace
Independent PN
pn) Qualifier
QualToplevel) PN
pn