{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -Wall #-}
module Debian.Debianize.CabalInfo
    ( -- * Types
      CabalInfo
    , PackageInfo(PackageInfo, cabalName, devDeb, docDeb, profDeb)
      -- * Lenses
    , packageDescription
    , debInfo
    , debianNameMap
    , epochMap
    , packageInfo
      -- * Builder
    , newCabalInfo
    ) where

import Control.Lens
import Control.Monad.Catch (MonadMask)
import Control.Monad.State (execStateT)
import Control.Monad.Trans (MonadIO, liftIO)
import Data.Generics (Data, Typeable)
import Data.Map as Map (Map)
import Data.Text as Text (null, pack, strip)
import Debian.Debianize.BasicInfo (Flags)
import Debian.Debianize.DebInfo as D (control, copyright, DebInfo, makeDebInfo)
import Debian.Debianize.BinaryDebDescription (Canonical(canonical))
import Debian.Debianize.CopyrightDescription (defaultCopyrightDescription)
import Debian.Debianize.InputCabal (inputCabalization)
import Debian.Debianize.SourceDebDescription as S (homepage)
import Debian.Debianize.VersionSplits (VersionSplits)
import Debian.Orphans ()
import Debian.Relation (BinPkgName)
import Debian.Version (DebianVersion)
import Distribution.Package (PackageName)
import Distribution.PackageDescription as Cabal (PackageDescription(homepage))
#if MIN_VERSION_Cabal(3,2,0)
import qualified Distribution.Utils.ShortText as ST
#endif
import Prelude hiding (init, init, log, log, null)

-- | Bits and pieces of information about the mapping from cabal package
-- names and versions to debian package names and versions.  In essence,
-- an 'Atoms' value represents a package's debianization.  The lenses in
-- this module are used to get and set the values hidden in this Atoms
-- value.  Many of the values should be left alone to be set when the
-- debianization is finalized.
data CabalInfo
    = CabalInfo
      { CabalInfo -> PackageDescription
_packageDescription :: PackageDescription
      -- ^ The result of reading a cabal configuration file.
      , CabalInfo -> DebInfo
_debInfo :: DebInfo
      -- ^ Information required to represent a non-cabal debianization.
      , CabalInfo -> Map PackageName VersionSplits
_debianNameMap :: Map PackageName VersionSplits
      -- ^ Mapping from cabal package name and version to debian source
      -- package name.  This allows different ranges of cabal versions to
      -- map to different debian source package names.
      , CabalInfo -> Map PackageName Int
_epochMap :: Map PackageName Int
      -- ^ Specify epoch numbers for the debian package generated from a
      -- cabal package.  Example: @EpochMapping (PackageName "HTTP") 1@.
      , CabalInfo -> Map PackageName PackageInfo
_packageInfo :: Map PackageName PackageInfo
      -- ^ Supply some info about a cabal package.
      } deriving (Int -> CabalInfo -> ShowS
[CabalInfo] -> ShowS
CabalInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CabalInfo] -> ShowS
$cshowList :: [CabalInfo] -> ShowS
show :: CabalInfo -> String
$cshow :: CabalInfo -> String
showsPrec :: Int -> CabalInfo -> ShowS
$cshowsPrec :: Int -> CabalInfo -> ShowS
Show, Typeable CabalInfo
CabalInfo -> DataType
CabalInfo -> Constr
(forall b. Data b => b -> b) -> CabalInfo -> CabalInfo
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> CabalInfo -> u
forall u. (forall d. Data d => d -> u) -> CabalInfo -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CabalInfo -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CabalInfo -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CabalInfo -> m CabalInfo
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CabalInfo -> m CabalInfo
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CabalInfo
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CabalInfo -> c CabalInfo
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CabalInfo)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CabalInfo)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CabalInfo -> m CabalInfo
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CabalInfo -> m CabalInfo
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CabalInfo -> m CabalInfo
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CabalInfo -> m CabalInfo
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CabalInfo -> m CabalInfo
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CabalInfo -> m CabalInfo
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CabalInfo -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CabalInfo -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> CabalInfo -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CabalInfo -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CabalInfo -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CabalInfo -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CabalInfo -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CabalInfo -> r
gmapT :: (forall b. Data b => b -> b) -> CabalInfo -> CabalInfo
$cgmapT :: (forall b. Data b => b -> b) -> CabalInfo -> CabalInfo
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CabalInfo)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CabalInfo)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CabalInfo)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CabalInfo)
dataTypeOf :: CabalInfo -> DataType
$cdataTypeOf :: CabalInfo -> DataType
toConstr :: CabalInfo -> Constr
$ctoConstr :: CabalInfo -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CabalInfo
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CabalInfo
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CabalInfo -> c CabalInfo
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CabalInfo -> c CabalInfo
Data, Typeable)

data PackageInfo = PackageInfo { PackageInfo -> PackageName
cabalName :: PackageName
                               , PackageInfo -> Maybe (BinPkgName, DebianVersion)
devDeb :: Maybe (BinPkgName, DebianVersion)
                               , PackageInfo -> Maybe (BinPkgName, DebianVersion)
profDeb :: Maybe (BinPkgName, DebianVersion)
                               , PackageInfo -> Maybe (BinPkgName, DebianVersion)
docDeb :: Maybe (BinPkgName, DebianVersion) } deriving (PackageInfo -> PackageInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PackageInfo -> PackageInfo -> Bool
$c/= :: PackageInfo -> PackageInfo -> Bool
== :: PackageInfo -> PackageInfo -> Bool
$c== :: PackageInfo -> PackageInfo -> Bool
Eq, Eq PackageInfo
PackageInfo -> PackageInfo -> Bool
PackageInfo -> PackageInfo -> Ordering
PackageInfo -> PackageInfo -> PackageInfo
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PackageInfo -> PackageInfo -> PackageInfo
$cmin :: PackageInfo -> PackageInfo -> PackageInfo
max :: PackageInfo -> PackageInfo -> PackageInfo
$cmax :: PackageInfo -> PackageInfo -> PackageInfo
>= :: PackageInfo -> PackageInfo -> Bool
$c>= :: PackageInfo -> PackageInfo -> Bool
> :: PackageInfo -> PackageInfo -> Bool
$c> :: PackageInfo -> PackageInfo -> Bool
<= :: PackageInfo -> PackageInfo -> Bool
$c<= :: PackageInfo -> PackageInfo -> Bool
< :: PackageInfo -> PackageInfo -> Bool
$c< :: PackageInfo -> PackageInfo -> Bool
compare :: PackageInfo -> PackageInfo -> Ordering
$ccompare :: PackageInfo -> PackageInfo -> Ordering
Ord, Int -> PackageInfo -> ShowS
[PackageInfo] -> ShowS
PackageInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PackageInfo] -> ShowS
$cshowList :: [PackageInfo] -> ShowS
show :: PackageInfo -> String
$cshow :: PackageInfo -> String
showsPrec :: Int -> PackageInfo -> ShowS
$cshowsPrec :: Int -> PackageInfo -> ShowS
Show, Typeable PackageInfo
PackageInfo -> DataType
PackageInfo -> Constr
(forall b. Data b => b -> b) -> PackageInfo -> PackageInfo
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> PackageInfo -> u
forall u. (forall d. Data d => d -> u) -> PackageInfo -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PackageInfo -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PackageInfo -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PackageInfo -> m PackageInfo
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PackageInfo -> m PackageInfo
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PackageInfo
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PackageInfo -> c PackageInfo
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PackageInfo)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PackageInfo)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PackageInfo -> m PackageInfo
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PackageInfo -> m PackageInfo
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PackageInfo -> m PackageInfo
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PackageInfo -> m PackageInfo
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PackageInfo -> m PackageInfo
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PackageInfo -> m PackageInfo
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PackageInfo -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PackageInfo -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> PackageInfo -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PackageInfo -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PackageInfo -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PackageInfo -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PackageInfo -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PackageInfo -> r
gmapT :: (forall b. Data b => b -> b) -> PackageInfo -> PackageInfo
$cgmapT :: (forall b. Data b => b -> b) -> PackageInfo -> PackageInfo
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PackageInfo)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PackageInfo)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PackageInfo)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PackageInfo)
dataTypeOf :: PackageInfo -> DataType
$cdataTypeOf :: PackageInfo -> DataType
toConstr :: PackageInfo -> Constr
$ctoConstr :: PackageInfo -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PackageInfo
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PackageInfo
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PackageInfo -> c PackageInfo
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PackageInfo -> c PackageInfo
Data, Typeable)

$(makeLenses ''CabalInfo)

instance Canonical CabalInfo where
    canonical :: CabalInfo -> CabalInfo
canonical CabalInfo
x = CabalInfo
x {_debInfo :: DebInfo
_debInfo = forall a. Canonical a => a -> a
canonical (CabalInfo -> DebInfo
_debInfo CabalInfo
x)}

-- | Given the 'Flags' value read the cabalization and build a new
-- 'CabalInfo' record.
newCabalInfo :: (MonadIO m, MonadMask m{-, Functor m-}) => Flags -> m (Either String CabalInfo)
newCabalInfo :: forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
Flags -> m (Either String CabalInfo)
newCabalInfo Flags
flags' =
    forall (m :: * -> *).
MonadIO m =>
Flags -> m (Either String PackageDescription)
inputCabalization Flags
flags' forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) (\PackageDescription
p -> forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {m :: * -> *}.
MonadIO m =>
PackageDescription -> m CabalInfo
doPkgDesc PackageDescription
p)
    where
      doPkgDesc :: PackageDescription -> m CabalInfo
doPkgDesc PackageDescription
pkgDesc = do
        CopyrightDescription
copyrt <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ PackageDescription -> IO CopyrightDescription
defaultCopyrightDescription PackageDescription
pkgDesc
        forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT
          (do (Lens' CabalInfo DebInfo
debInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' DebInfo (Maybe CopyrightDescription)
copyright) forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. a -> Maybe a
Just CopyrightDescription
copyrt
              (Lens' CabalInfo DebInfo
debInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' DebInfo SourceDebDescription
control forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' SourceDebDescription (Maybe Text)
S.homepage) forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= case Text -> Text
strip (ShortText -> Text
toText (PackageDescription -> ShortText
Cabal.homepage PackageDescription
pkgDesc)) of
                                                    Text
x | Text -> Bool
Text.null Text
x -> forall a. Maybe a
Nothing
                                                    Text
x -> forall a. a -> Maybe a
Just Text
x)
          (Flags -> PackageDescription -> CabalInfo
makeCabalInfo Flags
flags' PackageDescription
pkgDesc)
#if MIN_VERSION_Cabal(3,2,0)
      toText :: ShortText -> Text
toText = String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> String
ST.fromShortText
#else
      toText = pack
#endif

makeCabalInfo :: Flags -> PackageDescription -> CabalInfo
makeCabalInfo :: Flags -> PackageDescription -> CabalInfo
makeCabalInfo Flags
fs PackageDescription
pkgDesc =
    CabalInfo
      { _packageDescription :: PackageDescription
_packageDescription = PackageDescription
pkgDesc
      , _epochMap :: Map PackageName Int
_epochMap = forall a. Monoid a => a
mempty
      , _packageInfo :: Map PackageName PackageInfo
_packageInfo = forall a. Monoid a => a
mempty
      , _debianNameMap :: Map PackageName VersionSplits
_debianNameMap = forall a. Monoid a => a
mempty
      , _debInfo :: DebInfo
_debInfo = Flags -> DebInfo
makeDebInfo Flags
fs
      }