-- | This module contains functions 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 available commands.
-- 
-- These commands can be constructed using the module "System.Console.Command".
module System.Console.Program
  (
  -- * Using a command tree to construct a program
    single
  , interactive
  , showUsage
  
  -- * Configuration file
  -- $configfile
  ) where


import           System.Console.Command    (Commands,Command)
import           System.Console.ConfigFile (readFromFile)
import           System.Console.Internal   (run,options,nonOptions,action,description,name)

import           Control.Applicative       ((<|>),(*>))
import           Control.Arrow             ((&&&),second)
import           Control.Monad             (when)
import           Control.Monad.Trans.Class (lift)
import qualified Data.Map                     as Map
import           Data.Traversable          (traverse)
import qualified Data.Tree                    as Tree
import qualified System.Console.ANSI          as ANSI
import qualified System.Console.GetOpt        as GetOpt
import qualified System.Console.Haskeline     as Haskeline
import           System.Environment        (getArgs)
import           System.Exit               (exitFailure,exitSuccess)
import           System.IO                 (readFile)
import qualified Text.Parsec                  as P
import qualified Text.PrettyPrint.ANSI.Leijen as PP


-- $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
-- root of the command tree (usually the name of the program).
-- 
-- Settings in this file are of the form
-- @
--   option-name=option-value
-- @
-- , see the documentation of the package fez-conf for details. The format of
-- the \"option-value\" part depends on the type of the option argument; see
-- "System.Console.Argument".
-- 
-- Sections can be defined for settings applying to a single command,
-- using the name of a command, enclosed in square brackets, as section header:
-- @
--   [command1]
--   option-for-command1=true
-- @.


-- Parse the given list of strings into a command, non-options and options.
parse :: Commands -> [String] -> IO ()
parse commands args = do
  let (commandString,command,restArgs) = select commands args
  fileArgs <- readFromFile commands commandString
  let (opts,nonOpts,errors) = GetOpt.getOpt GetOpt.Permute (options $ action command) (fileArgs ++ restArgs)
  let optsMap = Map.fromList opts
  when (not $ null errors) $
    traverse putStrLn errors >> exitFailure
  run (action command) nonOpts optsMap

-- Select the right command from the command tree, and return the rest of the command line.
select :: Commands -> [String] -> ([String],Command,[String])
select (Tree.Node root _     ) []       = ([],root,[])
select (Tree.Node root subs)   (x : xs) = case lookup x $ map (name . Tree.rootLabel &&& id) subs of
  Nothing -> ([],root,x : xs)
  Just cs -> let (xs',c,rest) = select cs xs in (x : xs',c,rest)

-- | 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.
single :: Commands -> IO ()
single commands = parse commands =<< getArgs

-- | Start an interactive session. Arguments to the program are ignored;
-- instead, the user may repeatedly enter a command, possibly with options,
-- which will be executed.
interactive :: Commands -> IO ()
interactive commands = do
  Haskeline.runInputT Haskeline.defaultSettings $ sequence_ . repeat $ one
 where
  one = do
    lift $ ANSI.setSGR [ANSI.SetConsoleIntensity ANSI.BoldIntensity]
    lift $ putStr $ name (Tree.rootLabel commands)
    lift $ ANSI.setSGR [ANSI.Reset]
    line <- maybe (lift exitSuccess) return =<< Haskeline.getInputLine ": "
    case words' line of
      Left e   -> lift $ putStrLn e
      Right ws -> lift $ parse commands ws

words' :: String -> Either String [String]
words' = either (Left . show) Right . P.parse p "" where
  p = P.optional space *> P.sepEndBy (quoted <|> unquoted) space
  unquoted = P.many1 $ P.noneOf [' ']
  space = P.many1 $ P.char ' '
  quoted = P.between quote quote . P.many $
    P.try (escaped quote) <|> escaped escape <|> P.noneOf ['"','\\']
  quote = P.char '"'
  escape = P.char '\\'
  escaped x = escape *> x

-- | Print usage info for the program to stdout.
showUsage :: Commands -> IO ()
showUsage = PP.putDoc . usage
 where
  usage (Tree.Node c ns) = (PP.<> PP.line) . 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 = let n = nonOptions $ action c in if null n
    then id
    else flip (PP.<+>) $ PP.cat . PP.punctuate PP.space . map PP.text $ n
  opts c = let o = options $ action c in if null o
    then id
    else flip (PP.<$>) . PP.indent 2 . PP.vsep . map opt $ o
  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)