Death & Unconsciousness

1 files changed, 19 insertions, 2 deletions

diff --git a/src/Sequence/Utils.hs b/src/Sequence/Utils.hs
index 8b205ea..1b52630 100644
--- a/src/Sequence/Utils.hs
+++ b/src/Sequence/Utils.hs
@@ -1,8 +1,9 @@
-{-# LANGUAGE ViewPatterns, FlexibleContexts, MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, UndecidableInstances, OverloadedStrings #-}
+{-# LANGUAGE ViewPatterns, FlexibleContexts, MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, UndecidableInstances, OverloadedStrings, RankNTypes #-}
 
 module Sequence.Utils
   ( withArg, withFocus, withFocus'
-  , toName
+  , focusState
+  , toName, toDesc
   , Argument(..)
   , Completion(..)
   , module Sequence.Utils.Ask
@@ -44,6 +45,7 @@ import System.Console.Shell.Backend.Haskeline
 
 import Sequence.Utils.Ask
 import Sequence.Contact.Types
+import Sequence.Formula
 
 class Argument a st | a -> st where
   arg :: String -> Sh st (Maybe a)
@@ -59,6 +61,9 @@ withFocus f = use gFocus >>= maybe (shellPutErrLn $ "Currently not focusing any
 withFocus' :: (Entity -> Sh GameState a) -> Sh GameState (Maybe a)
 withFocus' f = preuse gFocus' >>= maybe (Nothing <$ shellPutErrLn "Currently not focusing any entity") (fmap Just . f)
 
+focusState :: MonadState GameState m => Traversal' GameState a -> StateT a (MaybeT m) b -> m (Maybe b)
+focusState lens action = runMaybeT $ uncurry (<$) . over _2 (lens .=) =<< runStateT action =<< MaybeT (preuse lens)
+
 unaligned = view faction' def
 
 toName :: MonadState GameState m => EntityIdentifier -> m String
@@ -68,6 +73,18 @@ toName ident = do
   let number' = bool id ('#':) isShadowed $ number
   fromMaybe number' . fmap (review entityName) . Bimap.lookup ident <$> use gEntityNames
 
+toDesc :: (MonadState GameState m, MonadIO m) => EntityIdentifier -> m String
+toDesc ident = do
+  name <- toName ident
+  health <- runMaybeT $ do
+    maxVit <- MaybeT . focusState (gEntities . ix ident) . evalFormula' name =<< (MaybeT . preuse $ gEntities . ix ident . eStats . sMaxVitality)
+    hDamage <- MaybeT . preuse $ gEntities . ix ident . eStats . sTotalDamage
+    fDamage <- MaybeT . preuse $ gEntities . ix ident . eStats . sFatigue
+    return $ (maxVit - hDamage, maxVit - fDamage)
+  case health of
+    Just dmg -> return $ name ++ " " ++ show dmg
+    Nothing -> return name
+
 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