module Debian.Debianize.BasicInfo
(
Flags(..)
, EnvSet(..)
, DebAction(..)
, DebType(..)
, verbosity
, dryRun
, validate
, debAction
, compilerFlavor
, cabalFlagAssignments
, buildEnv
, flagOptions
, newFlags
) where
import Control.Applicative ((<$>))
import Control.Category ((.))
import Control.Monad.State (StateT, execStateT)
import Control.Monad.Trans (MonadIO)
import Data.Char (toLower, toUpper)
import Data.Default (Default(def))
import Data.Generics (Data, Typeable)
import Control.Lens.TH (makeLenses)
import Data.Monoid (Monoid(..))
import Data.Set as Set (fromList, Set, union)
import Debian.Debianize.Prelude ((%=), read', (~=))
import Debian.Orphans ()
import Distribution.Compiler (CompilerFlavor(..))
import Distribution.PackageDescription as Cabal (FlagName(FlagName))
import Prelude hiding ((.), break, lines, log, null, readFile, sum)
import System.Console.GetOpt (ArgDescr(ReqArg, NoArg), ArgOrder(Permute), getOpt, OptDescr(Option))
import System.Environment (getArgs)
import System.FilePath ((</>))
import Text.Read (readMaybe)
data Flags = Flags
{
_verbosity :: Int
, _dryRun :: Bool
, _validate :: Bool
, _debAction :: DebAction
, _compilerFlavor :: CompilerFlavor
, _cabalFlagAssignments :: Set (FlagName, Bool)
, _buildEnv :: EnvSet
} deriving (Eq, Ord, Show, Data, Typeable)
data EnvSet = EnvSet
{ cleanOS :: FilePath
, dependOS :: FilePath
, buildOS :: FilePath
} deriving (Eq, Ord, Show, Data, Typeable)
data DebAction = Usage | Debianize | SubstVar DebType deriving (Read, Show, Eq, Ord, Data, Typeable)
data DebType = Dev | Prof | Doc deriving (Eq, Ord, Read, Show, Data, Typeable)
instance Default Flags where
def = Flags
{ _verbosity = 1
, _debAction = Debianize
, _dryRun = False
, _validate = False
, _compilerFlavor = GHC
, _cabalFlagAssignments = mempty
, _buildEnv = EnvSet {cleanOS = "/", dependOS = "/", buildOS = "/"}
}
$(makeLenses ''Flags)
flagOptions :: MonadIO m => [OptDescr (StateT Flags m ())]
flagOptions =
[ Option "v" ["verbose"] (ReqArg (\ s -> verbosity ~= (read' (\ s' -> error $ "verbose: " ++ show s') s :: Int)) "number")
"Change the amount of progress messages generated",
Option "n" ["dry-run", "compare"] (NoArg (dryRun ~= True))
"Just compare the existing debianization to the one we would generate.",
Option "h?" ["help"] (NoArg (debAction ~= Usage))
"Show this help text",
Option "" ["ghc"] (NoArg (compilerFlavor ~= GHC)) "Generate packages for GHC - same as --with-compiler GHC",
#if MIN_VERSION_Cabal(1,22,0)
Option "" ["ghcjs"] (NoArg (compilerFlavor ~= GHCJS)) "Generate packages for GHCJS - same as --with-compiler GHCJS",
#endif
Option "" ["hugs"] (NoArg (compilerFlavor ~= Hugs)) "Generate packages for Hugs - same as --with-compiler GHC",
Option "" ["with-compiler"] (ReqArg (\ s -> maybe (error $ "Invalid compiler id: " ++ show s)
(\ hc -> compilerFlavor ~= hc)
(readMaybe (map toUpper s) :: Maybe CompilerFlavor)) "COMPILER")
(unlines [ "Generate packages for this CompilerFlavor" ]),
Option "f" ["flags"] (ReqArg (\ fs -> cabalFlagAssignments %= (Set.union (Set.fromList (flagList fs)))) "FLAGS")
(unlines [ "Flags to pass to the finalizePackageDescription function in"
, "Distribution.PackageDescription.Configuration when loading the cabal file."]),
Option "" ["debianize"] (NoArg (debAction ~= Debianize))
"Deprecated - formerly used to get what is now the normal benavior.",
Option "" ["substvar"] (ReqArg (\ name -> debAction ~= (SubstVar (read' (\ s -> error $ "substvar: " ++ show s) name))) "Doc, Prof, or Dev")
(unlines [ "With this option no debianization is generated. Instead, the list"
, "of dependencies required for the dev, prof or doc package (depending"
, "on the argument) is printed to standard output. These can be added"
, "to the appropriate substvars file. (This is an option whose use case"
, "is lost in the mists of time.)"]),
Option "" ["buildenvdir"] (ReqArg (\ s -> buildEnv ~= EnvSet {cleanOS = s </> "clean", dependOS = s </> "depend", buildOS = s </> "build"}) "PATH")
"Directory containing the three build environments, clean, depend, and build.",
Option "f" ["cabal-flags"] (ReqArg (\ s -> cabalFlagAssignments %= (Set.union (fromList (flagList s)))) "FLAG FLAG ...")
"Flags to pass to cabal configure with the --flags= option "
]
flagList :: String -> [(FlagName, Bool)]
flagList = map tagWithValue . words
where tagWithValue ('-':name) = (FlagName (map toLower name), False)
tagWithValue name = (FlagName (map toLower name), True)
newFlags :: IO Flags
newFlags = do
(fns, _, _) <- getOpt Permute flagOptions <$> getArgs
execStateT (sequence fns) def