-- |
-- Module      : Debian.Package.Build.Sequence
-- Copyright   : 2014-2016 Kei Hibino
-- License     : BSD3
--
-- Maintainer  : ex8k.hibino@gmail.com
-- Stability   : experimental
-- Portability : portable
--
-- This module provides build-sequence actions.
module Debian.Package.Build.Sequence
       ( origArchive, nativeArchive, sourceDir

       , withCurrentDir, withBaseCurrentDir

       , getBuildDir, removeBuildDir
       , findDebianChanges

       , copyDebianDir

       , rsyncGenOrigSources, rsyncGenNativeSources, rsyncGenSources

       , cabalGenOrigSources, cabalGenSources, cabalAutogenSources

       , genSources

       , findGeneratedSourceDir, findGeneratedSource,
       ) where

import System.FilePath ((</>), takeFileName, takeDirectory, takeBaseName)
import System.Directory
  (getDirectoryContents, doesDirectoryExist, doesFileExist)
import Control.Applicative (pure, (<$>), (<*>), (<|>))
import Control.Monad (when, guard, msum)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Maybe (MaybeT(MaybeT), runMaybeT)
import Data.List (isPrefixOf)
import Data.Maybe (catMaybes)

import Debian.Package.Data
  (Hackage, hackageLongName, hackageArchive,
   Source, origArchiveName, nativeArchiveName, sourceDirName, isNative,
   PackageType, takeChangesType,
   HaskellPackage, hackage, package, haskellPackageFromPackage)
import Debian.Package.Build.Monad
  (Build, liftTrace, bracketBuild_, Config (..), askConfig, askBaseDir, askBuildDir)
import Debian.Package.Build.Command
  (chdir, pwd, createDirectoryIfMissing, confirmPath, renameFile, renameDirectory,
   unpack, packInDir', cabalDebian, dpkgParseChangeLog, rawSystem')
import qualified Debian.Package.Build.Cabal as Cabal


-- | Run 'Bulid' action under specified directory.
withCurrentDir :: FilePath -> Build a -> Build a
withCurrentDir :: FilePath -> Build a -> Build a
withCurrentDir FilePath
dir Build a
act = do
  FilePath
saveDir <- IO FilePath -> ReaderT FilePath (ReaderT Config Trace) FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO FilePath
pwd
  Build () -> Build () -> Build a -> Build a
forall a b c. Build a -> Build b -> Build c -> Build c
bracketBuild_
    (Trace () -> Build ()
forall a. Trace a -> Build a
liftTrace (Trace () -> Build ()) -> Trace () -> Build ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Trace ()
chdir FilePath
dir)
    (Trace () -> Build ()
forall a. Trace a -> Build a
liftTrace (Trace () -> Build ()) -> Trace () -> Build ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Trace ()
chdir FilePath
saveDir)
    Build a
act

-- | Run 'Build' action under base-directory.
withBaseCurrentDir :: Build a -> Build a
withBaseCurrentDir :: Build a -> Build a
withBaseCurrentDir Build a
act = do
  FilePath
baseDir <- ReaderT FilePath (ReaderT Config Trace) FilePath
askBaseDir
  FilePath -> Build a -> Build a
forall a. FilePath -> Build a -> Build a
withCurrentDir FilePath
baseDir Build a
act

-- | Take build-directory from 'Build' action context.
getBuildDir :: Build FilePath
getBuildDir :: ReaderT FilePath (ReaderT Config Trace) FilePath
getBuildDir =  ReaderT FilePath (ReaderT Config Trace) FilePath
askBuildDir

-- Pass build-directory to 'Build' action.
withBuildDir :: (FilePath -> Build a) -> Build a
withBuildDir :: (FilePath -> Build a) -> Build a
withBuildDir FilePath -> Build a
f = ReaderT FilePath (ReaderT Config Trace) FilePath
getBuildDir ReaderT FilePath (ReaderT Config Trace) FilePath
-> (FilePath -> Build a) -> Build a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> Build a
f

-- | Remove build-directory.
removeBuildDir :: Build ()
removeBuildDir :: Build ()
removeBuildDir = do
  FilePath
bldDir <- ReaderT FilePath (ReaderT Config Trace) FilePath
getBuildDir
  Trace () -> Build ()
forall a. Trace a -> Build a
liftTrace (Trace () -> Build ()) -> Trace () -> Build ()
forall a b. (a -> b) -> a -> b
$ do
    Bool
found <- IO Bool -> ReaderT Bool IO Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> ReaderT Bool IO Bool)
-> IO Bool -> ReaderT Bool IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesDirectoryExist FilePath
bldDir
    Bool -> Trace () -> Trace ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
found (Trace () -> Trace ()) -> Trace () -> Trace ()
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> Trace ()
rawSystem' FilePath
"rm" [FilePath
"-r", FilePath
bldDir]

-- | Take debian-directory name from 'Build' action context.
debianDirName' :: Build FilePath
debianDirName' :: ReaderT FilePath (ReaderT Config Trace) FilePath
debianDirName' =  Config -> FilePath
debianDirName (Config -> FilePath)
-> ReaderT FilePath (ReaderT Config Trace) Config
-> ReaderT FilePath (ReaderT Config Trace) FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT FilePath (ReaderT Config Trace) Config
askConfig

-- | Take original source archive name from 'Build' action context.
origArchive :: Source -> Build FilePath
origArchive :: Source -> ReaderT FilePath (ReaderT Config Trace) FilePath
origArchive Source
pkg =
  (FilePath -> ReaderT FilePath (ReaderT Config Trace) FilePath)
-> ReaderT FilePath (ReaderT Config Trace) FilePath
forall a. (FilePath -> Build a) -> Build a
withBuildDir ((FilePath -> ReaderT FilePath (ReaderT Config Trace) FilePath)
 -> ReaderT FilePath (ReaderT Config Trace) FilePath)
-> (FilePath -> ReaderT FilePath (ReaderT Config Trace) FilePath)
-> ReaderT FilePath (ReaderT Config Trace) FilePath
forall a b. (a -> b) -> a -> b
$ \FilePath
w -> FilePath -> ReaderT FilePath (ReaderT Config Trace) FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> ReaderT FilePath (ReaderT Config Trace) FilePath)
-> FilePath -> ReaderT FilePath (ReaderT Config Trace) FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
w FilePath -> FilePath -> FilePath
</> Source -> FilePath
origArchiveName Source
pkg

-- | Take debian native source archive name from 'Build' action context.
nativeArchive :: Source -> Build FilePath
nativeArchive :: Source -> ReaderT FilePath (ReaderT Config Trace) FilePath
nativeArchive Source
pkg =
  (FilePath -> ReaderT FilePath (ReaderT Config Trace) FilePath)
-> ReaderT FilePath (ReaderT Config Trace) FilePath
forall a. (FilePath -> Build a) -> Build a
withBuildDir ((FilePath -> ReaderT FilePath (ReaderT Config Trace) FilePath)
 -> ReaderT FilePath (ReaderT Config Trace) FilePath)
-> (FilePath -> ReaderT FilePath (ReaderT Config Trace) FilePath)
-> ReaderT FilePath (ReaderT Config Trace) FilePath
forall a b. (a -> b) -> a -> b
$ \FilePath
w -> FilePath -> ReaderT FilePath (ReaderT Config Trace) FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> ReaderT FilePath (ReaderT Config Trace) FilePath)
-> FilePath -> ReaderT FilePath (ReaderT Config Trace) FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
w FilePath -> FilePath -> FilePath
</> Source -> FilePath
nativeArchiveName Source
pkg

-- | Take source directory from 'Build' action context.
sourceDir :: Source -> Build FilePath
sourceDir :: Source -> ReaderT FilePath (ReaderT Config Trace) FilePath
sourceDir Source
pkg =
  (FilePath -> ReaderT FilePath (ReaderT Config Trace) FilePath)
-> ReaderT FilePath (ReaderT Config Trace) FilePath
forall a. (FilePath -> Build a) -> Build a
withBuildDir ((FilePath -> ReaderT FilePath (ReaderT Config Trace) FilePath)
 -> ReaderT FilePath (ReaderT Config Trace) FilePath)
-> (FilePath -> ReaderT FilePath (ReaderT Config Trace) FilePath)
-> ReaderT FilePath (ReaderT Config Trace) FilePath
forall a b. (a -> b) -> a -> b
$ \FilePath
w -> FilePath -> ReaderT FilePath (ReaderT Config Trace) FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> ReaderT FilePath (ReaderT Config Trace) FilePath)
-> FilePath -> ReaderT FilePath (ReaderT Config Trace) FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
w FilePath -> FilePath -> FilePath
</> Source -> FilePath
sourceDirName Source
pkg

-- | Action to copy debian directory from base-directory into specified directory.
copyDebianDir :: FilePath -> Build ()
copyDebianDir :: FilePath -> Build ()
copyDebianDir FilePath
srcDir = do
  FilePath
debDN       <- ReaderT FilePath (ReaderT Config Trace) FilePath
debianDirName'
  FilePath
baseDir     <- ReaderT FilePath (ReaderT Config Trace) FilePath
askBaseDir
  Trace () -> Build ()
forall a. Trace a -> Build a
liftTrace (Trace () -> Build ()) -> Trace () -> Build ()
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> Trace ()
rawSystem' FilePath
"cp" [FilePath
"-a", FilePath
baseDir FilePath -> FilePath -> FilePath
</> FilePath
debDN, FilePath
srcDir FilePath -> FilePath -> FilePath
</> FilePath
"."]


-- Setup source directory under build-directory using rsync.
rsyncGenOrigSourceDir :: Source -> Build FilePath
rsyncGenOrigSourceDir :: Source -> ReaderT FilePath (ReaderT Config Trace) FilePath
rsyncGenOrigSourceDir Source
pkg = do
  FilePath
srcDir   <- Source -> ReaderT FilePath (ReaderT Config Trace) FilePath
sourceDir Source
pkg
  FilePath
debDN    <- ReaderT FilePath (ReaderT Config Trace) FilePath
debianDirName'
  FilePath
baseDir  <- ReaderT FilePath (ReaderT Config Trace) FilePath
askBaseDir
  FilePath
bldDir   <- ReaderT FilePath (ReaderT Config Trace) FilePath
getBuildDir
  [FilePath]
confEXs  <- Config -> [FilePath]
sourceExcludes (Config -> [FilePath])
-> ReaderT FilePath (ReaderT Config Trace) Config
-> ReaderT FilePath (ReaderT Config Trace) [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT FilePath (ReaderT Config Trace) Config
askConfig
  let excludes :: [FilePath]
excludes = [FilePath -> FilePath
takeFileName FilePath
d
                 | FilePath
d <- [FilePath
bldDir]
                 , FilePath
baseDir FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` FilePath
d ]
                 [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
debDN] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
confEXs
  Trace () -> Build ()
forall a. Trace a -> Build a
liftTrace (Trace () -> Build ()) -> Trace () -> Build ()
forall a b. (a -> b) -> a -> b
$ do
    FilePath -> Trace ()
createDirectoryIfMissing FilePath
srcDir
    FilePath -> [FilePath] -> Trace ()
rawSystem' FilePath
"rsync"
      ([FilePath] -> Trace ()) -> [FilePath] -> Trace ()
forall a b. (a -> b) -> a -> b
$  [FilePath
"-auv"]
      [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"--exclude=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
e | FilePath
e <- [FilePath]
excludes]
      [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
baseDir FilePath -> FilePath -> FilePath
</> FilePath
".", FilePath
srcDir FilePath -> FilePath -> FilePath
</> FilePath
"." ]
  FilePath -> ReaderT FilePath (ReaderT Config Trace) FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
srcDir

-- | Setup source directory and original source archive under
--   build-directory using rsync.
rsyncGenOrigSources :: Source -> Build (FilePath, FilePath)
rsyncGenOrigSources :: Source -> Build (FilePath, FilePath)
rsyncGenOrigSources Source
pkg = do
  FilePath
srcDir <- Source -> ReaderT FilePath (ReaderT Config Trace) FilePath
rsyncGenOrigSourceDir Source
pkg
  FilePath
origPath  <- Source -> ReaderT FilePath (ReaderT Config Trace) FilePath
origArchive Source
pkg
  (FilePath -> Build ()) -> Build ()
forall a. (FilePath -> Build a) -> Build a
withBuildDir ((FilePath -> Build ()) -> Build ())
-> (FilePath -> Build ()) -> Build ()
forall a b. (a -> b) -> a -> b
$ Trace () -> Build ()
forall a. Trace a -> Build a
liftTrace (Trace () -> Build ())
-> (FilePath -> Trace ()) -> FilePath -> Build ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> FilePath -> Trace ()
packInDir' (FilePath -> FilePath
takeFileName FilePath
srcDir) FilePath
origPath
  FilePath -> Build ()
copyDebianDir FilePath
srcDir
  Trace () -> Build ()
forall a. Trace a -> Build a
liftTrace (Trace () -> Build ()) -> Trace () -> Build ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Trace ()
confirmPath FilePath
srcDir
  (FilePath, FilePath) -> Build (FilePath, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
origPath, FilePath
srcDir)

-- | Setup native source directory and native source archive under
--   build-directory using rsync.
rsyncGenNativeSources :: Source -> Build (FilePath, FilePath)
rsyncGenNativeSources :: Source -> Build (FilePath, FilePath)
rsyncGenNativeSources Source
pkg = do
  FilePath
srcDir <- Source -> ReaderT FilePath (ReaderT Config Trace) FilePath
rsyncGenOrigSourceDir Source
pkg
  FilePath -> Build ()
copyDebianDir FilePath
srcDir
  FilePath
nativePath <- Source -> ReaderT FilePath (ReaderT Config Trace) FilePath
nativeArchive Source
pkg
  (FilePath -> Build ()) -> Build ()
forall a. (FilePath -> Build a) -> Build a
withBuildDir ((FilePath -> Build ()) -> Build ())
-> (FilePath -> Build ()) -> Build ()
forall a b. (a -> b) -> a -> b
$ Trace () -> Build ()
forall a. Trace a -> Build a
liftTrace (Trace () -> Build ())
-> (FilePath -> Trace ()) -> FilePath -> Build ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> FilePath -> Trace ()
packInDir' (FilePath -> FilePath
takeFileName FilePath
srcDir) FilePath
nativePath
  Trace () -> Build ()
forall a. Trace a -> Build a
liftTrace (Trace () -> Build ()) -> Trace () -> Build ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Trace ()
confirmPath FilePath
srcDir
  (FilePath, FilePath) -> Build (FilePath, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
nativePath, FilePath
srcDir)

-- | Setup debian source directory and source archive.
rsyncGenSources :: Source -> Build (FilePath, FilePath)
rsyncGenSources :: Source -> Build (FilePath, FilePath)
rsyncGenSources Source
pkg
  | Source -> Bool
isNative Source
pkg = Source -> Build (FilePath, FilePath)
rsyncGenNativeSources Source
pkg
  | Bool
otherwise    = Source -> Build (FilePath, FilePath)
rsyncGenOrigSources   Source
pkg


-- Setup source archive using Cabal.
cabalGenArchive :: Hackage -> Build FilePath
cabalGenArchive :: Hackage -> ReaderT FilePath (ReaderT Config Trace) FilePath
cabalGenArchive Hackage
hkg = do
  Build () -> Build ()
forall a. Build a -> Build a
withBaseCurrentDir (Build () -> Build ())
-> (Trace () -> Build ()) -> Trace () -> Build ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace () -> Build ()
forall a. Trace a -> Build a
liftTrace (Trace () -> Build ()) -> Trace () -> Build ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> Trace ()
Cabal.sdist []
  FilePath
baseDir <- ReaderT FilePath (ReaderT Config Trace) FilePath
askBaseDir
  let apath :: FilePath
apath = FilePath
baseDir FilePath -> FilePath -> FilePath
</> Hackage -> FilePath
hackageArchive Hackage
hkg
  Trace () -> Build ()
forall a. Trace a -> Build a
liftTrace (Trace () -> Build ()) -> Trace () -> Build ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Trace ()
confirmPath FilePath
apath
  FilePath -> ReaderT FilePath (ReaderT Config Trace) FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
apath

-- Setup original source archive using Cabal.
cabalGenOrigArchive :: HaskellPackage -> Build FilePath
cabalGenOrigArchive :: HaskellPackage -> ReaderT FilePath (ReaderT Config Trace) FilePath
cabalGenOrigArchive HaskellPackage
hpkg = do
  FilePath
origPath <- Source -> ReaderT FilePath (ReaderT Config Trace) FilePath
origArchive (Source -> ReaderT FilePath (ReaderT Config Trace) FilePath)
-> Source -> ReaderT FilePath (ReaderT Config Trace) FilePath
forall a b. (a -> b) -> a -> b
$ HaskellPackage -> Source
package HaskellPackage
hpkg
  FilePath
apath    <- Hackage -> ReaderT FilePath (ReaderT Config Trace) FilePath
cabalGenArchive (Hackage -> ReaderT FilePath (ReaderT Config Trace) FilePath)
-> Hackage -> ReaderT FilePath (ReaderT Config Trace) FilePath
forall a b. (a -> b) -> a -> b
$ HaskellPackage -> Hackage
hackage HaskellPackage
hpkg
  Trace () -> Build ()
forall a. Trace a -> Build a
liftTrace (Trace () -> Build ()) -> Trace () -> Build ()
forall a b. (a -> b) -> a -> b
$ do
    FilePath -> Trace ()
createDirectoryIfMissing (FilePath -> Trace ()) -> FilePath -> Trace ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
takeDirectory FilePath
origPath
    FilePath -> FilePath -> Trace ()
renameFile FilePath
apath FilePath
origPath
  FilePath -> ReaderT FilePath (ReaderT Config Trace) FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
origPath

-- | Setup original source directory and archive using Cabal.
cabalGenOrigSources :: HaskellPackage -> Build (FilePath, FilePath)
cabalGenOrigSources :: HaskellPackage -> Build (FilePath, FilePath)
cabalGenOrigSources HaskellPackage
hpkg = do
  FilePath
origPath <- HaskellPackage -> ReaderT FilePath (ReaderT Config Trace) FilePath
cabalGenOrigArchive HaskellPackage
hpkg
  FilePath
srcDir   <- Source -> ReaderT FilePath (ReaderT Config Trace) FilePath
sourceDir (Source -> ReaderT FilePath (ReaderT Config Trace) FilePath)
-> Source -> ReaderT FilePath (ReaderT Config Trace) FilePath
forall a b. (a -> b) -> a -> b
$ HaskellPackage -> Source
package HaskellPackage
hpkg
  Trace () -> Build ()
forall a. Trace a -> Build a
liftTrace (Trace () -> Build ()) -> Trace () -> Build ()
forall a b. (a -> b) -> a -> b
$ do
    FilePath -> Trace ()
unpack FilePath
origPath
    FilePath -> FilePath -> Trace ()
renameDirectory
      (FilePath -> FilePath
takeDirectory FilePath
origPath FilePath -> FilePath -> FilePath
</> Hackage -> FilePath
hackageLongName (HaskellPackage -> Hackage
hackage HaskellPackage
hpkg))
      FilePath
srcDir
    FilePath -> Trace ()
confirmPath FilePath
srcDir
  (FilePath, FilePath) -> Build (FilePath, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
origPath, FilePath
srcDir)

-- | Setup source directory and archive using Cabal.
cabalGenSources :: HaskellPackage -> Build (FilePath, FilePath)
cabalGenSources :: HaskellPackage -> Build (FilePath, FilePath)
cabalGenSources HaskellPackage
hpkg = do
  pair :: (FilePath, FilePath)
pair@(FilePath
_, FilePath
srcDir) <- HaskellPackage -> Build (FilePath, FilePath)
cabalGenOrigSources HaskellPackage
hpkg
  FilePath -> Build ()
copyDebianDir FilePath
srcDir
  (FilePath, FilePath) -> Build (FilePath, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath, FilePath)
pair

cabalAutogenDebianDir :: Maybe String   -- ^ May specify revision string
                      -> [String]       -- ^ Optional arguments of cabal-debian command
                      -> Build FilePath -- ^ Generated debian-dir path
cabalAutogenDebianDir :: Maybe FilePath
-> [FilePath] -> ReaderT FilePath (ReaderT Config Trace) FilePath
cabalAutogenDebianDir Maybe FilePath
mayRev [FilePath]
cdArgs =  do
  FilePath
baseDir  <-  ReaderT FilePath (ReaderT Config Trace) FilePath
askBaseDir
  let ddName :: FilePath
ddName =  FilePath
"debian"
      tmpDD :: FilePath
tmpDD  =  FilePath
baseDir FilePath -> FilePath -> FilePath
</> FilePath
ddName
  Bool
exist <- IO Bool -> ReaderT FilePath (ReaderT Config Trace) Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> ReaderT FilePath (ReaderT Config Trace) Bool)
-> IO Bool -> ReaderT FilePath (ReaderT Config Trace) Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesDirectoryExist FilePath
tmpDD
  Bool -> Build () -> Build ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exist (FilePath -> Build ()
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> Build ()) -> FilePath -> Build ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Invalid state: directory already exist: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
tmpDD)

  FilePath
debDir   <-  (FilePath -> FilePath -> FilePath
</> FilePath
ddName) (FilePath -> FilePath)
-> ReaderT FilePath (ReaderT Config Trace) FilePath
-> ReaderT FilePath (ReaderT Config Trace) FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT FilePath (ReaderT Config Trace) FilePath
getBuildDir
  Trace () -> Build ()
forall a. Trace a -> Build a
liftTrace (Trace () -> Build ()) -> Trace () -> Build ()
forall a b. (a -> b) -> a -> b
$ do
    FilePath -> Maybe FilePath -> [FilePath] -> Trace ()
cabalDebian FilePath
baseDir Maybe FilePath
mayRev [FilePath]
cdArgs
    FilePath -> Trace ()
createDirectoryIfMissing (FilePath -> Trace ()) -> FilePath -> Trace ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
takeDirectory FilePath
debDir
    FilePath -> FilePath -> Trace ()
renameDirectory FilePath
tmpDD FilePath
debDir
  FilePath -> ReaderT FilePath (ReaderT Config Trace) FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
debDir

-- | Setup source directory and archive using Cabal and cabal-debian.
cabalAutogenSources :: String                                       -- ^ Hackge name string
                    -> Maybe String                                 -- ^ May specify revision string
                    -> [String]                                     -- ^ Optional arguments of cabal-debian command
                    -> Build ((FilePath, FilePath), HaskellPackage) -- ^ Result package informations of generated source
cabalAutogenSources :: FilePath
-> Maybe FilePath
-> [FilePath]
-> Build ((FilePath, FilePath), HaskellPackage)
cabalAutogenSources FilePath
hname Maybe FilePath
mayRev [FilePath]
cdArgs = do
  {- Fill Setup.hs to make cabal-debian can detect.
     Newer cabal-debian generates `DEB_SETUP_BIN_NAME = cabal' line,
     which causes home directory access errors at build time. -}
  IO () -> Build ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Build ()) -> (FilePath -> IO ()) -> FilePath -> Build ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO ()
Cabal.fillSetupHs (FilePath -> Build ())
-> ReaderT FilePath (ReaderT Config Trace) FilePath -> Build ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ReaderT FilePath (ReaderT Config Trace) FilePath
askBaseDir
  FilePath
debDir   <-  Maybe FilePath
-> [FilePath] -> ReaderT FilePath (ReaderT Config Trace) FilePath
cabalAutogenDebianDir Maybe FilePath
mayRev [FilePath]
cdArgs
  Source
pkg      <-  Trace Source -> Build Source
forall a. Trace a -> Build a
liftTrace (Trace Source -> Build Source)
-> (FilePath -> Trace Source) -> FilePath -> Build Source
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Trace Source
dpkgParseChangeLog (FilePath -> Build Source) -> FilePath -> Build Source
forall a b. (a -> b) -> a -> b
$ FilePath
debDir FilePath -> FilePath -> FilePath
</> FilePath
"changelog"
  let hpkg :: HaskellPackage
hpkg =   FilePath -> Source -> HaskellPackage
haskellPackageFromPackage FilePath
hname Source
pkg
  pair :: (FilePath, FilePath)
pair@(FilePath
_, FilePath
srcDir)  <-  HaskellPackage -> Build (FilePath, FilePath)
cabalGenOrigSources HaskellPackage
hpkg
  Trace () -> Build ()
forall a. Trace a -> Build a
liftTrace (Trace () -> Build ()) -> Trace () -> Build ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> Trace ()
renameDirectory FilePath
debDir (FilePath
srcDir FilePath -> FilePath -> FilePath
</> FilePath -> FilePath
takeFileName FilePath
debDir)
  ((FilePath, FilePath), HaskellPackage)
-> Build ((FilePath, FilePath), HaskellPackage)
forall (m :: * -> *) a. Monad m => a -> m a
return ((FilePath, FilePath)
pair, HaskellPackage
hpkg)


findDebianChangeLog :: MaybeT Build FilePath
findDebianChangeLog :: MaybeT Build FilePath
findDebianChangeLog =  ReaderT FilePath (ReaderT Config Trace) (Maybe FilePath)
-> MaybeT Build FilePath
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (ReaderT FilePath (ReaderT Config Trace) (Maybe FilePath)
 -> MaybeT Build FilePath)
-> ReaderT FilePath (ReaderT Config Trace) (Maybe FilePath)
-> MaybeT Build FilePath
forall a b. (a -> b) -> a -> b
$ do
  FilePath
baseDir  <-  ReaderT FilePath (ReaderT Config Trace) FilePath
askBaseDir
  FilePath
debDN    <-  ReaderT FilePath (ReaderT Config Trace) FilePath
debianDirName'
  let changelog :: FilePath
changelog = FilePath
baseDir FilePath -> FilePath -> FilePath
</> FilePath
debDN FilePath -> FilePath -> FilePath
</> FilePath
"changelog"
  IO (Maybe FilePath)
-> ReaderT FilePath (ReaderT Config Trace) (Maybe FilePath)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe FilePath)
 -> ReaderT FilePath (ReaderT Config Trace) (Maybe FilePath))
-> IO (Maybe FilePath)
-> ReaderT FilePath (ReaderT Config Trace) (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ do
    Bool
exist <- FilePath -> IO Bool
doesFileExist FilePath
changelog
    Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath -> IO (Maybe FilePath))
-> Maybe FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ if Bool
exist
             then FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
changelog
             else Maybe FilePath
forall a. Maybe a
Nothing

-- | Find debian .changes files
findDebianChanges :: Build [(FilePath, PackageType)]
findDebianChanges :: Build [(FilePath, PackageType)]
findDebianChanges =  do
  FilePath
bd <- ReaderT FilePath (ReaderT Config Trace) FilePath
getBuildDir
  [FilePath]
fs <- IO [FilePath] -> ReaderT FilePath (ReaderT Config Trace) [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath]
 -> ReaderT FilePath (ReaderT Config Trace) [FilePath])
-> IO [FilePath]
-> ReaderT FilePath (ReaderT Config Trace) [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> IO [FilePath]
getDirectoryContents FilePath
bd
  [(FilePath, PackageType)] -> Build [(FilePath, PackageType)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(FilePath, PackageType)] -> Build [(FilePath, PackageType)])
-> [(FilePath, PackageType)] -> Build [(FilePath, PackageType)]
forall a b. (a -> b) -> a -> b
$ [Maybe (FilePath, PackageType)] -> [(FilePath, PackageType)]
forall a. [Maybe a] -> [a]
catMaybes
    [ do PackageType
ty <- FilePath -> Maybe PackageType
takeChangesType FilePath
path
         (FilePath, PackageType) -> Maybe (FilePath, PackageType)
forall a. a -> Maybe a
Just (FilePath
path, PackageType
ty)
    | FilePath
path <- (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
bd FilePath -> FilePath -> FilePath
</>) [FilePath]
fs
    ]

findCabalDescription :: MaybeT Build FilePath
findCabalDescription :: MaybeT Build FilePath
findCabalDescription =  ReaderT FilePath (ReaderT Config Trace) (Maybe FilePath)
-> MaybeT Build FilePath
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (ReaderT FilePath (ReaderT Config Trace) FilePath
askBaseDir ReaderT FilePath (ReaderT Config Trace) FilePath
-> (FilePath
    -> ReaderT FilePath (ReaderT Config Trace) (Maybe FilePath))
-> ReaderT FilePath (ReaderT Config Trace) (Maybe FilePath)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO (Maybe FilePath)
-> ReaderT FilePath (ReaderT Config Trace) (Maybe FilePath)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe FilePath)
 -> ReaderT FilePath (ReaderT Config Trace) (Maybe FilePath))
-> (FilePath -> IO (Maybe FilePath))
-> FilePath
-> ReaderT FilePath (ReaderT Config Trace) (Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO (Maybe FilePath)
Cabal.findDescriptionFile)

-- | On the fly setup of source directory and archive.
genSources :: Maybe String                                                -- ^ May specify revision string
           -> [String]                                                    -- ^ Optional arguments of cabal-debian command
           -> Build (Maybe ((FilePath, FilePath), Source, Maybe Hackage)) -- ^ Result package informations of generated source
genSources :: Maybe FilePath
-> [FilePath]
-> Build (Maybe ((FilePath, FilePath), Source, Maybe Hackage))
genSources Maybe FilePath
mayRev [FilePath]
cdArgs = MaybeT Build ((FilePath, FilePath), Source, Maybe Hackage)
-> Build (Maybe ((FilePath, FilePath), Source, Maybe Hackage))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT Build ((FilePath, FilePath), Source, Maybe Hackage)
 -> Build (Maybe ((FilePath, FilePath), Source, Maybe Hackage)))
-> MaybeT Build ((FilePath, FilePath), Source, Maybe Hackage)
-> Build (Maybe ((FilePath, FilePath), Source, Maybe Hackage))
forall a b. (a -> b) -> a -> b
$
  do FilePath
clog <- MaybeT Build FilePath
findDebianChangeLog
     Source
src  <- Build Source -> MaybeT Build Source
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Build Source -> MaybeT Build Source)
-> (Trace Source -> Build Source)
-> Trace Source
-> MaybeT Build Source
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace Source -> Build Source
forall a. Trace a -> Build a
liftTrace (Trace Source -> MaybeT Build Source)
-> Trace Source -> MaybeT Build Source
forall a b. (a -> b) -> a -> b
$ FilePath -> Trace Source
dpkgParseChangeLog FilePath
clog
     (do FilePath
hname <- FilePath -> FilePath
takeBaseName (FilePath -> FilePath)
-> MaybeT Build FilePath -> MaybeT Build FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MaybeT Build FilePath
findCabalDescription
         let hpkg :: HaskellPackage
hpkg = FilePath -> Source -> HaskellPackage
haskellPackageFromPackage FilePath
hname Source
src
         (FilePath, FilePath)
p <- Build (FilePath, FilePath) -> MaybeT Build (FilePath, FilePath)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Build (FilePath, FilePath) -> MaybeT Build (FilePath, FilePath))
-> Build (FilePath, FilePath) -> MaybeT Build (FilePath, FilePath)
forall a b. (a -> b) -> a -> b
$ HaskellPackage -> Build (FilePath, FilePath)
cabalGenSources HaskellPackage
hpkg
         ((FilePath, FilePath), Source, Maybe Hackage)
-> MaybeT Build ((FilePath, FilePath), Source, Maybe Hackage)
forall (m :: * -> *) a. Monad m => a -> m a
return ((FilePath, FilePath)
p, Source
src, Hackage -> Maybe Hackage
forall a. a -> Maybe a
Just (Hackage -> Maybe Hackage) -> Hackage -> Maybe Hackage
forall a b. (a -> b) -> a -> b
$ HaskellPackage -> Hackage
hackage HaskellPackage
hpkg)
      MaybeT Build ((FilePath, FilePath), Source, Maybe Hackage)
-> MaybeT Build ((FilePath, FilePath), Source, Maybe Hackage)
-> MaybeT Build ((FilePath, FilePath), Source, Maybe Hackage)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
      do ReaderT
  FilePath
  (ReaderT Config Trace)
  ((FilePath, FilePath), Source, Maybe Hackage)
-> MaybeT Build ((FilePath, FilePath), Source, Maybe Hackage)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT
   FilePath
   (ReaderT Config Trace)
   ((FilePath, FilePath), Source, Maybe Hackage)
 -> MaybeT Build ((FilePath, FilePath), Source, Maybe Hackage))
-> ReaderT
     FilePath
     (ReaderT Config Trace)
     ((FilePath, FilePath), Source, Maybe Hackage)
-> MaybeT Build ((FilePath, FilePath), Source, Maybe Hackage)
forall a b. (a -> b) -> a -> b
$ (,,) ((FilePath, FilePath)
 -> Source
 -> Maybe Hackage
 -> ((FilePath, FilePath), Source, Maybe Hackage))
-> Build (FilePath, FilePath)
-> ReaderT
     FilePath
     (ReaderT Config Trace)
     (Source
      -> Maybe Hackage -> ((FilePath, FilePath), Source, Maybe Hackage))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Source -> Build (FilePath, FilePath)
rsyncGenSources Source
src ReaderT
  FilePath
  (ReaderT Config Trace)
  (Source
   -> Maybe Hackage -> ((FilePath, FilePath), Source, Maybe Hackage))
-> Build Source
-> ReaderT
     FilePath
     (ReaderT Config Trace)
     (Maybe Hackage -> ((FilePath, FilePath), Source, Maybe Hackage))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Source -> Build Source
forall (f :: * -> *) a. Applicative f => a -> f a
pure Source
src ReaderT
  FilePath
  (ReaderT Config Trace)
  (Maybe Hackage -> ((FilePath, FilePath), Source, Maybe Hackage))
-> ReaderT FilePath (ReaderT Config Trace) (Maybe Hackage)
-> ReaderT
     FilePath
     (ReaderT Config Trace)
     ((FilePath, FilePath), Source, Maybe Hackage)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Hackage
-> ReaderT FilePath (ReaderT Config Trace) (Maybe Hackage)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Hackage
forall a. Maybe a
Nothing)
  MaybeT Build ((FilePath, FilePath), Source, Maybe Hackage)
-> MaybeT Build ((FilePath, FilePath), Source, Maybe Hackage)
-> MaybeT Build ((FilePath, FilePath), Source, Maybe Hackage)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  do FilePath
hname <- FilePath -> FilePath
takeBaseName (FilePath -> FilePath)
-> MaybeT Build FilePath -> MaybeT Build FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MaybeT Build FilePath
findCabalDescription
     ReaderT
  FilePath
  (ReaderT Config Trace)
  ((FilePath, FilePath), Source, Maybe Hackage)
-> MaybeT Build ((FilePath, FilePath), Source, Maybe Hackage)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT
   FilePath
   (ReaderT Config Trace)
   ((FilePath, FilePath), Source, Maybe Hackage)
 -> MaybeT Build ((FilePath, FilePath), Source, Maybe Hackage))
-> ReaderT
     FilePath
     (ReaderT Config Trace)
     ((FilePath, FilePath), Source, Maybe Hackage)
-> MaybeT Build ((FilePath, FilePath), Source, Maybe Hackage)
forall a b. (a -> b) -> a -> b
$ do
       ((FilePath, FilePath)
p, HaskellPackage
hpkg) <- FilePath
-> Maybe FilePath
-> [FilePath]
-> Build ((FilePath, FilePath), HaskellPackage)
cabalAutogenSources FilePath
hname Maybe FilePath
mayRev [FilePath]
cdArgs
       ((FilePath, FilePath), Source, Maybe Hackage)
-> ReaderT
     FilePath
     (ReaderT Config Trace)
     ((FilePath, FilePath), Source, Maybe Hackage)
forall (m :: * -> *) a. Monad m => a -> m a
return ((FilePath, FilePath)
p, HaskellPackage -> Source
package HaskellPackage
hpkg, Hackage -> Maybe Hackage
forall a. a -> Maybe a
Just (Hackage -> Maybe Hackage) -> Hackage -> Maybe Hackage
forall a b. (a -> b) -> a -> b
$ HaskellPackage -> Hackage
hackage HaskellPackage
hpkg)
  MaybeT Build ((FilePath, FilePath), Source, Maybe Hackage)
-> MaybeT Build ((FilePath, FilePath), Source, Maybe Hackage)
-> MaybeT Build ((FilePath, FilePath), Source, Maybe Hackage)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  do FilePath
-> MaybeT Build ((FilePath, FilePath), Source, Maybe Hackage)
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"No source generate rule found."

-- | Probe generated source directory path.
findGeneratedSourceDir :: MaybeT Build FilePath
findGeneratedSourceDir :: MaybeT Build FilePath
findGeneratedSourceDir = do
  FilePath
bd  <- ReaderT FilePath (ReaderT Config Trace) FilePath
-> MaybeT Build FilePath
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT FilePath (ReaderT Config Trace) FilePath
getBuildDir
  [FilePath]
fs  <- IO [FilePath] -> MaybeT Build [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath] -> MaybeT Build [FilePath])
-> IO [FilePath] -> MaybeT Build [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> IO [FilePath]
getDirectoryContents FilePath
bd
  [MaybeT Build FilePath] -> MaybeT Build FilePath
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
    [ do Build (Maybe ()) -> MaybeT Build ()
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Build (Maybe ()) -> MaybeT Build ())
-> (IO (Maybe ()) -> Build (Maybe ()))
-> IO (Maybe ())
-> MaybeT Build ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Maybe ()) -> Build (Maybe ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ()) -> MaybeT Build ())
-> IO (Maybe ()) -> MaybeT Build ()
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> IO Bool -> IO (Maybe ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Bool
doesFileExist (FilePath
path FilePath -> FilePath -> FilePath
</> FilePath
"debian" FilePath -> FilePath -> FilePath
</> FilePath
"control")
         FilePath -> MaybeT Build FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
path
    | FilePath
f  <- [FilePath]
fs
    , FilePath
f FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [FilePath
".", FilePath
".."]
    , let path :: FilePath
path = FilePath
bd FilePath -> FilePath -> FilePath
</> FilePath
f
    ]

-- | Probe generated source informations
findGeneratedSource :: MaybeT Build (FilePath, Source, Hackage)
findGeneratedSource :: MaybeT Build (FilePath, Source, Hackage)
findGeneratedSource = do
  FilePath
srcDir <- MaybeT Build FilePath
findGeneratedSourceDir
  Source
src    <- Build Source -> MaybeT Build Source
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Build Source -> MaybeT Build Source)
-> (Trace Source -> Build Source)
-> Trace Source
-> MaybeT Build Source
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace Source -> Build Source
forall a. Trace a -> Build a
liftTrace (Trace Source -> MaybeT Build Source)
-> Trace Source -> MaybeT Build Source
forall a b. (a -> b) -> a -> b
$ FilePath -> Trace Source
dpkgParseChangeLog (FilePath -> Trace Source) -> FilePath -> Trace Source
forall a b. (a -> b) -> a -> b
$ FilePath
srcDir FilePath -> FilePath -> FilePath
</> FilePath
"debian" FilePath -> FilePath -> FilePath
</> FilePath
"changelog"
  FilePath
hname <- FilePath -> FilePath
takeBaseName (FilePath -> FilePath)
-> MaybeT Build FilePath -> MaybeT Build FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MaybeT Build FilePath
findCabalDescription
  (FilePath, Source, Hackage)
-> MaybeT Build (FilePath, Source, Hackage)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
srcDir, Source
src, HaskellPackage -> Hackage
hackage (HaskellPackage -> Hackage) -> HaskellPackage -> Hackage
forall a b. (a -> b) -> a -> b
$ FilePath -> Source -> HaskellPackage
haskellPackageFromPackage FilePath
hname Source
src)