diff options
Diffstat (limited to 'src/Sequence/Utils.hs')
| -rw-r--r-- | src/Sequence/Utils.hs | 17 |
1 files changed, 16 insertions, 1 deletions
diff --git a/src/Sequence/Utils.hs b/src/Sequence/Utils.hs index aa92081..aea853d 100644 --- a/src/Sequence/Utils.hs +++ b/src/Sequence/Utils.hs | |||
| @@ -1,7 +1,9 @@ | |||
| 1 | {-# LANGUAGE ViewPatterns, FlexibleContexts, MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, UndecidableInstances #-} | 1 | {-# LANGUAGE ViewPatterns, FlexibleContexts, MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, UndecidableInstances #-} |
| 2 | 2 | ||
| 3 | module Sequence.Utils | 3 | module Sequence.Utils |
| 4 | ( withArg, toName, fromName | 4 | ( withArg, withFocus |
| 5 | , askBool | ||
| 6 | , toName, fromName | ||
| 5 | ) where | 7 | ) where |
| 6 | 8 | ||
| 7 | import Sequence.Types | 9 | import Sequence.Types |
| @@ -28,6 +30,7 @@ import Data.List | |||
| 28 | 30 | ||
| 29 | import System.Console.Shell | 31 | import System.Console.Shell |
| 30 | import System.Console.Shell.ShellMonad | 32 | import System.Console.Shell.ShellMonad |
| 33 | import System.Console.Shell.Backend.Haskeline | ||
| 31 | 34 | ||
| 32 | 35 | ||
| 33 | class Argument a st | a -> st where | 36 | class Argument a st | a -> st where |
| @@ -38,6 +41,18 @@ withArg f (Completable str) = arg str >>= \a -> case a of | |||
| 38 | Nothing -> shellPutErrLn $ "Could not parse ‘" ++ str ++ "’" | 41 | Nothing -> shellPutErrLn $ "Could not parse ‘" ++ str ++ "’" |
| 39 | Just a -> f a | 42 | Just a -> f a |
| 40 | 43 | ||
| 44 | withFocus :: (EntityIdentifier -> Sh GameState ()) -> Sh GameState () | ||
| 45 | withFocus f = use gFocus >>= \focus -> case focus of | ||
| 46 | Nothing -> shellPutErrLn $ "Currently not focusing any entity" | ||
| 47 | Just id -> f id | ||
| 48 | |||
| 49 | askBool :: String -> Bool -> Sh st Bool | ||
| 50 | askBool prompt initial = liftIO $ runShell (initialShellDescription { shellCommands = [cmd "y" yes "yes", cmd "n" no "no"], commandStyle = SingleCharCommands, prompt = const $ return prompt, historyEnabled = False }) haskelineBackend initial | ||
| 51 | where | ||
| 52 | yes, no :: Sh Bool () | ||
| 53 | yes = put True | ||
| 54 | no = put False | ||
| 55 | |||
| 41 | unaligned = view faction' def | 56 | unaligned = view faction' def |
| 42 | 57 | ||
| 43 | toName :: MonadState GameState m => EntityIdentifier -> m String | 58 | toName :: MonadState GameState m => EntityIdentifier -> m String |
