diff options
Diffstat (limited to 'src/Sequence/Utils.hs')
| -rw-r--r-- | src/Sequence/Utils.hs | 46 |
1 files changed, 46 insertions, 0 deletions
diff --git a/src/Sequence/Utils.hs b/src/Sequence/Utils.hs new file mode 100644 index 0000000..7d28b83 --- /dev/null +++ b/src/Sequence/Utils.hs | |||
| @@ -0,0 +1,46 @@ | |||
| 1 | {-# LANGUAGE ViewPatterns, FlexibleContexts, MultiParamTypeClasses #-} | ||
| 2 | |||
| 3 | module Sequence.Utils | ||
| 4 | ( toName, fromName | ||
| 5 | ) where | ||
| 6 | |||
| 7 | import Sequence.Types | ||
| 8 | |||
| 9 | import Control.Monad.State.Strict | ||
| 10 | |||
| 11 | import Control.Lens | ||
| 12 | |||
| 13 | import Data.Bimap (Bimap) | ||
| 14 | import qualified Data.Bimap as Bimap | ||
| 15 | |||
| 16 | import Data.CaseInsensitive (CI) | ||
| 17 | import qualified Data.CaseInsensitive as CI | ||
| 18 | |||
| 19 | import Data.Map.Strict (Map) | ||
| 20 | import qualified Data.Map.Strict as Map | ||
| 21 | |||
| 22 | import Data.Function | ||
| 23 | import Data.Default | ||
| 24 | import Data.Maybe | ||
| 25 | import Text.Read | ||
| 26 | |||
| 27 | import Data.List | ||
| 28 | |||
| 29 | import System.Console.Shell | ||
| 30 | |||
| 31 | unaligned = view faction' def | ||
| 32 | |||
| 33 | toName :: MonadState GameState m => EntityIdentifier -> m String | ||
| 34 | toName id = fromMaybe (show $ id ^. entityId) . fmap (CI.original . view entityName) . Bimap.lookup id <$> use gEntityNames | ||
| 35 | |||
| 36 | fromName :: MonadState GameState m => String -> m (Maybe EntityIdentifier) | ||
| 37 | fromName (readMaybe -> n@(Just _)) = return $ EntityIdentifier <$> n | ||
| 38 | fromName (EntityName . CI.mk -> name) = Bimap.lookupR name <$> use gEntityNames | ||
| 39 | |||
| 40 | instance Completion EntityIdentifier GameState where | ||
| 41 | completableLabel _ = "<entity>" | ||
| 42 | complete _ st prefix = return . filter ((isPrefixOf `on` CI.foldCase) prefix) . map ((evalState ?? st) . toName) . Map.keys $ st ^. gEntities | ||
| 43 | |||
| 44 | instance Completion Faction GameState where | ||
| 45 | completableLabel _ = "<faction>" | ||
| 46 | complete _ st prefix = return . filter ((isPrefixOf `on` CI.foldCase) prefix) . nub . sort $ unaligned : map (view faction') (st ^. inhabitedFactions) | ||
