{-# LANGUAGE FlexibleContexts #-}

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

import Data.Set (Set)
import qualified Data.Set as Set

import Options.Applicative

import Data.Char (isSpace)

import Types

data Cmd = PerformAlt Alteration (Maybe Comment)
         | 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 :: SequenceM m => String -> m 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' :: SequenceM m => [String] -> m Cmd
parseCmd' [] = return Empty
parseCmd' args = do
  knownEntities <- entities
  tip <- snd <$> gets getMax
  return $ mapResult runParser
  where
    runParser = execParserPure (prefs $ showHelpOnError) (cmdParser knownEntities tip `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" 

-- data Cmd = PerformAlt Alteration (Maybe Comment)
--          | ShowTip
--          | ShowHistory (Maybe Integer)
--          | Dump
--          | Quit
-- data Alteration = Modify Entity SequenceValue
--                 | Override Entity SequenceValue
--                 | Drop Entity
--                 | Insert Entity SequenceValue
--                 | Rename Entity Entity

cmdParser :: Set Entity -> Entity -> Parser Cmd
cmdParser knownEntities tip = hsubparser $ mconcat [ command "quit" $ pure Quit `info` progDesc "Exit gracefully"
                                                   , command "dump" $ pure Dump `info` progDesc "Print all internal state in a format not necessarily human readable"
                                                   , command "history" $ parseHistory `info` progDesc "Print an excerpt of combat history"
                                                   , command "who" $ pure ShowTip `info` progDesc "Who’s turn is it?"
                                                   , command "set" $ parseOverride `info` progDesc "Set an entities sequence value"
                                                   , command "modify" $ parseModify `info` progDesc "Modify an entities sequence value"
                                                   , command "drop" $ parseDrop `info` progDesc "Stop tracking an entity"
                                                   , command "add" $ parseAdd `info` progDesc "Start tracking an entity"
                                                   , command "rename" $ parseRename `info` progDesc "Rename an entity"
                                                   ]
  where
    parseHistory = ShowHistory <$> optional (argument natural (help "How many entries to display" <> metavar "NATURAL"))
    parseOverride = PerformAlt <$> (Override <$> entity <*> sequenceValue) <*> comment

    natural = do
      int <- auto
      if int < 0
        then readerError "Natural number (0 ≤ n) required"
        else return int
    entity = Entity <$>