summaryrefslogtreecommitdiff
path: root/src/Sequence/Utils.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Sequence/Utils.hs')
-rw-r--r--src/Sequence/Utils.hs46
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
3module Sequence.Utils
4 ( toName, fromName
5 ) where
6
7import Sequence.Types
8
9import Control.Monad.State.Strict
10
11import Control.Lens
12
13import Data.Bimap (Bimap)
14import qualified Data.Bimap as Bimap
15
16import Data.CaseInsensitive (CI)
17import qualified Data.CaseInsensitive as CI
18
19import Data.Map.Strict (Map)
20import qualified Data.Map.Strict as Map
21
22import Data.Function
23import Data.Default
24import Data.Maybe
25import Text.Read
26
27import Data.List
28
29import System.Console.Shell
30
31unaligned = view faction' def
32
33toName :: MonadState GameState m => EntityIdentifier -> m String
34toName id = fromMaybe (show $ id ^. entityId) . fmap (CI.original . view entityName) . Bimap.lookup id <$> use gEntityNames
35
36fromName :: MonadState GameState m => String -> m (Maybe EntityIdentifier)
37fromName (readMaybe -> n@(Just _)) = return $ EntityIdentifier <$> n
38fromName (EntityName . CI.mk -> name) = Bimap.lookupR name <$> use gEntityNames
39
40instance 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
44instance 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)