{-# LANGUAGE FlexibleContexts #-}

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

import Data.Char (isSpace)

import Types

data Cmd = PerformAlt Alteration
         | Quit
         | Step
         | 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' (cmd:args) = return $ UnknownCommand (show $ cmd:args) -- DEBUG