summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Command.hs55
-rw-r--r--src/Utils.hs10
2 files changed, 54 insertions, 11 deletions
diff --git a/src/Command.hs b/src/Command.hs
index 4d85489..79893a5 100644
--- a/src/Command.hs
+++ b/src/Command.hs
@@ -5,15 +5,16 @@ module Command
5 , parseCmd 5 , parseCmd
6 ) where 6 ) where
7 7
8import Data.Set (Set)
9import qualified Data.Set as Set
10
8import Options.Applicative 11import Options.Applicative
9 12
10import Data.Char (isSpace) 13import Data.Char (isSpace)
11 14
12import Types 15import Types
13 16
14data Cmd = PerformAlt Alteration 17data Cmd = PerformAlt Alteration (Maybe Comment)
15 | ModifyTip SequenceValue
16 | OverrideTip SequenceValue
17 | ShowTip 18 | ShowTip
18 | ShowHistory (Maybe Integer) 19 | ShowHistory (Maybe Integer)
19 | Dump 20 | Dump
@@ -30,7 +31,7 @@ isQuote, isEscape :: Char -> Bool
30isQuote q = q `elem` quoteChars 31isQuote q = q `elem` quoteChars
31isEscape e = e `elem` escapeChars 32isEscape e = e `elem` escapeChars
32 33
33parseCmd :: String -> Cmd 34parseCmd :: SequenceM m => String -> m Cmd
34parseCmd = parseCmd' . split 35parseCmd = parseCmd' . split
35 where 36 where
36 split :: String -> [String] 37 split :: String -> [String]
@@ -63,15 +64,47 @@ parseCmd = parseCmd' . split
63 , isEscape c = split' ws w q (Just c) cs -- Set escaped flag at unescaped escape char 64 , isEscape c = split' ws w q (Just c) cs -- Set escaped flag at unescaped escape char
64 | otherwise = split' ws (c : w) q Nothing cs -- Append to word 65 | otherwise = split' ws (c : w) q Nothing cs -- Append to word
65 66
66parseCmd' :: [String] -> Cmd 67parseCmd' :: SequenceM m => [String] -> m Cmd
67parseCmd' [] = Empty 68parseCmd' [] = return Empty
68parseCmd' args = mapResult runParser 69parseCmd' args = do
70 knownEntities <- entities
71 tip <- snd <$> gets getMax
72 return $ mapResult runParser
69 where 73 where
70 runParser = execParserPure (prefs $ showHelpOnError) (cmdParser `info` progDesc "sequence - A tracker for combat sequences in Contact (a pen&paper rpg by Uhrwerk)") args 74 runParser = execParserPure (prefs $ showHelpOnError) (cmdParser knownEntities tip `info` progDesc "sequence - A tracker for combat sequences in Contact (a pen&paper rpg by Uhrwerk)") args
71 mapResult (Success a) = a 75 mapResult (Success a) = a
72 mapResult (Failure help) = UnknownCommand . fst $ renderFailure help "" 76 mapResult (Failure help) = UnknownCommand . fst $ renderFailure help ""
73 mapResult (CompletionInvoked _ ) = ParseError "Completion triggered" 77 mapResult (CompletionInvoked _ ) = ParseError "Completion triggered"
74 78
75cmdParser :: Parser Cmd 79-- data Cmd = PerformAlt Alteration (Maybe Comment)
76cmdParser = hsubparser $ mconcat [ command "quit" $ pure Quit `info` progDesc "Exit gracefully" 80-- | ShowTip
77 ] 81-- | ShowHistory (Maybe Integer)
82-- | Dump
83-- | Quit
84-- data Alteration = Modify Entity SequenceValue
85-- | Override Entity SequenceValue
86-- | Drop Entity
87-- | Insert Entity SequenceValue
88-- | Rename Entity Entity
89
90cmdParser :: Set Entity -> Entity -> Parser Cmd
91cmdParser knownEntities tip = hsubparser $ mconcat [ command "quit" $ pure Quit `info` progDesc "Exit gracefully"
92 , command "dump" $ pure Dump `info` progDesc "Print all internal state in a format not necessarily human readable"
93 , command "history" $ parseHistory `info` progDesc "Print an excerpt of combat history"
94 , command "who" $ pure ShowTip `info` progDesc "Who’s turn is it?"
95 , command "set" $ parseOverride `info` progDesc "Set an entities sequence value"
96 , command "modify" $ parseModify `info` progDesc "Modify an entities sequence value"
97 , command "drop" $ parseDrop `info` progDesc "Stop tracking an entity"
98 , command "add" $ parseAdd `info` progDesc "Start tracking an entity"
99 , command "rename" $ parseRename `info` progDesc "Rename an entity"
100 ]
101 where
102 parseHistory = ShowHistory <$> optional (argument natural (help "How many entries to display" <> metavar "NATURAL"))
103 parseOverride = PerformAlt <$> (Override <$> entity <*> sequenceValue) <*> comment
104
105 natural = do
106 int <- auto
107 if int < 0
108 then readerError "Natural number (0 ≤ n) required"
109 else return int
110 entity = Entity <$>
diff --git a/src/Utils.hs b/src/Utils.hs
index 2254fde..945c6b7 100644
--- a/src/Utils.hs
+++ b/src/Utils.hs
@@ -3,16 +3,23 @@
3module Utils 3module Utils
4 ( showEntity 4 ( showEntity
5 , apply, apply' 5 , apply, apply'
6 , entities
6 ) where 7 ) where
7 8
8import Data.Text (Text) 9import Data.Text (Text)
9import qualified Data.Text as Text 10import qualified Data.Text as Text
10 11
12import Data.PQueue.Prio.Max (MaxPQueue)
13import qualified Data.PQueue.Prio.Max as MaxPQueue
14
11import Data.Monoid (Monoid(..), (<>)) 15import Data.Monoid (Monoid(..), (<>))
12 16
13import Control.Monad.State.Class 17import Control.Monad.State.Class
14import Control.Monad.Writer.Class 18import Control.Monad.Writer.Class
15 19
20import Data.Set (Set)
21import qualified Data.Set as Set
22
16import Types 23import Types
17 24
18showEntity :: Entity -> Text 25showEntity :: Entity -> Text
@@ -28,3 +35,6 @@ apply' alteration = do
28 35
29apply :: Alteration -> Sequence -> (Sequence, History) 36apply :: Alteration -> Sequence -> (Sequence, History)
30apply alteration seq = undefined 37apply alteration seq = undefined
38
39entities :: MonadState Sequence m => m (Set Entity)
40entities = Set.fromList . MaxPQueue.keys <$> get