-- |
-- Module      : Application.CLI.Types
-- License     : BSD-Style
-- Copyright   : Copyright © 2014 Nicolas DI PRIMA
--
-- Maintainer  : Nicolas DI PRIMA <nicolas@di-prima.fr>
-- Stability   : experimental
-- Portability : unknown
--
module Application.CLI.Types
    ( -- * Types
      CLIContext
    , Command(..)
    , OptHelp(..)
    
      -- * Commands
      -- ** Getter/Setter
    , createContext
    , getHeader
    , getHelper
    , insertDefault
    , getDefault
    , insertCommand
      -- ** Lookup
    , lookupCommand

      -- * pretty printer
    , printUsage
    , printHelp
    , printOptHelp
    ) where

import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as M

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

data CLIContext = CLIContext
    { getCommands :: Map String Command
    , getDefault  :: Maybe Command
    , getHeader   :: String
    , getHelper   :: Command
    } deriving (Show, Eq)

-- | Create a CLIContext
createContext :: Command -- ^ the helper command
              -> String  -- ^ a description about the program
              -> CLIContext
createContext helper header =
    CLIContext
        { getCommands = M.empty
        , getDefault  = Nothing
        , getHelper   = helper
        , getHeader   = header
        }

insertCommand :: Command -> CLIContext -> CLIContext
insertCommand cmd cmdMap = cmdMap { getCommands = M.insert (cmdName cmd) cmd (getCommands cmdMap) }

insertDefault :: Command -> CLIContext -> CLIContext
insertDefault cmd cmdMap =
    insertCommand cmd $cmdMap { getDefault  = Just cmd }

lookupCommand :: String -> CLIContext -> Maybe Command
lookupCommand k cmdMap = M.lookup k (getCommands cmdMap)

-------------------------------------------------------------------------------
--                                  Command                                  --
-------------------------------------------------------------------------------

data Command =
      Command
        { cmdName :: String
        , cmdDesc :: String
        , cmdOptions :: [OptHelp]
        , cmdAction  :: CLIContext -> [String] -> IO ()
        }

instance Eq Command where
    (==) a b = eqname && eqdesc && eqopts
      where
        eqname = cmdName a == cmdName b
        eqdesc = cmdDesc a == cmdDesc b
        eqopts = cmdOptions a == cmdOptions b

instance Show Command where
    show c =
        "Command { " ++ "name: " ++ (cmdName c) ++ ", "
                     ++ "desc: " ++ (cmdDesc c) ++ ", "
                     ++ "opts: " ++ (show $ cmdOptions c) ++ " }"

printCommandHelp :: String  -- ^ indentation
                 -> Command
                 -> String
printCommandHelp prefix cmd =
    prefix ++ cmdName cmd ++ ": " ++ cmdDesc cmd ++ "\n"
    ++ (foldr (\c acc -> "\n" ++ prefix ++ prefix ++ (printOptHelp c) ++ acc) "" (cmdOptions cmd))

-------------------------------------------------------------------------------
--                         Option helps                                      --
-------------------------------------------------------------------------------

data OptHelp = OptHelp
    { optSymbols     :: [String]
    , optArgument    :: Maybe String
    , optDescription :: String
    } deriving (Eq, Show)

printOptHelp :: OptHelp -> String
printOptHelp opthelp =
    (printSymbols $ optSymbols opthelp)
    ++ (printArgument $ optArgument opthelp)
    ++ (optDescription opthelp)
  where
    printSymbols :: [String] -> String
    printSymbols []     = ""
    printSymbols [x]    = x ++ " "
    printSymbols (x:xs) = x ++ printSymbols xs

    printArgument :: Maybe String -> String
    printArgument Nothing  = ""
    printArgument (Just a) = "<" ++ a ++ ">"

-------------------------------------------------------------------------------
--                          Pretty printers                                  --
-------------------------------------------------------------------------------

printHelp :: String   -- ^ indentation
          -> String   -- ^ program name
          -> CLIContext -- ^ command list
          -> String
printHelp prefix name cmdMap =
    (defaultUsage prefix name $ getDefault cmdMap)
    ++ "\n"
    ++ (listCommands prefix cmdMap)

listCommands :: String
             -> CLIContext
             -> String
listCommands prefix cmdMap =
    "Available commands:\n"
    ++ (foldr (\c acc -> "\n" ++ (printCommandHelp listPrefix c) ++ acc) "" (M.elems $ getCommands cmdMap))
  where
    listPrefix :: String
    listPrefix = prefix

-- | Pretty printer: list the available commands
printUsage :: String   -- ^ indentation
           -> String   -- ^ program name
           -> CLIContext -- ^ the command to print
           -> String
printUsage prefix name cmdMap =
    (defaultUsage prefix name $ getDefault cmdMap)
    ++ "\n"
    ++ (listDescriptions prefix cmdMap)

defaultUsage :: String -- ^ prefix
             -> String -- ^ program name
             -> Maybe Command
             -> String
defaultUsage _      _    Nothing    = ""
defaultUsage prefix name (Just cmd) =
    prefix ++ "Usage: " ++ name ++ " [" ++ (cmdName cmd) ++ "]\n"

listDescriptions :: String   -- ^ prefix
                 -> CLIContext
                 -> String
listDescriptions prefix cmdMap =
    "Available commands:\n"
    ++ (foldr (\c acc -> "\n" ++ (commandDescription listPrefix c) ++ acc) "" (M.elems $ getCommands cmdMap))
  where
    listPrefix :: String
    listPrefix = prefix

commandDescription :: String
                   -> Command
                   -> String
commandDescription prefix cmd =
    prefix ++ cmdName cmd ++ ": " ++ cmdDesc cmd ++ "\n"