diff options
Diffstat (limited to 'src/Command.hs')
-rw-r--r-- | src/Command.hs | 25 |
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 | ||
8 | import Options.Applicative | ||
9 | |||
8 | import Data.Char (isSpace) | 10 | import Data.Char (isSpace) |
9 | 11 | ||
10 | import Types | 12 | import Types |
11 | 13 | ||
12 | data Cmd = PerformAlt Alteration | 14 | data 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 | |||
24 | isQuote q = q `elem` quoteChars | 30 | isQuote q = q `elem` quoteChars |
25 | isEscape e = e `elem` escapeChars | 31 | isEscape e = e `elem` escapeChars |
26 | 32 | ||
27 | parseCmd :: SequenceM m => String -> m Cmd | 33 | parseCmd :: String -> Cmd |
28 | parseCmd = parseCmd' . split | 34 | parseCmd = 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 | ||
60 | parseCmd' :: SequenceM m => [String] -> m Cmd | 66 | parseCmd' :: [String] -> Cmd |
61 | parseCmd' [] = return Empty | 67 | parseCmd' [] = Empty |
62 | parseCmd' (cmd:args) = return $ UnknownCommand (show $ cmd:args) -- DEBUG | 68 | parseCmd' 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 | |||
75 | cmdParser :: Parser Cmd | ||
76 | cmdParser = hsubparser $ mconcat [ command "quit" $ pure Quit `info` progDesc "Exit gracefully" | ||
77 | ] | ||