module Debian.Debianize.DebianName
( debianName
, debianNameBase
, mkPkgName
, mkPkgName'
, mapCabal
, splitCabal
, remapCabal
) where
import Control.Applicative ((<$>))
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, utilsPackageNameBase, overrideDebianNameBase)
import Debian.Debianize.Monad (DebT)
import Debian.Debianize.Prelude ((%=))
import Debian.Debianize.VersionSplits (DebBase(DebBase, unDebBase), 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, Functor m, PkgName name) => PackageType -> CompilerFlavor -> DebT m name
debianName typ cfl =
do base <-
case (typ, cfl) of
(Utilities, GHC) -> access utilsPackageNameBase >>= maybe (((\ base -> "haskell-" ++ base ++ "-utils") . unDebBase) <$> debianNameBase) return
(Utilities, _) -> access utilsPackageNameBase >>= maybe (((\ base -> base ++ "-utils") . unDebBase) <$> debianNameBase) return
_ -> unDebBase <$> debianNameBase
return $ mkPkgName' cfl typ (DebBase base)
debianNameBase :: Monad m => DebT m DebBase
debianNameBase =
do nameBase <- access T.overrideDebianNameBase
Just pkgDesc <- access packageDescription
let pkgId = Cabal.package pkgDesc
nameMap <- access T.debianNameMap
let pname@(PackageName _) = pkgName pkgId
version = (Just (D.EEQ (parseDebianVersion (showVersion (pkgVersion pkgId)))))
case (nameBase, Map.lookup (pkgName pkgId) nameMap) of
(Just base, _) -> return base
(Nothing, Nothing) -> return $ debianBaseName pname
(Nothing, Just splits) -> return $ doSplits splits version
mkPkgName :: PkgName name => CompilerFlavor -> PackageName -> PackageType -> name
mkPkgName cfl pkg typ = mkPkgName' cfl typ (debianBaseName pkg)
mkPkgName' :: PkgName name => CompilerFlavor -> PackageType -> DebBase -> name
mkPkgName' cfl typ (DebBase base) =
pkgNameFromString $
case typ of
Documentation -> prefix ++ base ++ "-doc"
Development -> prefix ++ base ++ "-dev"
Profiling -> prefix ++ base ++ "-prof"
Utilities -> base
Exec -> base
Source -> base
HaskellSource -> "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)
remapCabal :: Monad m => PackageName -> DebBase -> DebT m ()
remapCabal pname dname = do
debianNameMap %= Map.alter (const Nothing) pname
mapCabal pname dname