module Distribution.Package.Debian.Setup (
Flags(..)
, DebAction(..)
, DebType(..)
, parseArgs
) where
import Control.Monad (when)
import Data.Char (toLower)
import Distribution.Compiler (CompilerFlavor(..))
import Distribution.ReadE (readEOrFail)
import Distribution.PackageDescription (FlagName(..))
import Distribution.Verbosity (Verbosity, flagToVerbosity, normal)
import System.Console.GetOpt (ArgDescr (..), ArgOrder (..), OptDescr (..),
usageInfo, getOpt')
import System.Environment (getProgName)
import System.Exit (exitWith, ExitCode (..))
import System.IO (Handle, hPutStrLn, stderr, stdout)
data Flags = Flags
{
rpmPrefix :: FilePath
, rpmCompiler :: CompilerFlavor
, rpmConfigurationsFlags :: [(FlagName, Bool)]
, rpmHaddock :: Bool
, rpmHelp :: Bool
, debLibProf :: Bool
, rpmName :: Maybe String
, rpmOptimisation :: Bool
, rpmRelease :: Maybe String
, rpmSplitObjs :: Bool
, debOutputDir :: FilePath
, rpmVerbosity :: Verbosity
, rpmVersion :: Maybe String
, debMaintainer :: Maybe String
, debAction :: DebAction
}
deriving (Eq, Show)
data DebType = Dev| Prof | Doc deriving (Eq, Read, Show)
data DebAction = Usage | Debianize | SubstVar DebType | UpdateDebianization deriving (Eq, Show)
emptyFlags :: Flags
emptyFlags = Flags
{
rpmPrefix = "/usr/lib/haskell-packages/ghc6"
, rpmCompiler = GHC
, rpmConfigurationsFlags = []
, rpmHaddock = True
, rpmHelp = False
, debLibProf = True
, rpmName = Nothing
, rpmOptimisation = True
, rpmRelease = Nothing
, rpmSplitObjs = True
, debOutputDir = "./debian"
, rpmVerbosity = normal
, rpmVersion = Nothing
, debMaintainer = Nothing
, debAction = Usage
}
options :: [OptDescr (Flags -> Flags)]
options =
[
Option "" ["prefix"] (ReqArg (\ path x -> x { rpmPrefix = path }) "PATH")
"Pass this prefix if we need to configure the package",
Option "" ["ghc"] (NoArg (\x -> x { rpmCompiler = GHC }))
"Compile with GHC",
Option "" ["hugs"] (NoArg (\x -> x { rpmCompiler = Hugs }))
"Compile with Hugs",
Option "" ["jhc"] (NoArg (\x -> x { rpmCompiler = JHC }))
"Compile with JHC",
Option "" ["nhc"] (NoArg (\x -> x { rpmCompiler = NHC }))
"Compile with NHC",
Option "h?" ["help"] (NoArg (\x -> x { rpmHelp = True }))
"Show this help text",
Option "" ["name"] (ReqArg (\name x -> x { rpmName = Just name }) "NAME")
"Override the default package name",
Option "" ["disable-haddock"] (NoArg (\x -> x { rpmHaddock = False }))
"Don't generate API docs",
Option "" ["disable-library-profiling"] (NoArg (\x -> x { debLibProf = False }))
"Don't generate profiling libraries",
Option "" ["disable-optimization"] (NoArg (\x -> x { rpmOptimisation = False }))
"Don't generate optimised code",
Option "" ["disable-split-objs"] (NoArg (\x -> x { rpmSplitObjs = False }))
"Don't split object files to save space",
Option "f" ["flags"] (ReqArg (\flags x -> x { rpmConfigurationsFlags = rpmConfigurationsFlags x ++ flagList flags }) "FLAGS")
"Set given flags in Cabal conditionals",
Option "" ["release"] (ReqArg (\rel x -> x { rpmRelease = Just rel }) "RELEASE")
"Override the default package release",
Option "" ["debdir"] (ReqArg (\path x -> x { debOutputDir = path }) "DEBDIR")
("Override the default output directory (" ++ show (debOutputDir emptyFlags) ++ ")"),
Option "v" ["verbose"] (ReqArg (\verb x -> x { rpmVerbosity = readEOrFail flagToVerbosity verb }) "n")
"Change build verbosity",
Option "" ["version"] (ReqArg (\vers x -> x { rpmVersion = Just vers }) "VERSION")
"Override the default package version",
Option "" ["maintainer"] (ReqArg (\maint x -> x { debMaintainer = Just maint }) "Maintainer Name <email addr>")
"Override the Maintainer name and email in $DEBEMAIL/$EMAIL/$DEBFULLNAME/$FULLNAME",
Option "" ["debianize"] (NoArg (\x -> x {debAction = Debianize}))
"Generate a new debianization, replacing any existing one. One of --debianize, --substvar, or --update-debianization is required.",
Option "" ["substvar"] (ReqArg (\ name x -> x {debAction = SubstVar (read name)}) "Doc, Prof, or Dev")
(unlines ["Write out the list of dependencies required for the dev, prof or doc package depending",
"on the argument. This value can be added to the appropriate substvars file."]),
Option "" ["update-debianization"] (NoArg (\x -> x {debAction = UpdateDebianization}))
"Update an existing debianization, or generate a new one."
]
flagList :: String -> [(FlagName, Bool)]
flagList = map tagWithValue . words
where tagWithValue ('-':name) = (FlagName (map toLower name), False)
tagWithValue name = (FlagName (map toLower name), True)
printHelp :: Handle -> IO ()
printHelp h = do
progName <- getProgName
let info = "Usage: " ++ progName ++ " [FLAGS]\n"
hPutStrLn h (usageInfo info options)
parseArgs :: [String] -> IO Flags
parseArgs args = do
let (os, args', unknown, errs) = getOpt' RequireOrder options args
opts = foldl (flip ($)) emptyFlags os
when (rpmHelp opts || debAction opts == Usage) $ do
printHelp stdout
exitWith ExitSuccess
when (not (null errs)) $ do
hPutStrLn stderr "Errors:"
mapM_ (hPutStrLn stderr) errs
exitWith (ExitFailure 1)
when (not (null unknown)) $ do
hPutStrLn stderr "Unrecognised options:"
mapM_ (hPutStrLn stderr) unknown
exitWith (ExitFailure 1)
when (not (null args')) $ do
hPutStrLn stderr "Unrecognised arguments:"
mapM_ (hPutStrLn stderr) args'
exitWith (ExitFailure 1)
return opts