diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/Command.hs | 25 | ||||
-rw-r--r-- | src/Main.hs | 12 |
2 files changed, 25 insertions, 12 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 | ] | ||
diff --git a/src/Main.hs b/src/Main.hs index e6a3024..0088b7c 100644 --- a/src/Main.hs +++ b/src/Main.hs | |||
@@ -35,18 +35,16 @@ main = do | |||
35 | runCli :: (MonadIO m, MonadException m) => SequenceT m () | 35 | runCli :: (MonadIO m, MonadException m) => SequenceT m () |
36 | runCli = do | 36 | runCli = do |
37 | input <- lift $ getInputLine "→ " | 37 | input <- lift $ getInputLine "→ " |
38 | cmnd <- maybe (return $ ParseError "Trying to parse EOF") parseCmd input | ||
39 | case input of | 38 | case input of |
40 | Nothing -> liftIO exitSuccess | 39 | Nothing -> liftIO exitSuccess |
41 | Just _ -> do | 40 | Just input' -> do |
42 | case cmnd of | 41 | case parseCmd input' of |
43 | UnknownCommand cmd -> do | 42 | UnknownCommand help -> do |
44 | lift . outputStrLn $ "Unknown command: »" <> cmd <> "«" | 43 | lift . outputStrLn $ help |
45 | ParseError err -> do | 44 | ParseError err -> do |
46 | lift . outputStrLn $ "Error parsing input »" <> (fromMaybe "" input) <> "«: " <> err | 45 | lift . outputStrLn $ "Error parsing input »" <> (fromMaybe "" input) <> "«: " <> err |
47 | Empty -> return () | 46 | Empty -> return () |
48 | 47 | ||
49 | Quit -> liftIO exitSuccess | 48 | Quit -> liftIO exitSuccess |
50 | PerformAlt alt -> apply' alt | 49 | _ -> undefined |
51 | Step -> undefined | ||
52 | runCli | 50 | runCli |