about summary refs log tree commit diff
path: root/src/Xanthous/Messages.hs
diff options
context:
space:
mode:
authorGriffin Smith <root@gws.fyi>2019-10-06T16·50-0400
committerGriffin Smith <root@gws.fyi>2019-10-06T16·50-0400
commitde8052cef8a9f749cdb2312a4f5ae5f5a44cf1b8 (patch)
tree734d38ad7279b0188b46f67e0288c5efddab7f8e /src/Xanthous/Messages.hs
parent262fc7fb41f14181ed34cecfcca9ef2d25102688 (diff)
Allow eating edible items
Add menu support to the prompt system, and an "Eat" command that prompts
for an item to eat and eats the item the character specifies, restoring
an amount of hitpoints configurable via the item raw type.
Diffstat (limited to 'src/Xanthous/Messages.hs')
-rw-r--r--src/Xanthous/Messages.hs27
1 files changed, 20 insertions, 7 deletions
diff --git a/src/Xanthous/Messages.hs b/src/Xanthous/Messages.hs
index b1aeeb635cc9..b0dc0e4ae9d2 100644
--- a/src/Xanthous/Messages.hs
+++ b/src/Xanthous/Messages.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE TemplateHaskell #-}
+--------------------------------------------------------------------------------
 module Xanthous.Messages
   ( Message(..)
   , resolve
@@ -7,11 +8,13 @@ module Xanthous.Messages
 
     -- * Game messages
   , messages
+  , render
+  , lookup
   , message
   ) where
 --------------------------------------------------------------------------------
-import Xanthous.Prelude
-
+import Xanthous.Prelude hiding (lookup)
+--------------------------------------------------------------------------------
 import Control.Monad.Random.Class (MonadRandom)
 import Data.Aeson (FromJSON, ToJSON, toJSON)
 import Data.Aeson.Generic.DerivingVia
@@ -22,9 +25,10 @@ import Test.QuickCheck.Arbitrary.Generic
 import Test.QuickCheck.Instances.UnorderedContainers ()
 import Text.Mustache
 import qualified Data.Yaml as Yaml
-
+--------------------------------------------------------------------------------
 import Xanthous.Random
 import Xanthous.Orphans ()
+--------------------------------------------------------------------------------
 
 data Message = Single Template | Choice (NonEmpty Template)
   deriving stock (Show, Eq, Ord, Generic)
@@ -78,10 +82,19 @@ messages
   = either (error . Yaml.prettyPrintParseException) id
   $ Yaml.decodeEither' rawMessages
 
+render :: (MonadRandom m, ToJSON params) => Message -> params -> m Text
+render msg params = do
+  tpl <- resolve msg
+  pure . toStrict . renderMustache tpl $ toJSON params
+
+lookup :: [Text] -> Message
+lookup path = fromMaybe notFound $ messages ^? ix path
+  where notFound
+          = Single
+          $ compileMustacheText "template" "Message not found"
+          ^?! _Right
+
 message :: (MonadRandom m, ToJSON params) => [Text] -> params -> m Text
-message path params = maybe notFound renderMessage $ messages ^? ix path
+message path params = maybe notFound (`render` params) $ messages ^? ix path
   where
-    renderMessage msg = do
-      tpl <- resolve msg
-      pure . toStrict . renderMustache tpl $ toJSON params
     notFound = pure "Message not found"