debian-build-0.6.0.0: mains/odebuild.hs

import System.Environment (getProgName, getArgs)
import System.FilePath ((</>))
import Control.Monad (void, when)
import Data.List (stripPrefix)

import Debian.Package.Data (Source, Hackage, isBinaryPackage)
import Debian.Package.Build
  (BuildMode (Dep, Indep, Src), buildPackage, debi', pwd,
   defaultConfig, Build, runBuild, liftTrace, dpkgParseControl, modeListFromControl,
   removeBuildDir, findDebianChanges, genSources, removeGhcLibrary)


defualtModes :: [BuildMode]
defualtModes =  [Dep, Indep, Src]

remove' :: Hackage -> Build ()
remove' hkg = liftTrace $ sequence_ [removeGhcLibrary m hkg | m <- defualtModes]

install' :: Build ()
install' =  do
  ps <- findDebianChanges
  let cs = [c | (c, t) <- ps, isBinaryPackage t ]
  liftTrace $ do
    when (null cs) $ fail "No .changes files found!"
    mapM_ (\c -> debi' [c]) cs


help :: IO ()
help =  do
  prog <- getProgName
  let rev  = "[--revision=<debian revision>]"
      opts = "[debuild options]"
  putStr . unlines $ map unwords
    [[prog, "clean"],
     [prog, "source", rev],
     [prog, "build", rev, opts],
     [prog, "install", rev, opts],
     [prog, "reinstall", rev, opts],
     ["-- reinstall (Remove and install) support only for Haskell"],
     ["-- Revision string may use on auto-generating debian directory."]]

clean :: Build ()
clean =  removeBuildDir

source :: Maybe String -> Build ((FilePath, FilePath), Source, Maybe Hackage)
source mayRev = do
  clean
  maybe (fail "Illegal state: genSources") return =<< genSources mayRev

build :: Maybe String -> [String] -> Build (Source, Maybe Hackage)
build mayRev opts = do
  ((_, dir), src, mayH) <- source mayRev
  ctrl <- liftTrace . dpkgParseControl $ dir </> "debian" </> "control"
  liftTrace $ sequence_ [buildPackage dir m opts | m <- modeListFromControl ctrl]
  return (src, mayH)

install :: Maybe String -> [String] -> Build ()
install mayRev args = do
  void $ build mayRev args
  install'

reinstall :: Maybe String -> [String] -> Build ()
reinstall mayRev args = do
  (_src, mayH) <- build mayRev args
  maybe (return ()) remove' mayH
  install'

run :: Build a -> IO a
run b = do
  cur <- pwd
  uncurry (runBuild b cur) defaultConfig

parseArgs :: [String] -> (Maybe String, [String])
parseArgs =  d where
  d aas@(a:as) = case stripPrefix "--revision=" a of
    r@(Just _)  ->  (r, as)
    Nothing     ->  (Nothing, aas)
  d []         =    (Nothing, [])

main :: IO ()
main =  do
  as0 <- getArgs
  case as0 of
    "-h"     : _          ->  help
    "--help" : _          ->  help
    "help"   : _          ->  help
    as2@(c : as1)  ->  do
      let (mayRev, args) = parseArgs as1
      run $ case c of
        "clean"         ->    clean
        "source"        ->    void $ source mayRev
        "build"         ->    void $ build mayRev args
        "install"       ->    install mayRev args
        "reinstall"     ->    reinstall mayRev args
        _               ->    void . uncurry build $ parseArgs as2

    []                  -> run . void $ build Nothing []