command parsing

1 files changed, 47 insertions, 29 deletions

diff --git a/src/Command.hs b/src/Command.hs
index 79893a5..3616729 100644
--- a/src/Command.hs
+++ b/src/Command.hs
@@ -5,13 +5,20 @@ module Command
        , parseCmd
        ) where
 
-import Data.Set (Set)
-import qualified Data.Set as Set
+import Data.PQueue.Prio.Max (MaxPQueue)
+import qualified Data.PQueue.Prio.Max as MaxPQueue (getMax)
+  
+import Control.Monad.State (MonadState(..), gets)
 
 import Options.Applicative
 
 import Data.Char (isSpace)
 
+import Data.Text (Text)
+import qualified Data.Text as Text
+
+import Data.Maybe (fromMaybe)
+
 import Types
 
 data Cmd = PerformAlt Alteration (Maybe Comment)
@@ -67,44 +74,55 @@ parseCmd = parseCmd' . split
 parseCmd' :: SequenceM m => [String] -> m Cmd
 parseCmd' [] = return Empty
 parseCmd' args = do
-  knownEntities <- entities
-  tip <- snd <$> gets getMax
+  tip <- fmap snd <$> gets MaxPQueue.getMax
+  let
+    runParser = execParserPure (prefs $ showHelpOnError) (cmdParser tip `info` progDesc "sequence - A tracker for combat sequences in Contact (a pen&paper rpg by Uhrwerk)") args
   return $ mapResult runParser
   where
-    runParser = execParserPure (prefs $ showHelpOnError) (cmdParser knownEntities tip `info` progDesc "sequence - A tracker for combat sequences in Contact (a pen&paper rpg by Uhrwerk)") args
     mapResult (Success a) = a
     mapResult (Failure help) = UnknownCommand . fst $ renderFailure help ""
     mapResult (CompletionInvoked _ ) = ParseError "Completion triggered" 
 
--- data Cmd = PerformAlt Alteration (Maybe Comment)
---          | ShowTip
---          | ShowHistory (Maybe Integer)
---          | Dump
---          | Quit
--- data Alteration = Modify Entity SequenceValue
---                 | Override Entity SequenceValue
---                 | Drop Entity
---                 | Insert Entity SequenceValue
---                 | Rename Entity Entity
-
-cmdParser :: Set Entity -> Entity -> Parser Cmd
-cmdParser knownEntities tip = hsubparser $ mconcat [ command "quit" $ pure Quit `info` progDesc "Exit gracefully"
-                                                   , command "dump" $ pure Dump `info` progDesc "Print all internal state in a format not necessarily human readable"
-                                                   , command "history" $ parseHistory `info` progDesc "Print an excerpt of combat history"
-                                                   , command "who" $ pure ShowTip `info` progDesc "Who’s turn is it?"
-                                                   , command "set" $ parseOverride `info` progDesc "Set an entities sequence value"
-                                                   , command "modify" $ parseModify `info` progDesc "Modify an entities sequence value"
-                                                   , command "drop" $ parseDrop `info` progDesc "Stop tracking an entity"
-                                                   , command "add" $ parseAdd `info` progDesc "Start tracking an entity"
-                                                   , command "rename" $ parseRename `info` progDesc "Rename an entity"
-                                                   ]
+cmdParser :: Maybe Entity -> Parser Cmd
+cmdParser tip = hsubparser $ mconcat [ command "quit" $ pure Quit `info` progDesc "Exit gracefully"
+                                     , command "dump" $ pure Dump `info` progDesc "Print all internal state in a format not necessarily human readable"
+                                     , command "history" $ parseHistory `info` progDesc "Print an excerpt of combat history"
+                                     , command "who" $ pure ShowTip `info` progDesc "Who’s turn is it?"
+                                     , command "set" $ parseOverride `info` progDesc "Set an entities sequence value"
+                                     , command "modify" $ parseModify `info` progDesc "Modify an entities sequence value"
+                                     , command "drop" $ parseDrop `info` progDesc "Stop tracking an entity"
+                                     , command "add" $ parseAdd `info` progDesc "Start tracking an entity"
+                                     , command "rename" $ parseRename `info` progDesc "Rename an entity"
+                                     ]
   where
     parseHistory = ShowHistory <$> optional (argument natural (help "How many entries to display" <> metavar "NATURAL"))
-    parseOverride = PerformAlt <$> (Override <$> entity <*> sequenceValue) <*> comment
+    parseOverride = PerformAlt <$> (Override <$> entity <*> sequenceValue') <*> comment
+    parseModify = PerformAlt <$> (Modify <$> entity <*> sequenceValue) <*> comment
+    parseDrop = PerformAlt <$> (Drop <$> entity) <*> comment
+    parseAdd = PerformAlt <$> (Insert <$> entity <*> sequenceValue') <*> comment
+    parseRename = PerformAlt <$> (Rename <$> entity <*> entity') <*> comment
 
     natural = do
       int <- auto
       if int < 0
         then readerError "Natural number (0 ≤ n) required"
         else return int
-    entity = Entity <$> 
+    positive = do
+      int <- auto
+      if int <= 0
+        then readerError "Positive number (0 < n) required"
+        else return int
+
+    entity
+      | (Just tip') <- tip = fromMaybe tip' <$> optional entity'
+      | otherwise = entity'
+    entity' = Entity <$> (Text.pack <$> strArgument (help "Name of the target entity" <> metavar "NAME")) <*> optional (argument positive $ help "Number of the target entity" <> metavar "NUMBER")
+
+    sequenceValue = argument auto (help "Sequence value adjustment" <> metavar "SEQUENCE")
+    sequenceValue' = argument auto (help "Sequence value" <> metavar "SEQUENCE")
+
+    comment = toMaybe . fmap Text.pack <$> optional (strArgument $ help "Comment to record in history together with this action" <> metavar "COMMENT")
+    toMaybe (Just t)
+      | Text.null t = Nothing
+      | otherwise = Just t
+    toMaybe Nothing = Nothing