Package.hs

{-# LANGUAGE DeriveFunctor #-}
module Distribution.Client.Dependency.Modular.Package
  (module Distribution.Client.Dependency.Modular.Package,
   module Distribution.Package) where

import Data.List as L
import Data.Map as M

import Distribution.Package -- from Cabal
import Distribution.Text    -- from Cabal

import Distribution.Client.Dependency.Modular.Version

-- | A package name.
type PN = PackageName

-- | Unpacking a package name.
unPN :: PN -> String
unPN (PackageName pn) = pn

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

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

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

-- | 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 (Eq, Ord, Show)

-- | Instance. A version number and a location.
data I = I Ver Loc
  deriving (Eq, Ord, Show)

-- | String representation of an instance.
showI :: I -> String
showI (I v InRepo)   = showVer v
showI (I v (Inst (InstalledPackageId i))) = showVer v ++ "/installed" ++ shortId i
  where
    -- A hack to extract the beginning of the package ABI hash
    shortId = snip (splitAt 4) (++ "...") .
              snip ((\ (x, y) -> (reverse x, y)) . break (=='-') . reverse) ('-':)
    snip p f xs = case p xs of
                    (ys, zs) -> (if L.null zs then id else f) ys

-- | Package instance. A package name and an instance.
data PI qpn = PI qpn I
  deriving (Eq, Ord, Show, Functor)

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

-- | Checks if a package instance corresponds to an installed package.
instPI :: PI qpn -> Bool
instPI (PI _ (I _ (Inst _))) = True
instPI _                     = False

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

-- | Package path. (Stored in "reverse" order.)
type PP = [PN]

-- | String representation of a package path.
showPP :: PP -> String
showPP = intercalate "." . L.map display . reverse


-- | A qualified entity. Pairs a package path with the entity.
data Q a = Q PP a
  deriving (Eq, Ord, Show)

-- | Standard string representation of a qualified entity.
showQ :: (a -> String) -> (Q a -> String)
showQ showa (Q [] x) = showa x
showQ showa (Q pp x) = showPP pp ++ "." ++ showa x

-- | Qualified package name.
type QPN = Q PN

-- | String representation of a qualified package path.
showQPN :: QPN -> String
showQPN = showQ display

-- | The scope associates every package with a path. The convention is that packages
-- not in the data structure have an empty path associated with them.
type Scope = Map PN PP

-- | An empty scope structure, for initialization.
emptyScope :: Scope
emptyScope = M.empty

-- | Create artificial parents for each of the package names, making
-- them all independent.
makeIndependent :: [PN] -> Scope
makeIndependent ps = L.foldl (\ sc (n, p) -> M.insert p [PackageName (show n)] sc) emptyScope (zip ([0..] :: [Int]) ps)

qualify :: Scope -> PN -> QPN
qualify sc pn = Q (findWithDefault [] pn sc) pn

unQualify :: Q a -> a
unQualify (Q _ x) = x