summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Command.hs25
-rw-r--r--src/Main.hs12
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
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 ]
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
35runCli :: (MonadIO m, MonadException m) => SequenceT m () 35runCli :: (MonadIO m, MonadException m) => SequenceT m ()
36runCli = do 36runCli = 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