module Application.CLI
(
defaultMain
, CLI(..)
, OptHelp(..)
, Usage
, printUsage
, Help(..)
, printHelp
, CLIContext
, getHeader
, getDefault
, initialize
, with
) where
import Application.CLI.Class
import Application.CLI.Types
import System.Environment
import System.Exit
data Usage = Usage
instance CLI Usage where
name _ = ""
desc _ = ""
options _ = []
action _ ctx opts = do
progName <- getProgName
usage (printUsage " " progName ctx) opts
usage :: String
-> [String]
-> IO ()
usage list msgs = do
mapM_ (\str -> putStrLn str) msgs
putStrLn list
exitFailure
data Help = Help
instance CLI Help where
name _ = "help"
desc _ = "show help message"
options _ = []
action _ ctx _ = do
progName <- getProgName
putStrLn $ printHelp " " progName ctx
with :: CLI cli
=> cli
-> CLIContext
-> CLIContext
with c l = insertCommand (cliToCommand c) l
initialize :: CLI cliDefault
=> Maybe cliDefault
-> String
-> CLIContext
initialize defaultCli description =
case defaultCli of
Nothing -> cmdMap
Just cmd -> insertDefault (cliToCommand cmd) cmdMap
where
cmdMap :: CLIContext
cmdMap = createContext (cliToCommand Usage) description
defaultMain :: CLIContext
-> IO ()
defaultMain cmdMap = do
args <- getArgs
case args of
[] -> tryDefault
(x:xs) -> tryCommand x xs
where
raiseHelper :: String
-> IO ()
raiseHelper what =
cmdAction (getHelper cmdMap) cmdMap [what]
tryDefault :: IO ()
tryDefault = do
progName <- getProgName
case getDefault cmdMap of
Nothing -> raiseHelper $ progName ++ " does not provide default command"
Just cmd -> cmdAction cmd cmdMap []
tryCommand :: String
-> [String]
-> IO ()
tryCommand cmdstr opts =
case lookupCommand cmdstr cmdMap of
Nothing -> raiseHelper $ cmdstr ++ ": command does not exist"
Just cmd -> cmdAction cmd cmdMap opts