-- | This is the main module of console-program. You can use it to build a
-- console program, that parses the command line (and a configuration file),
-- divides it into modes/commands, options and non-options, and executes the
-- corresponding action from a tree of commands.
-- 
-- The main function is 'execute'; provided with a tree of commands and a
-- default configuration, it can be used as the @main@ function.
-- 
-- A \"mode\" or \"command\" provides a mode of operation of your program.
-- This allows a single executable 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.)
-- 
-- Options can be given in a configuration file, and on the command line.
-- Commands specify which options apply to them (the 'applicableOptions' field).
-- Such option descriptions can be created by 'System.Console.Argument.option'.
-- 
-- Options can have arguments, as in @program --option=value@, where @value@ is
-- the argument to @option@. These arguments have types, dictated by the
-- particular option. These types are represented by a 'System.Console.Argument.Type'.
-- 
-- 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
  , Command (Command,name,applicableNonOptions,applicableOptions,description,action)

  -- * Using a command tree to construct a program
  , execute
  , showUsage
  
  -- * Configuration file
  -- $configfile
  ) where


import qualified System.Console.Action.Internal as Action
import qualified System.Console.Options         as Options

import           Control.Applicative     ((<$>))
import           Control.Arrow           ((&&&),second)
import           Control.Exception       (tryJust)
import           Control.Monad           (guard,join)
import qualified Data.Set                     as Set
import qualified Data.Tree                    as Tree
import           Data.Foldable           (foldMap)
import           Data.Traversable        (traverse)
import qualified Fez.Data.Conf                as Conf
import qualified System.Console.GetOpt        as GetOpt
import           System.Directory        (getHomeDirectory)
import           System.Environment.UTF8 (getArgs)
import           System.Exit             (exitFailure)
import           System.IO               (readFile)
import           System.IO.Error         (isDoesNotExistError)
import qualified Text.PrettyPrint.ANSI.Leijen as PP


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

-- | A @Command s@ is an action, together with some descriptive information.
-- The description, and lists of applicable options and non-options are
-- used only to show usage information for the command.
-- @s@ is the type of settings that the action may use.
data Command c
  = Command
    {
      name :: String
      -- ^ This determines which command is executed, depending on the command line.
    , applicableNonOptions :: [String]
      -- ^ For usage info.
    , applicableOptions :: [GetOpt.OptDescr (Either String (Options.Setting c))]
      -- ^ For usage info; also, the union of this field, over all commands in
      -- the command tree, determines which options will be recognised when
      -- parsing the configuration file and command line.
    , description :: String
      -- ^ For usage info.
    , action :: Action.Action c
    }

-- $configfile
-- The configuration file is assumed to be in the user's home directory, and
-- to be named \".foobar\", where \"foobar\" is the name of the command at the
-- root of the command tree (usually the name of the program).
-- 
-- Settings in this file are of the form
-- @
--   option-name=option-value
-- @
-- , see module "Fez.Data.Conf" for details. The format of the \"option-value\"
-- part depends on the type of the option argument; see "System.Console.Argument".

fromDisk :: String -> IO [String]
fromDisk configFile = do
  home <- getHomeDirectory
  result <- tryJust (guard . isDoesNotExistError) (readFile $ home ++ "/" ++ configFile)
  return $ either (const []) Conf.parseToArgs result

-- Load configuration file and parse the command line into settings
-- and non-options.
load :: Commands c -> IO ([String],[Options.Setting c])
load commands = do
  let options = Set.toList $ collectOptions commands
  fileArgs <- fromDisk $ '.' : name (Tree.rootLabel commands)
  (opts,nonOpts,errors) <- GetOpt.getOpt GetOpt.Permute options . (++) fileArgs <$> getArgs
  if null errors
    then either ((>> exitFailure) . putStrLn) (return . (,) nonOpts) $ sequence opts
    else traverse putStrLn errors >> showUsage commands >> exitFailure

-- | Load the configuration file (if present), and run the action given on the command line.
-- You may use this function, with appropriate arguments, as your @main@ function.
-- 
-- Settings in the configuration file override the default configuration;
-- settings on the command line override both.
execute :: (Options.Configuration c) =>
     c          -- ^ Default configuration.
  -> Commands c -- ^ Tree of commands.
  -> IO ()
execute defaults commands = uncurry (select commands) . second (flip Options.apply defaults) =<< load commands

-- Select the right command from the command tree, given a list of non-options, and the options.
select :: (Options.Configuration c) => Commands c -> [String] -> c -> IO ()
select (Tree.Node root _     ) []           = Action.run (action root) []
select (Tree.Node root forest) nos@(x : xs) = case lookup x $ map (name . Tree.rootLabel &&& id) forest of
  Nothing -> Action.run (action root) nos
  Just cs -> select cs xs

-- | Print usage info for the program to stdout.
showUsage :: Commands c -> IO ()
showUsage = PP.putDoc . usage
 where
  usage (Tree.Node c ns) = subcs ns . (PP.<> PP.line) . opts c . descr c . nonOpts c $ PP.bold (PP.text $ name c)
  descr c = flip (PP.<$>) $ PP.string (description c)
  nonOpts c = if null (applicableNonOptions c)
    then id
    else flip (PP.<+>) $ PP.cat . PP.punctuate PP.space . map PP.text $ applicableNonOptions c
  opts c = if null (applicableOptions c)
    then id
    else flip (PP.<$>) . PP.indent 2 . PP.vsep . map opt $ applicableOptions c
  opt (GetOpt.Option short long a descr) = list 5 "-" arg (map (: []) short)
    PP.<+> list 20 "--" arg long PP.<+> PP.string descr where
    arg = case a of
      GetOpt.NoArg _    -> PP.empty
      GetOpt.ReqArg _ x -> PP.equals PP.<> PP.string x
      GetOpt.OptArg _ x -> PP.brackets (PP.equals PP.<> PP.string x)
  list i p a = PP.fill i . PP.cat . PP.punctuate PP.comma . map (\ x -> PP.text p PP.<> PP.text x PP.<> a)
  subcs ns = if null ns then id else flip (PP.<$>) $ PP.indent 2 (PP.vsep $ map usage ns)

collectOptions :: Commands c -> Set.Set (GetOpt.OptDescr (Either String (Options.Setting c)))
collectOptions = foldMap (Set.fromList . applicableOptions)

instance Eq (GetOpt.OptDescr a) where
  (GetOpt.Option _ x _ _) == (GetOpt.Option _ y _ _) = head x == head y
instance Ord (GetOpt.OptDescr a) where
  (GetOpt.Option _ x _ _) `compare` (GetOpt.Option _ y _ _) = compare (head x) (head y)