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) | ||