-- |
-- Module      : Debian.Package.Build.Command
-- Copyright   : 2014-2015 Kei Hibino
-- License     : BSD3
--
-- Maintainer  : ex8k.hibino@gmail.com
-- Stability   : experimental
-- Portability : portable
--
-- This module provides trace-able action instances like commands.
module Debian.Package.Build.Command
       ( chdir, pwd

       , createDirectoryIfMissing, renameDirectory, renameFile

       , confirmPath

       , unpackInDir, unpack, packInDir', packInDir

       , cabalDebian', cabalDebian, packageVersion
       , dpkgParseChangeLog, dpkgParseControl

       , debuild, debi', debi, aptGetBuildDepends

       , BuildMode (..)

       , modeListFromControl, buildPackage, build, rebuild

       , removeGhcLibrary

       , withCurrentDir'

       , readProcess', rawSystem', system'
       ) where

import Data.Maybe (fromMaybe)
import Control.Applicative ((<$>))
import Control.Monad (when, unless)
import Control.Monad.Trans.Class (lift)
import System.FilePath ((</>), (<.>), takeDirectory)
import qualified System.Directory as D
import qualified System.Process as Process
import System.Exit (ExitCode (..))
import Data.Version (versionBranch, showVersion)

import Debian.Package.Data
  (Hackage, ghcLibraryBinPackages, ghcLibraryPackages, ghcLibraryDocPackage,
   Source, parseChangeLog, DebianVersion, readDebianVersion, origVersion',
   Control (..), parseControl)
import Debian.Package.Build.Monad (Trace, traceCommand, traceOut, putLog, bracketTrace_)


handleExit :: String -> ExitCode -> IO ()
handleExit :: String -> ExitCode -> IO ()
handleExit String
cmd = ExitCode -> IO ()
forall (m :: * -> *). MonadFail m => ExitCode -> m ()
d  where
  d :: ExitCode -> m ()
d (ExitFailure Int
rv) = String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"Failed with", Int -> String
forall a. Show a => a -> String
show Int
rv String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":", String
cmd]
  d  ExitCode
ExitSuccess     = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Run command without shell and get standard output string.
readProcess' :: String -> [String] -> String -> Trace String
readProcess' :: String -> [String] -> String -> Trace String
readProcess' String
cmd [String]
args String
in' = do
  String -> Trace ()
traceCommand (String -> Trace ())
-> ([String] -> String) -> [String] -> Trace ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords ([String] -> Trace ()) -> [String] -> Trace ()
forall a b. (a -> b) -> a -> b
$ String
cmd String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
args
  IO String -> Trace String
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO String -> Trace String) -> IO String -> Trace String
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String -> IO String
Process.readProcess String
cmd [String]
args String
in'

-- | Run command without shell
rawSystem' :: String -> [String] -> Trace ()
rawSystem' :: String -> [String] -> Trace ()
rawSystem' String
cmd [String]
args = do
  String -> Trace ()
traceCommand (String -> Trace ())
-> ([String] -> String) -> [String] -> Trace ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords ([String] -> Trace ()) -> [String] -> Trace ()
forall a b. (a -> b) -> a -> b
$ String
cmd String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
args
  IO () -> Trace ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (String -> [String] -> IO ExitCode
Process.rawSystem String
cmd [String]
args IO ExitCode -> (ExitCode -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ExitCode -> IO ()
handleExit String
cmd)

-- | Run command with shell
system' :: String -> Trace ()
system' :: String -> Trace ()
system' String
cmd = do
  String -> Trace ()
traceCommand String
cmd
  IO () -> Trace ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> Trace ()) -> IO () -> Trace ()
forall a b. (a -> b) -> a -> b
$ String -> IO ExitCode
Process.system String
cmd IO ExitCode -> (ExitCode -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ExitCode -> IO ()
handleExit String
cmd

-- | Change directory action
chdir :: String -> Trace ()
chdir :: String -> Trace ()
chdir String
dir =  do
  String -> Trace ()
traceCommand (String -> Trace ()) -> String -> Trace ()
forall a b. (a -> b) -> a -> b
$ String
"<setCurrentDirectory> " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
dir
  IO () -> Trace ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> Trace ()) -> IO () -> Trace ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
D.setCurrentDirectory String
dir

-- | Action to get current working directory
pwd :: IO String
pwd :: IO String
pwd =  IO String
D.getCurrentDirectory

-- | Create directory if missing
createDirectoryIfMissing :: String -> Trace ()
createDirectoryIfMissing :: String -> Trace ()
createDirectoryIfMissing String
dir = do
  String -> Trace ()
traceCommand (String -> Trace ()) -> String -> Trace ()
forall a b. (a -> b) -> a -> b
$ String
"<createDirectoryIfMissing True> " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
dir
  IO () -> Trace ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> Trace ()) -> IO () -> Trace ()
forall a b. (a -> b) -> a -> b
$ Bool -> String -> IO ()
D.createDirectoryIfMissing Bool
True String
dir

renameMsg :: String -> String -> String -> String
renameMsg :: String -> String -> String -> String
renameMsg String
tag String
src String
dst = [String] -> String
unwords [String
"<" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
tag String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"> ", String
src, String
"-->", String
dst]

-- | Rename directory action. e.g. /renameDirectory from to/
renameDirectory :: String -> String -> Trace ()
renameDirectory :: String -> String -> Trace ()
renameDirectory String
src String
dst = do
  String -> Trace ()
traceCommand (String -> Trace ()) -> String -> Trace ()
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> String
renameMsg String
"renameDirectory" String
src String
dst
  IO () -> Trace ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> Trace ()) -> IO () -> Trace ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
D.renameDirectory String
src String
dst

-- | Rename file action. e.g. /renameFile from to/
renameFile :: String -> String -> Trace ()
renameFile :: String -> String -> Trace ()
renameFile String
src String
dst = do
  String -> Trace ()
traceCommand (String -> Trace ()) -> String -> Trace ()
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> String
renameMsg String
"renameFile" String
src String
dst
  IO () -> Trace ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> Trace ()) -> IO () -> Trace ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
D.renameFile String
src String
dst

-- | Confirm filepath using /ls/ command
confirmPath :: String -> Trace ()
confirmPath :: String -> Trace ()
confirmPath String
path =
  String -> [String] -> String -> Trace String
readProcess' String
"ls" [String
"-ld", String
path] String
"" Trace String -> (String -> Trace ()) -> Trace ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Trace ()
traceOut


-- | Unpack .tar.gz under directory.
unpackInDir :: FilePath -> FilePath -> Trace ()
String
apath unpackInDir :: String -> String -> Trace ()
`unpackInDir` String
dir = do
  String -> Trace ()
putLog (String -> Trace ()) -> String -> Trace ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"Unpacking", String
apath, String
"in", String
dir, String
"."]
  String -> [String] -> Trace ()
rawSystem' String
"tar" [String
"-C", String
dir, String
"-zxf", String
apath]

-- | Unpack .tar.gz under archive place.
unpack :: FilePath -> Trace ()
unpack :: String -> Trace ()
unpack String
apath = String
apath String -> String -> Trace ()
`unpackInDir` String -> String
takeDirectory String
apath

-- | Pack directory into .tar.gz under working directory
packInDir' :: FilePath -> FilePath -> FilePath -> Trace ()
packInDir' :: String -> String -> String -> Trace ()
packInDir' String
pdir String
apath String
wdir = do
  String -> Trace ()
putLog (String -> Trace ()) -> String -> Trace ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"Packing", String
pdir, String
"in", String
wdir, String
"into", String
apath, String
"."]
  String -> [String] -> Trace ()
rawSystem' String
"tar" [String
"-C", String
wdir, String
"-zcf", String
apath, String
pdir]

-- | Pack directory into same location .tar.gz under working directory
packInDir :: FilePath -> FilePath -> Trace ()
String
pdir packInDir :: String -> String -> Trace ()
`packInDir` String
wdir =
  String -> String -> String -> Trace ()
packInDir' String
pdir (String
pdir String -> String -> String
<.> String
"tar" String -> String -> String
<.> String
"gz") String
wdir


-- | Run action under specified directory
withCurrentDir' :: FilePath -> Trace a -> Trace a
withCurrentDir' :: String -> Trace a -> Trace a
withCurrentDir' String
dir Trace a
act = do
  String
saveDir <- IO String -> Trace String
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift IO String
pwd
  Trace () -> Trace () -> Trace a -> Trace a
forall a b c. Trace a -> Trace b -> Trace c -> Trace c
bracketTrace_
    (String -> Trace ()
chdir String
dir)
    (String -> Trace ()
chdir String
saveDir)
    Trace a
act

-- | Just call /cabal-debian/ command
cabalDebian' :: Maybe String -> [String] -> Trace ()
cabalDebian' :: Maybe String -> [String] -> Trace ()
cabalDebian' Maybe String
mayRev [String]
otherArgs = do
  Version
ver <-  DebianVersion -> Version
origVersion' (DebianVersion -> Version)
-> ReaderT Bool IO DebianVersion -> ReaderT Bool IO Version
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ReaderT Bool IO DebianVersion
packageVersion String
"cabal-debian"
  let revision :: String
revision = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"1~autogen1" Maybe String
mayRev
      oldArgs :: [String]
oldArgs = [String
"--quilt", String
"--revision=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
revision]
      verBranch :: [Int]
verBranch = Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
2 ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ Version -> [Int]
versionBranch Version
ver [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
0,Int
0]

  [String]
args <- case [Int]
verBranch of
    (Int
x:Int
y:[Int]
_)  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1             ->  String -> ReaderT Bool IO [String]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
                                      (String -> ReaderT Bool IO [String])
-> String -> ReaderT Bool IO [String]
forall a b. (a -> b) -> a -> b
$ String
"Version of cabal-debian is TOO OLD: "
                                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Version -> String
showVersion Version
ver String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'"
                                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" - Under version 1 generates wrong dependencies."
             | Int
2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
x Bool -> Bool -> Bool
&& Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
3   ->  [String] -> ReaderT Bool IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [String]
oldArgs
             | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4 Bool -> Bool -> Bool
&& Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<  Int
19  ->  [String] -> ReaderT Bool IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [String]
oldArgs
             | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
4             ->  [String] -> ReaderT Bool IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [String
"--revision=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
'-' Char -> String -> String
forall a. a -> [a] -> [a]
: String
revision]
             | Bool
otherwise          ->  String -> ReaderT Bool IO [String]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
                                      (String -> ReaderT Bool IO [String])
-> String -> ReaderT Bool IO [String]
forall a b. (a -> b) -> a -> b
$ String
"unknown version: "
                                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Version -> String
showVersion Version
ver String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'"
    [Int]
_                             ->  String -> ReaderT Bool IO [String]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
                                      (String -> ReaderT Bool IO [String])
-> String -> ReaderT Bool IO [String]
forall a b. (a -> b) -> a -> b
$ String
"unexpected version format: "
                                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Version -> String
showVersion Version
ver String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'"

  String -> [String] -> Trace ()
rawSystem' String
"cabal-debian" ([String] -> Trace ()) -> [String] -> Trace ()
forall a b. (a -> b) -> a -> b
$ [String]
args [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
otherArgs

-- | Call /cabal-debian/ command under specified directory
cabalDebian :: FilePath -> Maybe String -> [String] -> Trace ()
cabalDebian :: String -> Maybe String -> [String] -> Trace ()
cabalDebian String
dir Maybe String
mayRev = String -> Trace () -> Trace ()
forall a. String -> Trace a -> Trace a
withCurrentDir' String
dir (Trace () -> Trace ())
-> ([String] -> Trace ()) -> [String] -> Trace ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String -> [String] -> Trace ()
cabalDebian' Maybe String
mayRev

-- | Query debian package version
packageVersion :: String -> Trace DebianVersion
packageVersion :: String -> ReaderT Bool IO DebianVersion
packageVersion String
pkg = do
  String
vstr <- String -> [String] -> String -> Trace String
readProcess' String
"dpkg-query" [String
"--show", String
"--showformat=${Version}", String
pkg] String
""
  ReaderT Bool IO DebianVersion
-> (DebianVersion -> ReaderT Bool IO DebianVersion)
-> Maybe DebianVersion
-> ReaderT Bool IO DebianVersion
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> ReaderT Bool IO DebianVersion
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> ReaderT Bool IO DebianVersion)
-> String -> ReaderT Bool IO DebianVersion
forall a b. (a -> b) -> a -> b
$ String
"readDebianVersion: failed: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
vstr) DebianVersion -> ReaderT Bool IO DebianVersion
forall (m :: * -> *) a. Monad m => a -> m a
return
    (Maybe DebianVersion -> ReaderT Bool IO DebianVersion)
-> Maybe DebianVersion -> ReaderT Bool IO DebianVersion
forall a b. (a -> b) -> a -> b
$ String -> Maybe DebianVersion
readDebianVersion String
vstr

-- | Read debian changelog file and try to parse into 'Source'
dpkgParseChangeLog :: FilePath -> Trace Source
dpkgParseChangeLog :: String -> Trace Source
dpkgParseChangeLog String
cpath =  do
  String
str <- String -> [String] -> String -> Trace String
readProcess' String
"dpkg-parsechangelog" [String
"-l" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cpath] String
""
  Trace Source
-> (Source -> Trace Source) -> Maybe Source -> Trace Source
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Trace Source
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Trace Source) -> String -> Trace Source
forall a b. (a -> b) -> a -> b
$ String
"parseChangeLog: failed: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str) Source -> Trace Source
forall (m :: * -> *) a. Monad m => a -> m a
return
    (Maybe Source -> Trace Source) -> Maybe Source -> Trace Source
forall a b. (a -> b) -> a -> b
$ String -> Maybe Source
parseChangeLog String
str

-- | Read debian control file
dpkgParseControl :: FilePath -> Trace Control
dpkgParseControl :: String -> Trace Control
dpkgParseControl String
cpath =  do
  String -> Trace ()
putLog (String -> Trace ()) -> String -> Trace ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"Reading", String
cpath, String
"."]
  String
str <- IO String -> Trace String
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO String -> Trace String) -> IO String -> Trace String
forall a b. (a -> b) -> a -> b
$ String -> IO String
readFile String
cpath
  Trace Control
-> (Control -> Trace Control) -> Maybe Control -> Trace Control
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Trace Control
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Trace Control) -> String -> Trace Control
forall a b. (a -> b) -> a -> b
$ String
"parseControl: failed: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str) Control -> Trace Control
forall (m :: * -> *) a. Monad m => a -> m a
return
    (Maybe Control -> Trace Control) -> Maybe Control -> Trace Control
forall a b. (a -> b) -> a -> b
$ String -> Maybe Control
parseControl String
str


debuild' :: [String] -> Trace ()
debuild' :: [String] -> Trace ()
debuild' =  String -> [String] -> Trace ()
rawSystem' String
"debuild"

-- | Call /debuild/ under specified directory, with command line options
debuild :: FilePath -> [String] -> Trace ()
debuild :: String -> [String] -> Trace ()
debuild String
dir = String -> Trace () -> Trace ()
forall a. String -> Trace a -> Trace a
withCurrentDir' String
dir (Trace () -> Trace ())
-> ([String] -> Trace ()) -> [String] -> Trace ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Trace ()
debuild'

-- | Just run debi with root user
debi' :: [String] -> Trace ()
debi' :: [String] -> Trace ()
debi' =  String -> [String] -> Trace ()
rawSystem' String
"sudo" ([String] -> Trace ())
-> ([String] -> [String]) -> [String] -> Trace ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"debi" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:)

-- | Install packages under specified source package directory
debi :: FilePath -> [String] -> Trace ()
debi :: String -> [String] -> Trace ()
debi String
dir = String -> Trace () -> Trace ()
forall a. String -> Trace a -> Trace a
withCurrentDir' String
dir (Trace () -> Trace ())
-> ([String] -> Trace ()) -> [String] -> Trace ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Trace ()
debi'

-- | Install build-depends
aptGetBuildDepends :: FilePath -> Trace ()
aptGetBuildDepends :: String -> Trace ()
aptGetBuildDepends String
dir =
  String -> Trace () -> Trace ()
forall a. String -> Trace a -> Trace a
withCurrentDir' String
dir (Trace () -> Trace ()) -> Trace () -> Trace ()
forall a b. (a -> b) -> a -> b
$ String -> [String] -> Trace ()
rawSystem' String
"sudo" [String
"apt-get-build-depends"]

-- | Build mode, all or binary only
data BuildMode = All | Bin | Src | Dep | Indep
               deriving (BuildMode -> BuildMode -> Bool
(BuildMode -> BuildMode -> Bool)
-> (BuildMode -> BuildMode -> Bool) -> Eq BuildMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BuildMode -> BuildMode -> Bool
$c/= :: BuildMode -> BuildMode -> Bool
== :: BuildMode -> BuildMode -> Bool
$c== :: BuildMode -> BuildMode -> Bool
Eq, Int -> BuildMode -> String -> String
[BuildMode] -> String -> String
BuildMode -> String
(Int -> BuildMode -> String -> String)
-> (BuildMode -> String)
-> ([BuildMode] -> String -> String)
-> Show BuildMode
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [BuildMode] -> String -> String
$cshowList :: [BuildMode] -> String -> String
show :: BuildMode -> String
$cshow :: BuildMode -> String
showsPrec :: Int -> BuildMode -> String -> String
$cshowsPrec :: Int -> BuildMode -> String -> String
Show, ReadPrec [BuildMode]
ReadPrec BuildMode
Int -> ReadS BuildMode
ReadS [BuildMode]
(Int -> ReadS BuildMode)
-> ReadS [BuildMode]
-> ReadPrec BuildMode
-> ReadPrec [BuildMode]
-> Read BuildMode
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BuildMode]
$creadListPrec :: ReadPrec [BuildMode]
readPrec :: ReadPrec BuildMode
$creadPrec :: ReadPrec BuildMode
readList :: ReadS [BuildMode]
$creadList :: ReadS [BuildMode]
readsPrec :: Int -> ReadS BuildMode
$creadsPrec :: Int -> ReadS BuildMode
Read, BuildMode
BuildMode -> BuildMode -> Bounded BuildMode
forall a. a -> a -> Bounded a
maxBound :: BuildMode
$cmaxBound :: BuildMode
minBound :: BuildMode
$cminBound :: BuildMode
Bounded, Int -> BuildMode
BuildMode -> Int
BuildMode -> [BuildMode]
BuildMode -> BuildMode
BuildMode -> BuildMode -> [BuildMode]
BuildMode -> BuildMode -> BuildMode -> [BuildMode]
(BuildMode -> BuildMode)
-> (BuildMode -> BuildMode)
-> (Int -> BuildMode)
-> (BuildMode -> Int)
-> (BuildMode -> [BuildMode])
-> (BuildMode -> BuildMode -> [BuildMode])
-> (BuildMode -> BuildMode -> [BuildMode])
-> (BuildMode -> BuildMode -> BuildMode -> [BuildMode])
-> Enum BuildMode
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: BuildMode -> BuildMode -> BuildMode -> [BuildMode]
$cenumFromThenTo :: BuildMode -> BuildMode -> BuildMode -> [BuildMode]
enumFromTo :: BuildMode -> BuildMode -> [BuildMode]
$cenumFromTo :: BuildMode -> BuildMode -> [BuildMode]
enumFromThen :: BuildMode -> BuildMode -> [BuildMode]
$cenumFromThen :: BuildMode -> BuildMode -> [BuildMode]
enumFrom :: BuildMode -> [BuildMode]
$cenumFrom :: BuildMode -> [BuildMode]
fromEnum :: BuildMode -> Int
$cfromEnum :: BuildMode -> Int
toEnum :: Int -> BuildMode
$ctoEnum :: Int -> BuildMode
pred :: BuildMode -> BuildMode
$cpred :: BuildMode -> BuildMode
succ :: BuildMode -> BuildMode
$csucc :: BuildMode -> BuildMode
Enum)

-- | Infer all build mode list from debian control file data
modeListFromControl :: Control -> [BuildMode]
modeListFromControl :: Control -> [BuildMode]
modeListFromControl Control
c =
  BuildMode
Src
  BuildMode -> [BuildMode] -> [BuildMode]
forall a. a -> [a] -> [a]
:  [ BuildMode
Dep   | Bool -> Bool
not (Bool -> Bool) -> ([String] -> Bool) -> [String] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([String] -> Bool) -> [String] -> Bool
forall a b. (a -> b) -> a -> b
$ Control -> [String]
controlArch Control
c ]
  [BuildMode] -> [BuildMode] -> [BuildMode]
forall a. [a] -> [a] -> [a]
++ [ BuildMode
Indep | Bool -> Bool
not (Bool -> Bool) -> ([String] -> Bool) -> [String] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([String] -> Bool) -> [String] -> Bool
forall a b. (a -> b) -> a -> b
$ Control -> [String]
controlAll  Control
c ]

hasBinaryBuildMode :: BuildMode -> Bool
hasBinaryBuildMode :: BuildMode -> Bool
hasBinaryBuildMode =  Bool -> Bool
not (Bool -> Bool) -> (BuildMode -> Bool) -> BuildMode -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BuildMode -> BuildMode -> Bool
forall a. Eq a => a -> a -> Bool
== BuildMode
Src)

-- | Build package using /debuild/ under specified directory
buildPackage :: FilePath -> BuildMode -> [String] -> Trace ()
buildPackage :: String -> BuildMode -> [String] -> Trace ()
buildPackage String
dir BuildMode
mode [String]
opts = do
  let modeOpt :: BuildMode -> [String]
modeOpt BuildMode
All    =  []
      modeOpt BuildMode
Bin    =  [String
"-b"]
      modeOpt BuildMode
Src    =  [String
"-S"]
      modeOpt BuildMode
Dep    =  [String
"-B"]
      modeOpt BuildMode
Indep  =  [String
"-A"]
  String -> [String] -> Trace ()
debuild String
dir ([String] -> Trace ()) -> [String] -> Trace ()
forall a b. (a -> b) -> a -> b
$ [String
"-uc", String
"-us"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ BuildMode -> [String]
modeOpt BuildMode
mode [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
opts

-- | Build package with specified mode list.
--   Calculated mode list from control is used when not specified build modes.
build :: FilePath -> [BuildMode] -> Bool -> [String] -> Trace ()
build :: String -> [BuildMode] -> Bool -> [String] -> Trace ()
build String
dir [BuildMode]
modes' Bool
installDep [String]
opts = do
  [BuildMode]
modes <-
    if [BuildMode] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [BuildMode]
modes'
    then Control -> [BuildMode]
modeListFromControl (Control -> [BuildMode])
-> Trace Control -> ReaderT Bool IO [BuildMode]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Trace Control
dpkgParseControl (String
dir String -> String -> String
</> String
"debian" String -> String -> String
</> String
"control")
    else [BuildMode] -> ReaderT Bool IO [BuildMode]
forall (m :: * -> *) a. Monad m => a -> m a
return [BuildMode]
modes'
  Bool -> Trace () -> Trace ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
installDep Bool -> Bool -> Bool
&& (BuildMode -> Bool) -> [BuildMode] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any BuildMode -> Bool
hasBinaryBuildMode [BuildMode]
modes) (Trace () -> Trace ()) -> Trace () -> Trace ()
forall a b. (a -> b) -> a -> b
$ String -> Trace ()
aptGetBuildDepends String
dir
  [Trace ()] -> Trace ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [String -> BuildMode -> [String] -> Trace ()
buildPackage String
dir BuildMode
m [String]
opts | BuildMode
m <- [BuildMode]
modes]

-- | Clean and build package using /debuild/ under specified directory
rebuild :: FilePath -> [BuildMode] -> [String] -> Trace ()
rebuild :: String -> [BuildMode] -> [String] -> Trace ()
rebuild String
dir [BuildMode]
modes [String]
opts = do
  String -> [String] -> Trace ()
debuild String
dir [String
"clean"]
  String -> [BuildMode] -> Bool -> [String] -> Trace ()
build String
dir [BuildMode]
modes Bool
False [String]
opts

-- | Remove ghc library packages under specified source package directory
removeGhcLibrary :: BuildMode -> Hackage -> Trace ()
removeGhcLibrary :: BuildMode -> Hackage -> Trace ()
removeGhcLibrary BuildMode
mode Hackage
hkg = do
  let pkgs :: BuildMode -> Hackage -> [String]
pkgs BuildMode
All   =  Hackage -> [String]
ghcLibraryPackages
      pkgs BuildMode
Bin   =  Hackage -> [String]
ghcLibraryPackages
      pkgs BuildMode
Src   =  [String] -> Hackage -> [String]
forall a b. a -> b -> a
const []
      pkgs BuildMode
Dep   =  Hackage -> [String]
ghcLibraryBinPackages
      pkgs BuildMode
Indep =  (String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[]) (String -> [String]) -> (Hackage -> String) -> Hackage -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hackage -> String
ghcLibraryDocPackage
      pkgs' :: [String]
pkgs' = BuildMode -> Hackage -> [String]
pkgs BuildMode
mode Hackage
hkg
  Bool -> Trace () -> Trace ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
pkgs') (Trace () -> Trace ())
-> (String -> Trace ()) -> String -> Trace ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Trace ()
system'
    (String -> Trace ()) -> String -> Trace ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"echo '' |", String
"sudo apt-get remove", [String] -> String
unwords [String]
pkgs', String
"|| true"]