diff options
| author | Gregor Kleen <gkleen@yggdrasil.li> | 2016-06-05 01:10:24 +0200 |
|---|---|---|
| committer | Gregor Kleen <gkleen@yggdrasil.li> | 2016-06-05 01:10:24 +0200 |
| commit | e93892c008759957e4ee567e7e642bd8a0dd9286 (patch) | |
| tree | bc2bf233a51cebe7d6525c1dfd6511986dd85cbb /src/Sequence/Utils.hs | |
| parent | 62ed6579cc1a71c4e962063999743f7fcd927f1c (diff) | |
| download | 2017-01-16_17:13:37-e93892c008759957e4ee567e7e642bd8a0dd9286.tar 2017-01-16_17:13:37-e93892c008759957e4ee567e7e642bd8a0dd9286.tar.gz 2017-01-16_17:13:37-e93892c008759957e4ee567e7e642bd8a0dd9286.tar.bz2 2017-01-16_17:13:37-e93892c008759957e4ee567e7e642bd8a0dd9286.tar.xz 2017-01-16_17:13:37-e93892c008759957e4ee567e7e642bd8a0dd9286.zip | |
Framework for rolling tests
Diffstat (limited to 'src/Sequence/Utils.hs')
| -rw-r--r-- | src/Sequence/Utils.hs | 9 |
1 files changed, 5 insertions, 4 deletions
diff --git a/src/Sequence/Utils.hs b/src/Sequence/Utils.hs index 9fc0ab2..517c3c2 100644 --- a/src/Sequence/Utils.hs +++ b/src/Sequence/Utils.hs | |||
| @@ -1,7 +1,7 @@ | |||
| 1 | {-# LANGUAGE ViewPatterns, FlexibleContexts, MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, UndecidableInstances, OverloadedStrings #-} | 1 | {-# LANGUAGE ViewPatterns, FlexibleContexts, MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, UndecidableInstances, OverloadedStrings #-} |
| 2 | 2 | ||
| 3 | module Sequence.Utils | 3 | module Sequence.Utils |
| 4 | ( withArg, withFocus | 4 | ( withArg, withFocus, withFocus' |
| 5 | , toName | 5 | , toName |
| 6 | , Argument(..) | 6 | , Argument(..) |
| 7 | , Completion(..) | 7 | , Completion(..) |
| @@ -48,9 +48,10 @@ withArg f (Completable str) = arg str >>= \a -> case a of | |||
| 48 | Just a -> f a | 48 | Just a -> f a |
| 49 | 49 | ||
| 50 | withFocus :: (EntityIdentifier -> Sh GameState ()) -> Sh GameState () | 50 | withFocus :: (EntityIdentifier -> Sh GameState ()) -> Sh GameState () |
| 51 | withFocus f = use gFocus >>= \focus -> case focus of | 51 | withFocus f = use gFocus >>= maybe (shellPutErrLn $ "Currently not focusing any entity") f |
| 52 | Nothing -> shellPutErrLn $ "Currently not focusing any entity" | 52 | |
| 53 | Just id -> f id | 53 | withFocus' :: (Entity -> Sh GameState a) -> Sh GameState (Maybe a) |
| 54 | withFocus' f = preuse gFocus' >>= maybe (Nothing <$ shellPutErrLn "Currently not focusing any entity") (fmap Just . f) | ||
| 54 | 55 | ||
| 55 | unaligned = view faction' def | 56 | unaligned = view faction' def |
| 56 | 57 | ||