describe subcommands

This commit is contained in:
Luite Stegeman 2012-04-05 21:30:03 +02:00
parent 0fcb55960c
commit 7e2fce52b5

View File

@ -11,6 +11,9 @@ import Types
import Build (touch)
import Devel (devel)
import System.IO (stdout, stderr, hPutStr, hPutStrLn)
import System.Exit (exitSuccess, exitFailure)
import Control.Monad.IO.Class (MonadIO, liftIO)
defineOptions "NoOptions" (return ())
@ -31,7 +34,7 @@ cabalCommand mopt
| optCabalDev mopt = "cabal-dev"
| otherwise = "cabal"
main = runSubcommand
main = runSubcommand'
[ subcommand "init" cmdInit
, subcommand "configure" cmdConfigure
#ifndef WINDOWS
@ -64,5 +67,33 @@ cmdDevel mopt opts args = devel (optCabalDev mopt) args
cmdVersion :: MainOptions -> VersionOptions -> [String] -> IO ()
cmdVersion _ _ _ = putStrLn $ "yesod-core version: " ++ yesodVersion
-- temporary hack to describe subcommands, remove once options supports subcommand descriptions
runSubcommand' :: (Options opts, MonadIO m) => [Subcommand opts (m a)] -> m a
runSubcommand' subcommands = do
argv <- liftIO System.Environment.getArgs
let parsed = parseSubcommand subcommands argv
case parsedSubcommand parsed of
Just cmd -> cmd
Nothing -> liftIO $ case parsedError parsed of
Just err -> do
hPutStrLn stderr (parsedHelp parsed)
hPutStrLn stderr describeSubcommands
hPutStrLn stderr err
exitFailure
Nothing -> do
hPutStr stdout (parsedHelp parsed)
hPutStr stdout describeSubcommands
exitSuccess
describeSubcommands :: String
describeSubcommands = unlines
[ "Available subcommands, use `yesod --help subcommand' to get more information"
, " init Scaffold a new site"
, " configure Configure a project for building"
#ifndef WINDOWS
, " build Build project (performs TH dependency analysis)"
, " touch Touch any files with altered TH dependencies but do not build"
#endif
, " devel Run project with the devel server"
, " version Print the version of Yesod"
]