module System.Console.Command
(
Commands,Tree.Tree(Tree.Node)
, Command(Command,name,description,action)
, Action
, io
, withNonOption
, withOption
, ignoreOption
) where
import System.Console.Internal
(
Command(Command,name,description,action)
, Action(Action,run,options,nonOptions,ignoringOptions)
, Option(Option)
, Identifier
)
import qualified System.Console.Argument as Argument
import qualified Data.Map as Map
import qualified Data.Tree as Tree
import System.Exit (exitFailure)
type Commands
= Tree.Tree Command
io :: IO () -> Action
io h = Action r [] [] [] where
r [] _ = h
r rest _ = putStrLn e >> exitFailure where
e = "Error: unused non-option or unrecognised command: " ++ unwords rest
withNonOption :: Argument.Type x -> (x -> Action) -> Action
withNonOption at f = Action
{
run = \ nonOpts opts -> case nonOpts of
(x : xs) -> either
((>> exitFailure) . putStrLn)
(\ y -> run (f y) xs opts)
(Argument.parser at x)
[] -> maybe
(putStrLn ("Error: missing argument of type " ++ Argument.name at) >> exitFailure)
(\ y -> run (f y) [] opts)
(Argument.defaultValue at)
, nonOptions = Argument.name at : nonOptions (f undefined)
, options = options (f undefined)
, ignoringOptions = ignoringOptions (f undefined)
}
withOption :: Option a -> (a -> Action) -> Action
withOption (Option identifier optDescr def p) f = Action
{
run = \ nonOpts opts -> case maybe (Right def) p $ Map.lookup identifier opts of
Left e -> putStrLn e >> exitFailure
Right a -> run (f a) nonOpts opts
, nonOptions = nonOptions (f undefined)
, options = optDescr : options (f undefined)
, ignoringOptions = ignoringOptions (f undefined)
}
ignoreOption :: Option a -> Action -> Action
ignoreOption (Option _ g _ _) a = a
{
ignoringOptions = g : ignoringOptions a
}