-- |
-- Module      : Application.CLI
-- License     : BSD-Style
-- Copyright   : Copyright © 2014 Nicolas DI PRIMA
--
-- Maintainer  : Nicolas DI PRIMA <nicolas@di-prima.fr>
-- Stability   : experimental
-- Portability : unknown
--
-- This module aimes to provide an easy and low-dependencies Command Line
-- configuration options.
--
-- You can create a new command for your program by creating an object
-- And creating an instance of CLI of this object
--
-- @
--   data MyEchoCommand = MyEchoCommand
--   instance CLI MyCommand where
--      name _ = "cmd"
--      desc _ = "just echo the given arguments"
--      options _ = [ ]
--      action _ _ opts = mapM_ putStrLn opts
-- @
--
-- And to create you application, you need 2 functions (initialize, with and defaultMain).
-- * @initialize@: only create the default CLIContext with a default Help command
--   and a default Usage function
-- * @with@: insert the Command into the CLIContext
-- * @defaultMain@: will trigger the right command
--
-- @
--   main :: IO ()
--   main = defaultMain $ with MyEchoCommand $ initialize "a message header in case the help command is triggered"
-- @
--

module Application.CLI
    ( -- * Default Main
      defaultMain

      -- * CLI
    , CLI(..)
    , OptHelp(..)
      -- ** Default CLIs
    , Help(..)
    , printHelp

      -- * Commands
    , CLIContext
    , getHeader
    , initialize
    , initializeWithDefault
    , with

      -- * Options
    , Options
    , withStr
    , withOptionalStr
    , withParameterStr
    , withOptionalParameterStr
    , withFlag
    ) where

import Application.CLI.Class
import Application.CLI.Types
import Data.List
import System.Environment
import System.Exit

-- | Default usage Command Interface
data Usage = Usage
instance CLI Usage where
    name    _ = ""
    desc    _ = ""
    options _ = []
    action  _ ctx opts = do
        progName <- getProgName
        usage (printUsage "    " progName ctx) opts

usage :: String
      -> [String]
      -> IO ()
usage list msgs = do
    mapM_ (\str -> putStrLn str) msgs
    putStrLn list
    exitFailure

-- | This is the default help command
--
-- It is triggered by the command "help" and also provides
-- an option to print a specific command options
data Help = Help
instance CLI Help where
    name    _  = "help"
    desc    _  = "show help message"
    options _  = [ OptHelp [] (Just "command") "print the help message for a specific command"
                 ]
    action  _ ctx =
        withOptionalStr $ \mcommand _ -> do
            case mcommand of
                Nothing -> printStdHelp
                Just c  -> printCmdHelp c
      where
        printCmdHelp :: String -> IO ()
        printCmdHelp cmd = do
            case lookupCommand cmd ctx of
                Nothing -> error $ "command '" ++ cmd ++ "' does not exist"
                Just c  -> putStrLn $ printCommandHelp "   " c

        printStdHelp :: IO ()
        printStdHelp = do
            progName <- getProgName
            putStrLn $ progName ++ ": " ++ getHeader ctx
            putStrLn $ printHelp "    " progName ctx

-------------------------------------------------------------------------------
--                               Commands                                    --
-------------------------------------------------------------------------------

-- | Add a new Command into a collection of commands
with :: CLI cli
     => cli      -- ^ A new Command Interface
     -> CLIContext -- ^ The original Collection of commands
     -> CLIContext
with c l = insertCommand (cliToCommand c) l

-- | Initialize a collection of commands
initializeWithDefault :: CLI cliDefault
                      => cliDefault -- ^ The command to execute if no option is given
                      -> String     -- ^ CLI Description
                      -> CLIContext
initializeWithDefault defaultCli description =
    insertDefault (cliToCommand defaultCli) cmdMap
  where
    cmdMap = initialize description

-- | Initialize a collection of command
initialize :: String     -- ^ CLI Description
           -> CLIContext
initialize description =
    createContext (cliToCommand Usage) description

-------------------------------------------------------------------------------
--                             Options                                       --
-------------------------------------------------------------------------------

-- | This function is to expect an argument at the Head of the @Options@
-- if the command is not found at the head, the program fails and the description
-- message is printed
withStr :: String  -- ^ a description of what is expected
        -> (String -> Options -> IO a)
        -> Options
        -> IO a
withStr what _ []     = error $ "expecting <" ++ what ++ ">"
withStr _    f (x:xs) = f x xs

-- | This function is to expect an optional argument
-- of the command is not found at the Head of the @Options@
-- the function will be executed with Nothing, otherwise it will be executed
-- with (Just @String@)
withOptionalStr :: (Maybe String -> Options -> IO a)
                -> Options
                -> IO a
withOptionalStr f []     = f Nothing  []
withOptionalStr f (x:xs) = f (Just x) xs

-- | Look for a parameterized option
-- The given list of flags are the potential list of flags that can be use to
-- find the position of the options
--
-- This parameter can be found anywhere in the Options list and the argument
-- of the function will be the string following one of this Flags
-- The parameter and its value are removed from the options before being use
-- into the function.
withParameterStr :: [String] -- ^ the reference flag
                 -> (String -> Options -> IO a)
                 -> Options
                 -> IO a
withParameterStr flags f l =
    case break (flip elem flags) l of
        (_  , [])      -> error $ "expecting parameter " ++ intercalate ", " flags ++ " <value>"
        (_  , _:[])    -> error $ "parameter " ++ intercalate ", " flags ++ " is expection an argument"
        (xs1, _:p:xs2) -> f p (xs1 ++ xs2)

-- | idem as @withParameterStr@ but it is an optional parameter
withOptionalParameterStr :: [String] -- ^ the reference flag
                         -> (Maybe String -> Options -> IO a)
                         -> Options
                         -> IO a
withOptionalParameterStr flags f l =
    case break (flip elem flags) l of
        (xs1, [])      -> f Nothing xs1
        (_  , _:[])    -> error $ "parameter " ++ intercalate ", " flags ++ " is expecting an argument"
        (xs1, _:p:xs2) -> f (Just p) (xs1 ++ xs2)

-- | This function is to expect Flag in the Options
-- it will look into all the options and will remove the string
-- from the Options
withFlag :: [String]                   -- ^ the flag to lookup
         -> (Bool -> Options -> IO a)  -- ^ the function to execute
         -> Options                    -- ^ the options
         -> IO a
withFlag flags f l =
    case break (flip elem flags) l of
        (xs1, [])    -> f False xs1
        (xs1, _:xs2) -> f True  (xs1 ++ xs2)

-------------------------------------------------------------------------------
--                             Default Main                                  --
-------------------------------------------------------------------------------

-- | The default Main
-- It will analyze the program's parameters and will trigger the
-- right command.
defaultMain :: CLIContext -- ^ A collection of commands
            -> IO ()
defaultMain cmdMap = do
    args <- getArgs
    case args of
        []     -> tryDefault
        (x:xs) -> tryCommand x xs
  where
    raiseHelper :: String
                -> IO ()
    raiseHelper what =
        cmdAction (getHelper cmdMap) cmdMap [what]
    tryDefault :: IO ()
    tryDefault = do
        progName <- getProgName
        case getDefault cmdMap of
            Nothing  -> raiseHelper $ progName ++ " does not provide default command"
            Just cmd -> cmdAction cmd cmdMap []
    tryCommand :: String
               -> [String]
               -> IO ()
    tryCommand cmdstr opts =
        case lookupCommand cmdstr cmdMap of
            Nothing  -> raiseHelper $ cmdstr ++ ": command does not exist"
            Just cmd -> cmdAction cmd cmdMap opts