summaryrefslogtreecommitdiff
path: root/src/Command.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Command.hs')
-rw-r--r--src/Command.hs25
1 files changed, 20 insertions, 5 deletions
diff --git a/src/Command.hs b/src/Command.hs
index 55f4466..4d85489 100644
--- a/src/Command.hs
+++ b/src/Command.hs
@@ -5,13 +5,19 @@ module Command
5 , parseCmd 5 , parseCmd
6 ) where 6 ) where
7 7
8import Options.Applicative
9
8import Data.Char (isSpace) 10import Data.Char (isSpace)
9 11
10import Types 12import Types
11 13
12data Cmd = PerformAlt Alteration 14data Cmd = PerformAlt Alteration
15 | ModifyTip SequenceValue
16 | OverrideTip SequenceValue
17 | ShowTip
18 | ShowHistory (Maybe Integer)
19 | Dump
13 | Quit 20 | Quit
14 | Step
15 | UnknownCommand String 21 | UnknownCommand String
16 | ParseError String 22 | ParseError String
17 | Empty 23 | Empty
@@ -24,7 +30,7 @@ isQuote, isEscape :: Char -> Bool
24isQuote q = q `elem` quoteChars 30isQuote q = q `elem` quoteChars
25isEscape e = e `elem` escapeChars 31isEscape e = e `elem` escapeChars
26 32
27parseCmd :: SequenceM m => String -> m Cmd 33parseCmd :: String -> Cmd
28parseCmd = parseCmd' . split 34parseCmd = parseCmd' . split
29 where 35 where
30 split :: String -> [String] 36 split :: String -> [String]
@@ -57,6 +63,15 @@ parseCmd = parseCmd' . split
57 , isEscape c = split' ws w q (Just c) cs -- Set escaped flag at unescaped escape char 63 , isEscape c = split' ws w q (Just c) cs -- Set escaped flag at unescaped escape char
58 | otherwise = split' ws (c : w) q Nothing cs -- Append to word 64 | otherwise = split' ws (c : w) q Nothing cs -- Append to word
59 65
60parseCmd' :: SequenceM m => [String] -> m Cmd 66parseCmd' :: [String] -> Cmd
61parseCmd' [] = return Empty 67parseCmd' [] = Empty
62parseCmd' (cmd:args) = return $ UnknownCommand (show $ cmd:args) -- DEBUG 68parseCmd' args = mapResult runParser
69 where
70 runParser = execParserPure (prefs $ showHelpOnError) (cmdParser `info` progDesc "sequence - A tracker for combat sequences in Contact (a pen&paper rpg by Uhrwerk)") args
71 mapResult (Success a) = a
72 mapResult (Failure help) = UnknownCommand . fst $ renderFailure help ""
73 mapResult (CompletionInvoked _ ) = ParseError "Completion triggered"
74
75cmdParser :: Parser Cmd
76cmdParser = hsubparser $ mconcat [ command "quit" $ pure Quit `info` progDesc "Exit gracefully"
77 ]