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, compilerFlavor)
import Debian.Debianize.Monad (DebT)
import Debian.Debianize.Prelude ((%=))
import Debian.Debianize.VersionSplits (DebBase(DebBase), 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.Compiler (CompilerFlavor(..))
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 cfl <- access compilerFlavor
Just pkgDesc <- access packageDescription
let pkgId = Cabal.package pkgDesc
nameMap <- access T.debianNameMap
return $ debianName' cfl (Map.lookup (pkgName pkgId) nameMap) typ pkgId
debianName' :: (PkgName name) => CompilerFlavor -> Maybe VersionSplits -> PackageType -> PackageIdentifier -> name
debianName' cfl msplits typ pkgId =
case msplits of
Nothing -> mkPkgName cfl pname typ
Just splits -> (\ s -> mkPkgName' cfl s typ) $ doSplits splits version
where
pname@(PackageName _) = pkgName pkgId
version = (Just (D.EEQ (parseDebianVersion (showVersion (pkgVersion pkgId)))))
mkPkgName :: PkgName name => CompilerFlavor -> PackageName -> PackageType -> name
mkPkgName cfl pkg typ = mkPkgName' cfl (debianBaseName pkg) typ
mkPkgName' :: PkgName name => CompilerFlavor -> DebBase -> PackageType -> name
mkPkgName' cfl (DebBase base) typ =
pkgNameFromString $
case typ of
Documentation -> prefix ++ base ++ "-doc"
Development -> prefix ++ base ++ "-dev"
Profiling -> prefix ++ base ++ "-prof"
Utilities -> "haskell-" ++ base ++ "-utils"
Exec -> base
Source' -> "haskell-" ++ base ++ ""
Cabal -> base
where prefix = "lib" ++ map toLower (show cfl) ++ "-"
debianBaseName :: PackageName -> DebBase
debianBaseName (PackageName name) =
DebBase (map (fixChar . toLower) name)
where
fixChar :: Char -> Char
fixChar '_' = '-'
fixChar c = toLower c
mapCabal :: Monad m => PackageName -> DebBase -> 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 -> DebBase -> 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)