{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
module Distribution.Make
( module Distribution.Package
, License (..)
, Version
, defaultMain
, defaultMainArgs
) where
import Distribution.Compat.Prelude
import Prelude ()
import Distribution.License
import Distribution.Package
import Distribution.Pretty
import Distribution.Simple.Command
import Distribution.Simple.Program
import Distribution.Simple.Setup
import Distribution.Simple.Utils
import Distribution.Version
import System.Environment (getArgs, getProgName)
defaultMain :: IO ()
defaultMain :: IO ()
defaultMain = IO [String]
getArgs IO [String] -> ([String] -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [String] -> IO ()
defaultMainArgs
defaultMainArgs :: [String] -> IO ()
defaultMainArgs :: [String] -> IO ()
defaultMainArgs = [String] -> IO ()
defaultMainHelper
defaultMainHelper :: [String] -> IO ()
defaultMainHelper :: [String] -> IO ()
defaultMainHelper [String]
args = do
CommandParse (GlobalFlags, CommandParse (IO ()))
command <- CommandUI GlobalFlags
-> [Command (IO ())]
-> [String]
-> IO (CommandParse (GlobalFlags, CommandParse (IO ())))
forall a action.
CommandUI a
-> [Command action]
-> [String]
-> IO (CommandParse (a, CommandParse action))
commandsRun ([Command (IO ())] -> CommandUI GlobalFlags
forall action. [Command action] -> CommandUI GlobalFlags
globalCommand [Command (IO ())]
commands) [Command (IO ())]
commands [String]
args
case CommandParse (GlobalFlags, CommandParse (IO ()))
command of
CommandHelp String -> String
help -> (String -> String) -> IO ()
printHelp String -> String
help
CommandList [String]
opts -> [String] -> IO ()
printOptionsList [String]
opts
CommandErrors [String]
errs -> [String] -> IO ()
forall {b}. [String] -> IO b
printErrors [String]
errs
CommandReadyToGo (GlobalFlags
flags, CommandParse (IO ())
commandParse) ->
case CommandParse (IO ())
commandParse of
CommandParse (IO ())
_
| Flag Bool -> Bool
forall a. WithCallStack (Flag a -> a)
fromFlag (GlobalFlags -> Flag Bool
globalVersion GlobalFlags
flags) -> IO ()
printVersion
| Flag Bool -> Bool
forall a. WithCallStack (Flag a -> a)
fromFlag (GlobalFlags -> Flag Bool
globalNumericVersion GlobalFlags
flags) -> IO ()
printNumericVersion
CommandHelp String -> String
help -> (String -> String) -> IO ()
printHelp String -> String
help
CommandList [String]
opts -> [String] -> IO ()
printOptionsList [String]
opts
CommandErrors [String]
errs -> [String] -> IO ()
forall {b}. [String] -> IO b
printErrors [String]
errs
CommandReadyToGo IO ()
action -> IO ()
action
where
printHelp :: (String -> String) -> IO ()
printHelp String -> String
help = IO String
getProgName IO String -> (String -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO ()
putStr (String -> IO ()) -> (String -> String) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
help
printOptionsList :: [String] -> IO ()
printOptionsList = String -> IO ()
putStr (String -> IO ()) -> ([String] -> String) -> [String] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines
printErrors :: [String] -> IO b
printErrors [String]
errs = do
String -> IO ()
putStr (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" [String]
errs)
ExitCode -> IO b
forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure Int
1)
printNumericVersion :: IO ()
printNumericVersion = String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Version -> String
forall a. Pretty a => a -> String
prettyShow Version
cabalVersion
printVersion :: IO ()
printVersion =
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
String
"Cabal library version "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ Version -> String
forall a. Pretty a => a -> String
prettyShow Version
cabalVersion
progs :: ProgramDb
progs = ProgramDb
defaultProgramDb
commands :: [Command (IO ())]
commands =
[ ProgramDb -> CommandUI ConfigFlags
configureCommand ProgramDb
progs CommandUI ConfigFlags
-> (ConfigFlags -> [String] -> IO ()) -> Command (IO ())
forall flags action.
CommandUI flags -> (flags -> [String] -> action) -> Command action
`commandAddAction` ConfigFlags -> [String] -> IO ()
configureAction
, ProgramDb -> CommandUI BuildFlags
buildCommand ProgramDb
progs CommandUI BuildFlags
-> (BuildFlags -> [String] -> IO ()) -> Command (IO ())
forall flags action.
CommandUI flags -> (flags -> [String] -> action) -> Command action
`commandAddAction` BuildFlags -> [String] -> IO ()
buildAction
, CommandUI InstallFlags
installCommand CommandUI InstallFlags
-> (InstallFlags -> [String] -> IO ()) -> Command (IO ())
forall flags action.
CommandUI flags -> (flags -> [String] -> action) -> Command action
`commandAddAction` InstallFlags -> [String] -> IO ()
installAction
, CommandUI CopyFlags
copyCommand CommandUI CopyFlags
-> (CopyFlags -> [String] -> IO ()) -> Command (IO ())
forall flags action.
CommandUI flags -> (flags -> [String] -> action) -> Command action
`commandAddAction` CopyFlags -> [String] -> IO ()
copyAction
, CommandUI HaddockFlags
haddockCommand CommandUI HaddockFlags
-> (HaddockFlags -> [String] -> IO ()) -> Command (IO ())
forall flags action.
CommandUI flags -> (flags -> [String] -> action) -> Command action
`commandAddAction` HaddockFlags -> [String] -> IO ()
haddockAction
, CommandUI CleanFlags
cleanCommand CommandUI CleanFlags
-> (CleanFlags -> [String] -> IO ()) -> Command (IO ())
forall flags action.
CommandUI flags -> (flags -> [String] -> action) -> Command action
`commandAddAction` CleanFlags -> [String] -> IO ()
cleanAction
, CommandUI SDistFlags
sdistCommand CommandUI SDistFlags
-> (SDistFlags -> [String] -> IO ()) -> Command (IO ())
forall flags action.
CommandUI flags -> (flags -> [String] -> action) -> Command action
`commandAddAction` SDistFlags -> [String] -> IO ()
sdistAction
, CommandUI RegisterFlags
registerCommand CommandUI RegisterFlags
-> (RegisterFlags -> [String] -> IO ()) -> Command (IO ())
forall flags action.
CommandUI flags -> (flags -> [String] -> action) -> Command action
`commandAddAction` RegisterFlags -> [String] -> IO ()
registerAction
, CommandUI RegisterFlags
unregisterCommand CommandUI RegisterFlags
-> (RegisterFlags -> [String] -> IO ()) -> Command (IO ())
forall flags action.
CommandUI flags -> (flags -> [String] -> action) -> Command action
`commandAddAction` RegisterFlags -> [String] -> IO ()
unregisterAction
]
configureAction :: ConfigFlags -> [String] -> IO ()
configureAction :: ConfigFlags -> [String] -> IO ()
configureAction ConfigFlags
flags [String]
args = do
[String] -> IO ()
noExtraFlags [String]
args
let verbosity :: Verbosity
verbosity = Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ ConfigFlags -> Flag Verbosity
configVerbosity ConfigFlags
flags
mbWorkDir :: Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir = Flag (SymbolicPath CWD ('Dir Pkg))
-> Maybe (SymbolicPath CWD ('Dir Pkg))
forall a. Flag a -> Maybe a
flagToMaybe (Flag (SymbolicPath CWD ('Dir Pkg))
-> Maybe (SymbolicPath CWD ('Dir Pkg)))
-> Flag (SymbolicPath CWD ('Dir Pkg))
-> Maybe (SymbolicPath CWD ('Dir Pkg))
forall a b. (a -> b) -> a -> b
$ ConfigFlags -> Flag (SymbolicPath CWD ('Dir Pkg))
configWorkingDir ConfigFlags
flags
Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> String
-> [String]
-> IO ()
rawSystemExit Verbosity
verbosity Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir String
"sh" ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$
String
"configure"
String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Bool -> ConfigFlags -> [String]
configureArgs Bool
backwardsCompatHack ConfigFlags
flags
where
backwardsCompatHack :: Bool
backwardsCompatHack = Bool
True
copyAction :: CopyFlags -> [String] -> IO ()
copyAction :: CopyFlags -> [String] -> IO ()
copyAction CopyFlags
flags [String]
args = do
[String] -> IO ()
noExtraFlags [String]
args
let verbosity :: Verbosity
verbosity = Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ CopyFlags -> Flag Verbosity
copyVerbosity CopyFlags
flags
mbWorkDir :: Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir = Flag (SymbolicPath CWD ('Dir Pkg))
-> Maybe (SymbolicPath CWD ('Dir Pkg))
forall a. Flag a -> Maybe a
flagToMaybe (Flag (SymbolicPath CWD ('Dir Pkg))
-> Maybe (SymbolicPath CWD ('Dir Pkg)))
-> Flag (SymbolicPath CWD ('Dir Pkg))
-> Maybe (SymbolicPath CWD ('Dir Pkg))
forall a b. (a -> b) -> a -> b
$ CopyFlags -> Flag (SymbolicPath CWD ('Dir Pkg))
copyWorkingDir CopyFlags
flags
destArgs :: [String]
destArgs = case Flag CopyDest -> CopyDest
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag CopyDest -> CopyDest) -> Flag CopyDest -> CopyDest
forall a b. (a -> b) -> a -> b
$ CopyFlags -> Flag CopyDest
copyDest CopyFlags
flags of
CopyDest
NoCopyDest -> [String
"install"]
CopyTo String
path -> [String
"copy", String
"destdir=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
path]
CopyToDb String
_ -> String -> [String]
forall a. HasCallStack => String -> a
error String
"CopyToDb not supported via Make"
Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> String
-> [String]
-> IO ()
rawSystemExit Verbosity
verbosity Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir String
"make" [String]
destArgs
installAction :: InstallFlags -> [String] -> IO ()
installAction :: InstallFlags -> [String] -> IO ()
installAction InstallFlags
flags [String]
args = do
[String] -> IO ()
noExtraFlags [String]
args
let verbosity :: Verbosity
verbosity = Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ InstallFlags -> Flag Verbosity
installVerbosity InstallFlags
flags
mbWorkDir :: Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir = Flag (SymbolicPath CWD ('Dir Pkg))
-> Maybe (SymbolicPath CWD ('Dir Pkg))
forall a. Flag a -> Maybe a
flagToMaybe (Flag (SymbolicPath CWD ('Dir Pkg))
-> Maybe (SymbolicPath CWD ('Dir Pkg)))
-> Flag (SymbolicPath CWD ('Dir Pkg))
-> Maybe (SymbolicPath CWD ('Dir Pkg))
forall a b. (a -> b) -> a -> b
$ InstallFlags -> Flag (SymbolicPath CWD ('Dir Pkg))
installWorkingDir InstallFlags
flags
Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> String
-> [String]
-> IO ()
rawSystemExit Verbosity
verbosity Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir String
"make" [String
"install"]
Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> String
-> [String]
-> IO ()
rawSystemExit Verbosity
verbosity Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir String
"make" [String
"register"]
haddockAction :: HaddockFlags -> [String] -> IO ()
haddockAction :: HaddockFlags -> [String] -> IO ()
haddockAction HaddockFlags
flags [String]
args = do
[String] -> IO ()
noExtraFlags [String]
args
let verbosity :: Verbosity
verbosity = Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ HaddockFlags -> Flag Verbosity
haddockVerbosity HaddockFlags
flags
mbWorkDir :: Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir = Flag (SymbolicPath CWD ('Dir Pkg))
-> Maybe (SymbolicPath CWD ('Dir Pkg))
forall a. Flag a -> Maybe a
flagToMaybe (Flag (SymbolicPath CWD ('Dir Pkg))
-> Maybe (SymbolicPath CWD ('Dir Pkg)))
-> Flag (SymbolicPath CWD ('Dir Pkg))
-> Maybe (SymbolicPath CWD ('Dir Pkg))
forall a b. (a -> b) -> a -> b
$ HaddockFlags -> Flag (SymbolicPath CWD ('Dir Pkg))
haddockWorkingDir HaddockFlags
flags
Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> String
-> [String]
-> IO ()
rawSystemExit Verbosity
verbosity Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir String
"make" [String
"docs"]
IO () -> (IOException -> IO ()) -> IO ()
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` \IOException
_ ->
Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> String
-> [String]
-> IO ()
rawSystemExit Verbosity
verbosity Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir String
"make" [String
"doc"]
buildAction :: BuildFlags -> [String] -> IO ()
buildAction :: BuildFlags -> [String] -> IO ()
buildAction BuildFlags
flags [String]
args = do
[String] -> IO ()
noExtraFlags [String]
args
let verbosity :: Verbosity
verbosity = Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ BuildFlags -> Flag Verbosity
buildVerbosity BuildFlags
flags
mbWorkDir :: Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir = Flag (SymbolicPath CWD ('Dir Pkg))
-> Maybe (SymbolicPath CWD ('Dir Pkg))
forall a. Flag a -> Maybe a
flagToMaybe (Flag (SymbolicPath CWD ('Dir Pkg))
-> Maybe (SymbolicPath CWD ('Dir Pkg)))
-> Flag (SymbolicPath CWD ('Dir Pkg))
-> Maybe (SymbolicPath CWD ('Dir Pkg))
forall a b. (a -> b) -> a -> b
$ BuildFlags -> Flag (SymbolicPath CWD ('Dir Pkg))
buildWorkingDir BuildFlags
flags
Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> String
-> [String]
-> IO ()
rawSystemExit Verbosity
verbosity Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir String
"make" []
cleanAction :: CleanFlags -> [String] -> IO ()
cleanAction :: CleanFlags -> [String] -> IO ()
cleanAction CleanFlags
flags [String]
args = do
[String] -> IO ()
noExtraFlags [String]
args
let verbosity :: Verbosity
verbosity = Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ CleanFlags -> Flag Verbosity
cleanVerbosity CleanFlags
flags
mbWorkDir :: Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir = Flag (SymbolicPath CWD ('Dir Pkg))
-> Maybe (SymbolicPath CWD ('Dir Pkg))
forall a. Flag a -> Maybe a
flagToMaybe (Flag (SymbolicPath CWD ('Dir Pkg))
-> Maybe (SymbolicPath CWD ('Dir Pkg)))
-> Flag (SymbolicPath CWD ('Dir Pkg))
-> Maybe (SymbolicPath CWD ('Dir Pkg))
forall a b. (a -> b) -> a -> b
$ CleanFlags -> Flag (SymbolicPath CWD ('Dir Pkg))
cleanWorkingDir CleanFlags
flags
Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> String
-> [String]
-> IO ()
rawSystemExit Verbosity
verbosity Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir String
"make" [String
"clean"]
sdistAction :: SDistFlags -> [String] -> IO ()
sdistAction :: SDistFlags -> [String] -> IO ()
sdistAction SDistFlags
flags [String]
args = do
[String] -> IO ()
noExtraFlags [String]
args
let verbosity :: Verbosity
verbosity = Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ SDistFlags -> Flag Verbosity
sDistVerbosity SDistFlags
flags
mbWorkDir :: Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir = Flag (SymbolicPath CWD ('Dir Pkg))
-> Maybe (SymbolicPath CWD ('Dir Pkg))
forall a. Flag a -> Maybe a
flagToMaybe (Flag (SymbolicPath CWD ('Dir Pkg))
-> Maybe (SymbolicPath CWD ('Dir Pkg)))
-> Flag (SymbolicPath CWD ('Dir Pkg))
-> Maybe (SymbolicPath CWD ('Dir Pkg))
forall a b. (a -> b) -> a -> b
$ SDistFlags -> Flag (SymbolicPath CWD ('Dir Pkg))
sDistWorkingDir SDistFlags
flags
Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> String
-> [String]
-> IO ()
rawSystemExit Verbosity
verbosity Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir String
"make" [String
"dist"]
registerAction :: RegisterFlags -> [String] -> IO ()
registerAction :: RegisterFlags -> [String] -> IO ()
registerAction RegisterFlags
flags [String]
args = do
[String] -> IO ()
noExtraFlags [String]
args
let verbosity :: Verbosity
verbosity = Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ RegisterFlags -> Flag Verbosity
registerVerbosity RegisterFlags
flags
mbWorkDir :: Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir = Flag (SymbolicPath CWD ('Dir Pkg))
-> Maybe (SymbolicPath CWD ('Dir Pkg))
forall a. Flag a -> Maybe a
flagToMaybe (Flag (SymbolicPath CWD ('Dir Pkg))
-> Maybe (SymbolicPath CWD ('Dir Pkg)))
-> Flag (SymbolicPath CWD ('Dir Pkg))
-> Maybe (SymbolicPath CWD ('Dir Pkg))
forall a b. (a -> b) -> a -> b
$ RegisterFlags -> Flag (SymbolicPath CWD ('Dir Pkg))
registerWorkingDir RegisterFlags
flags
Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> String
-> [String]
-> IO ()
rawSystemExit Verbosity
verbosity Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir String
"make" [String
"register"]
unregisterAction :: RegisterFlags -> [String] -> IO ()
unregisterAction :: RegisterFlags -> [String] -> IO ()
unregisterAction RegisterFlags
flags [String]
args = do
[String] -> IO ()
noExtraFlags [String]
args
let verbosity :: Verbosity
verbosity = Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ RegisterFlags -> Flag Verbosity
registerVerbosity RegisterFlags
flags
mbWorkDir :: Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir = Flag (SymbolicPath CWD ('Dir Pkg))
-> Maybe (SymbolicPath CWD ('Dir Pkg))
forall a. Flag a -> Maybe a
flagToMaybe (Flag (SymbolicPath CWD ('Dir Pkg))
-> Maybe (SymbolicPath CWD ('Dir Pkg)))
-> Flag (SymbolicPath CWD ('Dir Pkg))
-> Maybe (SymbolicPath CWD ('Dir Pkg))
forall a b. (a -> b) -> a -> b
$ RegisterFlags -> Flag (SymbolicPath CWD ('Dir Pkg))
registerWorkingDir RegisterFlags
flags
Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> String
-> [String]
-> IO ()
rawSystemExit Verbosity
verbosity Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir String
"make" [String
"unregister"]