From fbaf4d9da45f714c32f410d3b5785fd06504325a Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Sat, 4 Jun 2016 18:06:36 +0200
Subject: archetypes & cleanup

---
 src/Sequence/Utils.hs | 30 ++++++++++++++++++++++--------
 1 file changed, 22 insertions(+), 8 deletions(-)

(limited to 'src/Sequence/Utils.hs')

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 @@
 
 module Sequence.Utils
   ( withArg, withFocus
-  , toName, fromName
+  , toName
+  , Argument(..)
+  , Completion(..)
   , module Sequence.Utils.Ask
   ) where
 
@@ -10,6 +12,7 @@ import Sequence.Types
 
 import Control.Monad.State.Strict
 
+import Control.Applicative
 import Control.Monad
 import Control.Lens
 
@@ -28,6 +31,7 @@ import Data.Maybe
 import Text.Read (readMaybe)
 
 import Data.List
+import Data.Bool
 
 import System.Console.Shell
 import System.Console.Shell.ShellMonad
@@ -49,20 +53,30 @@ withFocus f = use gFocus >>= \focus -> case focus of
   Just id -> f id
 
 unaligned = view faction' def
-  
-toName :: MonadState GameState m => EntityIdentifier -> m String
-toName id = fromMaybe (show $ id ^. entityId) . fmap (CI.original . view entityName) . Bimap.lookup id <$> use gEntityNames
 
-fromName :: MonadState GameState m => String -> m (Maybe EntityIdentifier)
-fromName (readMaybe -> (Just (EntityIdentifier -> n))) = (n <$) . guard . Map.member n <$> use gEntities
-fromName (EntityName . CI.mk -> name) = Bimap.lookupR name <$> use gEntityNames
+toName :: MonadState GameState m => EntityIdentifier -> m String
+toName ident = do
+  let number = review entityId' ident
+  isShadowed <- uses gEntityNames . Bimap.memberR $ view entityName number
+  let number' = bool id ('#':) isShadowed $ number
+  fromMaybe number' . fmap (review entityName) . Bimap.lookup ident <$> use gEntityNames
 
 instance Completion EntityIdentifier GameState where
   completableLabel _ = "<entity>"
   complete _ st prefix = return . filter ((isPrefixOf `on` CI.foldCase) prefix) . map ((evalState ?? st) . toName) . Map.keys $ st ^. gEntities
 
 instance Argument EntityIdentifier GameState where
-  arg = fromName
+  arg = \str -> do
+    fromForcedIdR <- fromForcedId str
+    fromNameR <- fromName str
+    fromIdR <- fromId str
+    return $ fromForcedIdR <|> fromNameR <|> fromIdR
+    where
+      fromName (EntityName . CI.mk -> name) = Bimap.lookupR name <$> use gEntityNames
+      fromId (preview entityId' -> Just n) = (n <$) . guard . Map.member n <$> use gEntities
+      fromId _ = return Nothing
+      fromForcedId ('#':str) = fromId str
+      fromForcedId _ = return Nothing
 
 instance Completion Faction GameState where
   completableLabel _ = "<faction>"
-- 
cgit v1.2.3