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.hs30
1 files changed, 22 insertions, 8 deletions
diff --git a/src/Sequence/Utils.hs b/src/Sequence/Utils.hs
index 274a69d..9fc0ab2 100644
--- a/src/Sequence/Utils.hs
+++ b/src/Sequence/Utils.hs
@@ -2,7 +2,9 @@
2 2
3module Sequence.Utils 3module Sequence.Utils
4 ( withArg, withFocus 4 ( withArg, withFocus
5 , toName, fromName 5 , toName
6 , Argument(..)
7 , Completion(..)
6 , module Sequence.Utils.Ask 8 , module Sequence.Utils.Ask
7 ) where 9 ) where
8 10
@@ -10,6 +12,7 @@ import Sequence.Types
10 12
11import Control.Monad.State.Strict 13import Control.Monad.State.Strict
12 14
15import Control.Applicative
13import Control.Monad 16import Control.Monad
14import Control.Lens 17import Control.Lens
15 18
@@ -28,6 +31,7 @@ import Data.Maybe
28import Text.Read (readMaybe) 31import Text.Read (readMaybe)
29 32
30import Data.List 33import Data.List
34import Data.Bool
31 35
32import System.Console.Shell 36import System.Console.Shell
33import System.Console.Shell.ShellMonad 37import System.Console.Shell.ShellMonad
@@ -49,20 +53,30 @@ withFocus f = use gFocus >>= \focus -> case focus of
49 Just id -> f id 53 Just id -> f id
50 54
51unaligned = view faction' def 55unaligned = view faction' def
52
53toName :: MonadState GameState m => EntityIdentifier -> m String
54toName id = fromMaybe (show $ id ^. entityId) . fmap (CI.original . view entityName) . Bimap.lookup id <$> use gEntityNames
55 56
56fromName :: MonadState GameState m => String -> m (Maybe EntityIdentifier) 57toName :: MonadState GameState m => EntityIdentifier -> m String
57fromName (readMaybe -> (Just (EntityIdentifier -> n))) = (n <$) . guard . Map.member n <$> use gEntities 58toName ident = do
58fromName (EntityName . CI.mk -> name) = Bimap.lookupR name <$> use gEntityNames 59 let number = review entityId' ident
60 isShadowed <- uses gEntityNames . Bimap.memberR $ view entityName number
61 let number' = bool id ('#':) isShadowed $ number
62 fromMaybe number' . fmap (review entityName) . Bimap.lookup ident <$> use gEntityNames
59 63
60instance Completion EntityIdentifier GameState where 64instance Completion EntityIdentifier GameState where
61 completableLabel _ = "<entity>" 65 completableLabel _ = "<entity>"
62 complete _ st prefix = return . filter ((isPrefixOf `on` CI.foldCase) prefix) . map ((evalState ?? st) . toName) . Map.keys $ st ^. gEntities 66 complete _ st prefix = return . filter ((isPrefixOf `on` CI.foldCase) prefix) . map ((evalState ?? st) . toName) . Map.keys $ st ^. gEntities
63 67
64instance Argument EntityIdentifier GameState where 68instance Argument EntityIdentifier GameState where
65 arg = fromName 69 arg = \str -> do
70 fromForcedIdR <- fromForcedId str
71 fromNameR <- fromName str
72 fromIdR <- fromId str
73 return $ fromForcedIdR <|> fromNameR <|> fromIdR
74 where
75 fromName (EntityName . CI.mk -> name) = Bimap.lookupR name <$> use gEntityNames
76 fromId (preview entityId' -> Just n) = (n <$) . guard . Map.member n <$> use gEntities
77 fromId _ = return Nothing
78 fromForcedId ('#':str) = fromId str
79 fromForcedId _ = return Nothing
66 80
67instance Completion Faction GameState where 81instance Completion Faction GameState where
68 completableLabel _ = "<faction>" 82 completableLabel _ = "<faction>"