{-# LANGUAGE FlexibleContexts #-}

module Command
       ( Cmd(..)
       , parseCmd
       ) where

import Options.Applicative

import Data.Char (isSpace)

import Types

data Cmd = PerformAlt Alteration
         | ModifyTip SequenceValue
         | OverrideTip SequenceValue
         | ShowTip
         | ShowHistory (Maybe Integer)
         | Dump
         | Quit
         | UnknownCommand String
         | ParseError String
         | Empty

quoteChars, escapeChars :: [Char]
quoteChars = ['"', '\'']
escapeChars = ['\\']

isQuote, isEscape :: Char -> Bool
isQuote q = q `elem` quoteChars
isEscape e = e `elem` escapeChars

parseCmd :: String -> Cmd
parseCmd = parseCmd' . split
  where
    split :: String -> [String]
    split = reverse . split' [] "" Nothing Nothing
    split' :: [String] -> String -> Maybe Char -> Maybe Char -> String -> [String]
    split' ws w q e "" = trimStart $ (prepend q . append e $ reverse w):ws
      where
        prepend (Just c) = (c : )
        prepend _ = id
        append (Just c) = (++ [c])
        append _ = id
        trimStart ("":ws) = ws
        trimStart ws = ws
    split' ws w q e (c:cs)
      | null w
      , Nothing <- q
      , Nothing <- e
      , isQuote c           = split' ws w (Just c) Nothing cs -- Start quoted word at unescaped quote
      | Nothing <- e
      , (Just q') <- q
      , c == q'             = split' (reverse w : ws) "" Nothing Nothing cs -- Close quoted word at unescaped quote of same type
      | null w
      , isSpace c
      , Nothing <- e
      , Nothing <- q        = split' ws w Nothing Nothing cs -- Ignore leading unescaped spaces if not within quotes
      | isSpace c
      , Nothing <- e
      , Nothing <- q        = split' (reverse w : ws) "" Nothing Nothing cs -- Close unquoted word at unescaped space
      | Nothing <- e
      , isEscape c          = split' ws w q (Just c) cs -- Set escaped flag at unescaped escape char
      | otherwise           = split' ws (c : w) q Nothing cs -- Append to word

parseCmd' :: [String] -> Cmd
parseCmd' [] = Empty
parseCmd' args = mapResult runParser
  where
    runParser = execParserPure (prefs $ showHelpOnError) (cmdParser `info` progDesc "sequence - A tracker for combat sequences in Contact (a pen&paper rpg by Uhrwerk)") args
    mapResult (Success a) = a
    mapResult (Failure help) = UnknownCommand . fst $ renderFailure help ""
    mapResult (CompletionInvoked _ ) = ParseError "Completion triggered" 

cmdParser :: Parser Cmd
cmdParser = hsubparser $ mconcat [ command "quit" $ pure Quit `info` progDesc "Exit gracefully"
                                 ]