diff options
Diffstat (limited to 'src/Sequence/Utils.hs')
-rw-r--r-- | src/Sequence/Utils.hs | 30 |
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 | ||
3 | module Sequence.Utils | 3 | module 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 | ||
11 | import Control.Monad.State.Strict | 13 | import Control.Monad.State.Strict |
12 | 14 | ||
15 | import Control.Applicative | ||
13 | import Control.Monad | 16 | import Control.Monad |
14 | import Control.Lens | 17 | import Control.Lens |
15 | 18 | ||
@@ -28,6 +31,7 @@ import Data.Maybe | |||
28 | import Text.Read (readMaybe) | 31 | import Text.Read (readMaybe) |
29 | 32 | ||
30 | import Data.List | 33 | import Data.List |
34 | import Data.Bool | ||
31 | 35 | ||
32 | import System.Console.Shell | 36 | import System.Console.Shell |
33 | import System.Console.Shell.ShellMonad | 37 | import 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 | ||
51 | unaligned = view faction' def | 55 | unaligned = view faction' def |
52 | |||
53 | toName :: MonadState GameState m => EntityIdentifier -> m String | ||
54 | toName id = fromMaybe (show $ id ^. entityId) . fmap (CI.original . view entityName) . Bimap.lookup id <$> use gEntityNames | ||
55 | 56 | ||
56 | fromName :: MonadState GameState m => String -> m (Maybe EntityIdentifier) | 57 | toName :: MonadState GameState m => EntityIdentifier -> m String |
57 | fromName (readMaybe -> (Just (EntityIdentifier -> n))) = (n <$) . guard . Map.member n <$> use gEntities | 58 | toName ident = do |
58 | fromName (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 | ||
60 | instance Completion EntityIdentifier GameState where | 64 | instance 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 | ||
64 | instance Argument EntityIdentifier GameState where | 68 | instance 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 | ||
67 | instance Completion Faction GameState where | 81 | instance Completion Faction GameState where |
68 | completableLabel _ = "<faction>" | 82 | completableLabel _ = "<faction>" |