module Debian.Debianize.DebianName
( debianName
, mkPkgName
, mkPkgName'
, mapCabal
, splitCabal
) where
import Data.Char (toLower)
import Data.Lens.Lazy (access)
import Data.Map as Map (lookup, alter)
import Data.Version (Version, showVersion)
import Debian.Debianize.Types.BinaryDebDescription as Debian (PackageType(..))
import Debian.Debianize.Types.Atoms as T (debianNameMap, packageDescription)
import Debian.Debianize.Monad (DebT)
import Debian.Debianize.Prelude ((%=))
import Debian.Debianize.VersionSplits (insertSplit, doSplits, VersionSplits, makePackage)
import Debian.Orphans ()
import Debian.Relation (PkgName(..), Relations)
import qualified Debian.Relation as D (VersionReq(EEQ))
import Debian.Version (parseDebianVersion)
import Distribution.Package (Dependency(..), PackageIdentifier(..), PackageName(PackageName))
import qualified Distribution.PackageDescription as Cabal
import Prelude hiding (unlines)
data Dependency_
= BuildDepends Dependency
| BuildTools Dependency
| PkgConfigDepends Dependency
| ExtraLibs Relations
deriving (Eq, Show)
debianName :: (Monad m, PkgName name) => PackageType -> DebT m name
debianName typ =
do Just pkgDesc <- access packageDescription
let pkgId = Cabal.package pkgDesc
nameMap <- access T.debianNameMap
return $ debianName' (Map.lookup (pkgName pkgId) nameMap) typ pkgId
debianName' :: (PkgName name) => Maybe VersionSplits -> PackageType -> PackageIdentifier -> name
debianName' msplits typ pkgId =
case msplits of
Nothing -> mkPkgName pname typ
Just splits -> (\ s -> mkPkgName' s typ) $ doSplits splits version
where
pname@(PackageName _) = pkgName pkgId
version = (Just (D.EEQ (parseDebianVersion (showVersion (pkgVersion pkgId)))))
mkPkgName :: PkgName name => PackageName -> PackageType -> name
mkPkgName pkg typ = mkPkgName' (debianBaseName pkg) typ
mkPkgName' :: PkgName name => String -> PackageType -> name
mkPkgName' base typ =
pkgNameFromString $
case typ of
Documentation -> "libghc-" ++ base ++ "-doc"
Development -> "libghc-" ++ base ++ "-dev"
Profiling -> "libghc-" ++ base ++ "-prof"
Utilities -> "haskell-" ++ base ++ "-utils"
Exec -> base
Source' -> "haskell-" ++ base ++ ""
Cabal -> base
debianBaseName :: PackageName -> String
debianBaseName (PackageName name) =
map (fixChar . toLower) name
where
fixChar :: Char -> Char
fixChar '_' = '-'
fixChar c = toLower c
mapCabal :: Monad m => PackageName -> String -> DebT m ()
mapCabal pname dname =
debianNameMap %= Map.alter f pname
where
f :: Maybe VersionSplits -> Maybe VersionSplits
f Nothing = Just (makePackage dname)
f (Just sp) = error $ "mapCabal " ++ show pname ++ " " ++ show dname ++ ": - already mapped: " ++ show sp
splitCabal :: Monad m => PackageName -> String -> Version -> DebT m ()
splitCabal pname ltname ver =
debianNameMap %= Map.alter f pname
where
f :: Maybe VersionSplits -> Maybe VersionSplits
f Nothing = error $ "splitCabal - not mapped: " ++ show pname
f (Just sp) = Just (insertSplit ver ltname sp)