Command.hs

-- |
-- A \"mode\" or \"command\" provides a mode of operation of your program.
-- This allows a single program to provide many different pieces of
-- functionality. The first argument to the program (or the first few, if it
-- has subcommands) determines which command should be executed.
-- (@darcs@ and @cabal@ are examples of programs that make heavy use of modes.)
-- 
-- An 'Action' represents an IO action, together with information about
-- applicable option and non-option arguments.
-- 
-- A command can have also non-option arguments (plain arguments). These also
-- have types. Create such commands using the function 'System.Console.Action.withArgument'.
module System.Console.Command
  (
    Commands,Tree.Tree(Tree.Node)
  , Command
  
  , Action
  , io
  , withNonOption
  , withOption
  ) where


import           System.Console.Internal
  (
    Command(Command)
  , Action(Action,run,options,nonOptions)
  , 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)


-- | @Commands s@ is a tree of commands. It represents the whole set of
-- possible commands of a program.
type Commands
  = Tree.Tree Command


-- | A simple action, taking no argument, and having no options.
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

-- | Create an action that takes an argument (non-option).
-- 
-- The type of argument is specified by the first parameter; such values can
-- be obtained from the module "System.Console.Argument".
withNonOption :: Argument.Type x -> (x -> Action) -> Action
withNonOption at f = Action
  {
    run = \ nonOpts opts -> case nonOpts of
      (x : xs) -> either
        ((>> exitFailure) . putStrLn) -- Show errors and exit.
        (\ y -> run (f y) xs opts)    -- Argument parsing succeeded; run the action.
        (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)
  }

-- | Create an action that takes an option.
-- 
-- The first parameter is a description of the option; such a value can be
-- constructed using 'System.Console.Argument.option'.
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)
  }