{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, RankNTypes, ScopedTypeVariables, StandaloneDeriving, TypeFamilies #-}
{-# OPTIONS -Wall -Wwarn -fno-warn-name-shadowing -fno-warn-orphans #-}
module Debian.Debianize.DebianName
( debianName
, debianNameBase
, mkPkgName
, mkPkgName'
, mapCabal
, splitCabal
, remapCabal
) where
import Control.Lens
import Data.Char (toLower)
import Data.Map as Map (alter, lookup)
import Debian.Debianize.Monad (CabalT)
import Debian.Debianize.CabalInfo as A (debianNameMap, packageDescription, debInfo)
import Debian.Debianize.BinaryDebDescription as Debian (PackageType(..))
import Debian.Debianize.DebInfo as D (overrideDebianNameBase, utilsPackageNameBase)
import Debian.Debianize.VersionSplits (DebBase(DebBase, unDebBase), doSplits, insertSplit, makePackage, VersionSplits(oldestPackage, splits))
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, unPackageName)
import Distribution.Version (Version)
import qualified Distribution.PackageDescription as Cabal (PackageDescription(package))
import Distribution.Pretty (prettyShow)
import Prelude hiding (unlines)
data Dependency_
= BuildDepends Dependency
| BuildTools Dependency
| PkgConfigDepends Dependency
| Relations
deriving (Dependency_ -> Dependency_ -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Dependency_ -> Dependency_ -> Bool
$c/= :: Dependency_ -> Dependency_ -> Bool
== :: Dependency_ -> Dependency_ -> Bool
$c== :: Dependency_ -> Dependency_ -> Bool
Eq, Int -> Dependency_ -> ShowS
[Dependency_] -> ShowS
Dependency_ -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Dependency_] -> ShowS
$cshowList :: [Dependency_] -> ShowS
show :: Dependency_ -> String
$cshow :: Dependency_ -> String
showsPrec :: Int -> Dependency_ -> ShowS
$cshowsPrec :: Int -> Dependency_ -> ShowS
Show)
debianName :: (Monad m, PkgName name) => PackageType -> CompilerFlavor -> CabalT m name
debianName :: forall (m :: * -> *) name.
(Monad m, PkgName name) =>
PackageType -> CompilerFlavor -> CabalT m name
debianName PackageType
typ CompilerFlavor
hc =
do String
base <-
case (PackageType
typ, CompilerFlavor
hc) of
(PackageType
Utilities, CompilerFlavor
GHC) -> forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' CabalInfo DebInfo
debInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' DebInfo (Maybe String)
utilsPackageNameBase) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (((\ String
base -> String
"haskell-" forall a. [a] -> [a] -> [a]
++ String
base forall a. [a] -> [a] -> [a]
++ String
"-utils") forall b c a. (b -> c) -> (a -> b) -> a -> c
. DebBase -> String
unDebBase) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). Monad m => CabalT m DebBase
debianNameBase) forall (m :: * -> *) a. Monad m => a -> m a
return
(PackageType
Utilities, CompilerFlavor
_) -> forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' CabalInfo DebInfo
debInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' DebInfo (Maybe String)
utilsPackageNameBase) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (((\ String
base -> String
base forall a. [a] -> [a] -> [a]
++ String
"-utils") forall b c a. (b -> c) -> (a -> b) -> a -> c
. DebBase -> String
unDebBase) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). Monad m => CabalT m DebBase
debianNameBase) forall (m :: * -> *) a. Monad m => a -> m a
return
(PackageType, CompilerFlavor)
_ -> DebBase -> String
unDebBase forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). Monad m => CabalT m DebBase
debianNameBase
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall name.
PkgName name =>
CompilerFlavor -> PackageType -> DebBase -> name
mkPkgName' CompilerFlavor
hc PackageType
typ (String -> DebBase
DebBase String
base)
debianNameBase :: Monad m => CabalT m DebBase
debianNameBase :: forall (m :: * -> *). Monad m => CabalT m DebBase
debianNameBase =
do Maybe DebBase
nameBase <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' CabalInfo DebInfo
debInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' DebInfo (Maybe DebBase)
D.overrideDebianNameBase)
PackageDescription
pkgDesc <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' CabalInfo PackageDescription
packageDescription
let pkgId :: PackageIdentifier
pkgId = PackageDescription -> PackageIdentifier
Cabal.package PackageDescription
pkgDesc
Map PackageName VersionSplits
nameMap <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' CabalInfo (Map PackageName VersionSplits)
A.debianNameMap
let pname :: PackageName
pname = PackageIdentifier -> PackageName
pkgName PackageIdentifier
pkgId
version :: Maybe VersionReq
version = (forall a. a -> Maybe a
Just (DebianVersion -> VersionReq
D.EEQ (forall string. ParseDebianVersion string => string -> DebianVersion
parseDebianVersion' (forall a. Pretty a => a -> String
prettyShow (PackageIdentifier -> Version
pkgVersion PackageIdentifier
pkgId)))))
case (Maybe DebBase
nameBase, forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (PackageIdentifier -> PackageName
pkgName PackageIdentifier
pkgId) Map PackageName VersionSplits
nameMap) of
(Just DebBase
base, Maybe VersionSplits
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return DebBase
base
(Maybe DebBase
Nothing, Maybe VersionSplits
Nothing) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ PackageName -> DebBase
debianBaseName PackageName
pname
(Maybe DebBase
Nothing, Just VersionSplits
splits) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ VersionSplits -> Maybe VersionReq -> DebBase
doSplits VersionSplits
splits Maybe VersionReq
version
mkPkgName :: PkgName name => CompilerFlavor -> PackageName -> PackageType -> name
mkPkgName :: forall name.
PkgName name =>
CompilerFlavor -> PackageName -> PackageType -> name
mkPkgName CompilerFlavor
hc PackageName
pkg PackageType
typ = forall name.
PkgName name =>
CompilerFlavor -> PackageType -> DebBase -> name
mkPkgName' CompilerFlavor
hc PackageType
typ (PackageName -> DebBase
debianBaseName PackageName
pkg)
mkPkgName' :: PkgName name => CompilerFlavor -> PackageType -> DebBase -> name
mkPkgName' :: forall name.
PkgName name =>
CompilerFlavor -> PackageType -> DebBase -> name
mkPkgName' CompilerFlavor
hc PackageType
typ (DebBase String
base) =
forall a. PkgName a => String -> a
pkgNameFromString forall a b. (a -> b) -> a -> b
$
case PackageType
typ of
PackageType
Documentation -> String
prefix forall a. [a] -> [a] -> [a]
++ String
base forall a. [a] -> [a] -> [a]
++ String
"-doc"
PackageType
Development -> String
prefix forall a. [a] -> [a] -> [a]
++ String
base forall a. [a] -> [a] -> [a]
++ String
"-dev"
PackageType
Profiling -> String
prefix forall a. [a] -> [a] -> [a]
++ String
base forall a. [a] -> [a] -> [a]
++ String
"-prof"
PackageType
Utilities -> String
base
PackageType
Exec -> String
base
PackageType
Source -> String
base
PackageType
HaskellSource -> String
"haskell-" forall a. [a] -> [a] -> [a]
++ String
base
PackageType
Cabal -> String
base
where prefix :: String
prefix = String
"lib" forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (forall a. Show a => a -> String
show CompilerFlavor
hc) forall a. [a] -> [a] -> [a]
++ String
"-"
debianBaseName :: PackageName -> DebBase
debianBaseName :: PackageName -> DebBase
debianBaseName PackageName
p =
String -> DebBase
DebBase (forall a b. (a -> b) -> [a] -> [b]
map (Char -> Char
fixChar forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char
toLower) (PackageName -> String
unPackageName PackageName
p))
where
fixChar :: Char -> Char
fixChar :: Char -> Char
fixChar Char
'_' = Char
'-'
fixChar Char
c = Char -> Char
toLower Char
c
mapCabal :: Monad m => PackageName -> DebBase -> CabalT m ()
mapCabal :: forall (m :: * -> *).
Monad m =>
PackageName -> DebBase -> CabalT m ()
mapCabal PackageName
pname DebBase
dname =
Lens' CabalInfo (Map PackageName VersionSplits)
debianNameMap forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter Maybe VersionSplits -> Maybe VersionSplits
f PackageName
pname
where
f :: Maybe VersionSplits -> Maybe VersionSplits
f :: Maybe VersionSplits -> Maybe VersionSplits
f Maybe VersionSplits
Nothing = forall a. a -> Maybe a
Just (DebBase -> VersionSplits
makePackage DebBase
dname)
f (Just VersionSplits
sp) | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => a -> a -> Bool
== DebBase
dname) (VersionSplits -> DebBase
oldestPackage VersionSplits
sp forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd (VersionSplits -> [(Version, DebBase)]
splits VersionSplits
sp)) = forall a. a -> Maybe a
Just VersionSplits
sp
f (Just VersionSplits
sp) = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"mapCabal " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show PackageName
pname forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show DebBase
dname forall a. [a] -> [a] -> [a]
++ String
": - already mapped: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show VersionSplits
sp
splitCabal :: Monad m => PackageName -> DebBase -> Version -> CabalT m ()
splitCabal :: forall (m :: * -> *).
Monad m =>
PackageName -> DebBase -> Version -> CabalT m ()
splitCabal PackageName
pname DebBase
ltname Version
ver =
Lens' CabalInfo (Map PackageName VersionSplits)
debianNameMap forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter Maybe VersionSplits -> Maybe VersionSplits
f PackageName
pname
where
f :: Maybe VersionSplits -> Maybe VersionSplits
f :: Maybe VersionSplits -> Maybe VersionSplits
f Maybe VersionSplits
Nothing = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"splitCabal - not mapped: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show PackageName
pname
f (Just VersionSplits
sp) = forall a. a -> Maybe a
Just (Version -> DebBase -> VersionSplits -> VersionSplits
insertSplit Version
ver DebBase
ltname VersionSplits
sp)
remapCabal :: Monad m => PackageName -> DebBase -> CabalT m ()
remapCabal :: forall (m :: * -> *).
Monad m =>
PackageName -> DebBase -> CabalT m ()
remapCabal PackageName
pname DebBase
dname = do
Lens' CabalInfo (Map PackageName VersionSplits)
debianNameMap forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) PackageName
pname
forall (m :: * -> *).
Monad m =>
PackageName -> DebBase -> CabalT m ()
mapCabal PackageName
pname DebBase
dname