diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Command.hs | 55 | ||||
| -rw-r--r-- | src/Utils.hs | 10 |
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 | ||
| 8 | import Data.Set (Set) | ||
| 9 | import qualified Data.Set as Set | ||
| 10 | |||
| 8 | import Options.Applicative | 11 | import Options.Applicative |
| 9 | 12 | ||
| 10 | import Data.Char (isSpace) | 13 | import Data.Char (isSpace) |
| 11 | 14 | ||
| 12 | import Types | 15 | import Types |
| 13 | 16 | ||
| 14 | data Cmd = PerformAlt Alteration | 17 | data 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 | |||
| 30 | isQuote q = q `elem` quoteChars | 31 | isQuote q = q `elem` quoteChars |
| 31 | isEscape e = e `elem` escapeChars | 32 | isEscape e = e `elem` escapeChars |
| 32 | 33 | ||
| 33 | parseCmd :: String -> Cmd | 34 | parseCmd :: SequenceM m => String -> m Cmd |
| 34 | parseCmd = parseCmd' . split | 35 | parseCmd = 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 | ||
| 66 | parseCmd' :: [String] -> Cmd | 67 | parseCmd' :: SequenceM m => [String] -> m Cmd |
| 67 | parseCmd' [] = Empty | 68 | parseCmd' [] = return Empty |
| 68 | parseCmd' args = mapResult runParser | 69 | parseCmd' 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 | ||
| 75 | cmdParser :: Parser Cmd | 79 | -- data Cmd = PerformAlt Alteration (Maybe Comment) |
| 76 | cmdParser = 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 | |||
| 90 | cmdParser :: Set Entity -> Entity -> Parser Cmd | ||
| 91 | cmdParser 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 @@ | |||
| 3 | module Utils | 3 | module Utils |
| 4 | ( showEntity | 4 | ( showEntity |
| 5 | , apply, apply' | 5 | , apply, apply' |
| 6 | , entities | ||
| 6 | ) where | 7 | ) where |
| 7 | 8 | ||
| 8 | import Data.Text (Text) | 9 | import Data.Text (Text) |
| 9 | import qualified Data.Text as Text | 10 | import qualified Data.Text as Text |
| 10 | 11 | ||
| 12 | import Data.PQueue.Prio.Max (MaxPQueue) | ||
| 13 | import qualified Data.PQueue.Prio.Max as MaxPQueue | ||
| 14 | |||
| 11 | import Data.Monoid (Monoid(..), (<>)) | 15 | import Data.Monoid (Monoid(..), (<>)) |
| 12 | 16 | ||
| 13 | import Control.Monad.State.Class | 17 | import Control.Monad.State.Class |
| 14 | import Control.Monad.Writer.Class | 18 | import Control.Monad.Writer.Class |
| 15 | 19 | ||
| 20 | import Data.Set (Set) | ||
| 21 | import qualified Data.Set as Set | ||
| 22 | |||
| 16 | import Types | 23 | import Types |
| 17 | 24 | ||
| 18 | showEntity :: Entity -> Text | 25 | showEntity :: Entity -> Text |
| @@ -28,3 +35,6 @@ apply' alteration = do | |||
| 28 | 35 | ||
| 29 | apply :: Alteration -> Sequence -> (Sequence, History) | 36 | apply :: Alteration -> Sequence -> (Sequence, History) |
| 30 | apply alteration seq = undefined | 37 | apply alteration seq = undefined |
| 38 | |||
| 39 | entities :: MonadState Sequence m => m (Set Entity) | ||
| 40 | entities = Set.fromList . MaxPQueue.keys <$> get | ||
