{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
module Distribution.Make (
module Distribution.Package,
License(..), Version,
defaultMain, defaultMainArgs, defaultMainNoRead
) where
import Prelude ()
import Distribution.Compat.Prelude
import Distribution.Compat.Exception
import Distribution.Package
import Distribution.Simple.Program
import Distribution.PackageDescription
import Distribution.Simple.Setup
import Distribution.Simple.Command
import Distribution.Simple.Utils
import Distribution.License
import Distribution.Version
import Distribution.Pretty
import System.Environment (getArgs, getProgName)
import System.Exit
defaultMain :: IO ()
defaultMain :: IO ()
defaultMain = IO [String]
getArgs IO [String] -> ([String] -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [String] -> IO ()
[String] -> IO ()
defaultMainArgs
defaultMainArgs :: [String] -> IO ()
defaultMainArgs :: [String] -> IO ()
defaultMainArgs = [String] -> IO ()
[String] -> IO ()
defaultMainHelper
{-# DEPRECATED defaultMainNoRead "it ignores its PackageDescription arg" #-}
defaultMainNoRead :: PackageDescription -> IO ()
defaultMainNoRead :: PackageDescription -> IO ()
defaultMainNoRead = IO () -> PackageDescription -> IO ()
forall a b. a -> b -> a
const IO ()
IO ()
defaultMain
defaultMainHelper :: [String] -> IO ()
defaultMainHelper :: [String] -> IO ()
defaultMainHelper args :: [String]
args =
case CommandUI GlobalFlags
-> [Command (IO ())]
-> [String]
-> CommandParse (GlobalFlags, CommandParse (IO ()))
forall a action.
CommandUI a
-> [Command action]
-> [String]
-> CommandParse (a, CommandParse action)
commandsRun ([Command (IO ())] -> CommandUI GlobalFlags
forall action. [Command action] -> CommandUI GlobalFlags
globalCommand [Command (IO ())]
commands) [Command (IO ())]
commands [String]
args of
CommandHelp help :: String -> String
help -> (String -> String) -> IO ()
printHelp String -> String
help
CommandList opts :: [String]
opts -> [String] -> IO ()
printOptionsList [String]
opts
CommandErrors errs :: [String]
errs -> [String] -> IO ()
forall b. [String] -> IO b
printErrors [String]
errs
CommandReadyToGo (flags :: GlobalFlags
flags, commandParse :: CommandParse (IO ())
commandParse) ->
case CommandParse (IO ())
commandParse of
_ | 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 help :: String -> String
help -> (String -> String) -> IO ()
printHelp String -> String
help
CommandList opts :: [String]
opts -> [String] -> IO ()
printOptionsList [String]
opts
CommandErrors errs :: [String]
errs -> [String] -> IO ()
forall b. [String] -> IO b
printErrors [String]
errs
CommandReadyToGo action :: IO ()
action -> IO ()
action
where
printHelp :: (String -> String) -> IO ()
printHelp help :: String -> String
help = IO String
getProgName IO String -> (String -> IO ()) -> IO ()
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 errs :: [String]
errs = do
String -> IO ()
putStr (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "\n" [String]
errs)
ExitCode -> IO b
forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure 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
$ "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 ()
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 ()
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 ()
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 ()
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 ()
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 ()
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 ()
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 ()
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 ()
RegisterFlags -> [String] -> IO ()
unregisterAction
]
configureAction :: ConfigFlags -> [String] -> IO ()
configureAction :: ConfigFlags -> [String] -> IO ()
configureAction flags :: ConfigFlags
flags args :: [String]
args = do
[String] -> IO ()
noExtraFlags [String]
args
let verbosity :: Verbosity
verbosity = Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (ConfigFlags -> Flag Verbosity
configVerbosity ConfigFlags
flags)
Verbosity -> String -> [String] -> IO ()
rawSystemExit Verbosity
verbosity "sh" ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$
"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 flags :: CopyFlags
flags args :: [String]
args = do
[String] -> IO ()
noExtraFlags [String]
args
let 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
NoCopyDest -> ["install"]
CopyTo path :: String
path -> ["copy", "destdir=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
path]
CopyToDb _ -> String -> [String]
forall a. HasCallStack => String -> a
error "CopyToDb not supported via Make"
Verbosity -> String -> [String] -> IO ()
rawSystemExit (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) "make" [String]
destArgs
installAction :: InstallFlags -> [String] -> IO ()
installAction :: InstallFlags -> [String] -> IO ()
installAction flags :: InstallFlags
flags args :: [String]
args = do
[String] -> IO ()
noExtraFlags [String]
args
Verbosity -> String -> [String] -> IO ()
rawSystemExit (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) "make" ["install"]
Verbosity -> String -> [String] -> IO ()
rawSystemExit (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) "make" ["register"]
haddockAction :: HaddockFlags -> [String] -> IO ()
haddockAction :: HaddockFlags -> [String] -> IO ()
haddockAction flags :: HaddockFlags
flags args :: [String]
args = do
[String] -> IO ()
noExtraFlags [String]
args
Verbosity -> String -> [String] -> IO ()
rawSystemExit (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) "make" ["docs"]
IO () -> (IOException -> IO ()) -> IO ()
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` \_ ->
Verbosity -> String -> [String] -> IO ()
rawSystemExit (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) "make" ["doc"]
buildAction :: BuildFlags -> [String] -> IO ()
buildAction :: BuildFlags -> [String] -> IO ()
buildAction flags :: BuildFlags
flags args :: [String]
args = do
[String] -> IO ()
noExtraFlags [String]
args
Verbosity -> String -> [String] -> IO ()
rawSystemExit (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) "make" []
cleanAction :: CleanFlags -> [String] -> IO ()
cleanAction :: CleanFlags -> [String] -> IO ()
cleanAction flags :: CleanFlags
flags args :: [String]
args = do
[String] -> IO ()
noExtraFlags [String]
args
Verbosity -> String -> [String] -> IO ()
rawSystemExit (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) "make" ["clean"]
sdistAction :: SDistFlags -> [String] -> IO ()
sdistAction :: SDistFlags -> [String] -> IO ()
sdistAction flags :: SDistFlags
flags args :: [String]
args = do
[String] -> IO ()
noExtraFlags [String]
args
Verbosity -> String -> [String] -> IO ()
rawSystemExit (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) "make" ["dist"]
registerAction :: RegisterFlags -> [String] -> IO ()
registerAction :: RegisterFlags -> [String] -> IO ()
registerAction flags :: RegisterFlags
flags args :: [String]
args = do
[String] -> IO ()
noExtraFlags [String]
args
Verbosity -> String -> [String] -> IO ()
rawSystemExit (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
regVerbosity RegisterFlags
flags) "make" ["register"]
unregisterAction :: RegisterFlags -> [String] -> IO ()
unregisterAction :: RegisterFlags -> [String] -> IO ()
unregisterAction flags :: RegisterFlags
flags args :: [String]
args = do
[String] -> IO ()
noExtraFlags [String]
args
Verbosity -> String -> [String] -> IO ()
rawSystemExit (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
regVerbosity RegisterFlags
flags) "make" ["unregister"]