Command.hs

-- |
-- A '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 with this behaviour.)
-- 
-- An 'Action' represents an IO action, together with information about
-- applicable options and non-option arguments.
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)


-- | @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)
  , ignoringOptions = ignoringOptions (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)
  , ignoringOptions = ignoringOptions (f undefined)
  }

-- | Create an action that allows, but ignores, the given option.
-- 
-- This is especially useful if this option is given in the configuration
-- file, but is meant for other commands; then this action will not give an
-- error message about an unrecognised option.
ignoreOption :: Option a -> Action -> Action
ignoreOption (Option _ g _ _) a = a
  {
    ignoringOptions = g : ignoringOptions a
  }