Use plain old functions instead of StateT

src/Web/Larceny.hs

@@ -130,7 +130,7 @@ renderWith l sub s = renderRelative l sub s []
 renderRelative :: Library s -> Substitutions s -> s -> Path -> Path -> IO (Maybe Text)
 renderRelative l sub s givenPath targetPath =
   case findTemplate l givenPath targetPath of
-    (pth, Just (Template run)) -> Just <$> evalStateT (run pth sub l) s
+    (pth, Just (Template run)) -> Just <$> fst <$> run pth sub l s
     (_, Nothing) -> return Nothing
 
 -- | Load all the templates in some directory into a Library.

src/Web/Larceny/Fills.hs

@@ -17,7 +17,8 @@ module Web.Larceny.Fills ( textFill
                          , (%)) where
 
 import           Control.Exception
-import           Control.Monad.State (StateT)
+import           Control.Monad       (foldM)
+import           Control.Monad.State (StateT, runStateT)
 import qualified Data.Map            as M
 import           Data.Maybe          (fromMaybe)
 import           Data.Text           (Text)
@@ -100,7 +101,9 @@ rawTextFill t = rawTextFill' (return t)
 -- textFill' getTextFromDatabase
 -- @
 textFill' :: StateT s IO Text -> Fill s
-textFill' t = Fill $ \_m _t _l -> HE.text <$> t
+textFill' t = Fill $ \_m _t _l st -> do
+   (t, st') <- runStateT t st
+   return (HE.text t, st')
 
 -- | Use state or IO, then fill in some text.
 --
@@ -109,7 +112,7 @@ textFill' t = Fill $ \_m _t _l -> HE.text <$> t
 -- textFill' getTextFromDatabase
 -- @
 rawTextFill' :: StateT s IO Text -> Fill s
-rawTextFill' t = Fill $ \_m _t _l -> t
+rawTextFill' t = Fill $ \_m _t _l -> runStateT t
 
 -- | Create substitutions for each element in a list and fill the child nodes
 -- with those substitutions.
@@ -124,17 +127,26 @@ rawTextFill' t = Fill $ \_m _t _l -> t
 mapSubs :: (a -> Substitutions s)
         -> [a]
         -> Fill s
-mapSubs f xs = Fill $ \_attrs (pth, tpl) lib ->
-    T.concat <$>  mapM (\n -> runTemplate tpl pth (f n) lib) xs
+mapSubs f xs = Fill $ \_attrs (pth, tpl) lib st ->
+  foldM
+    (\(text, st) item -> do
+      (t , st') <- runTemplate tpl pth (f item) lib st
+      return (text <> t, st'))
+    ("", st)
+    xs
 
 -- | Create substitutions for each element in a list (using IO/state if
 -- needed) and fill the child nodes with those substitutions.
 mapSubs' :: (a -> StateT s IO (Substitutions s)) -> [a] -> Fill s
 mapSubs' f xs = Fill $
-  \_m (pth, tpl) lib ->
-    T.concat <$>  mapM (\x -> do
-                           s' <- f x
-                           runTemplate tpl pth s' lib) xs
+  \_m (pth, tpl) lib st ->
+    foldM
+      (\(text, st) item -> do
+        (s', st' ) <- runStateT (f item) st
+        (t , st'') <- runTemplate tpl pth s' lib st'
+        return (text <> t, st''))
+      ("", st)
+      xs
 
 -- | Fill in the child nodes of the blank with substitutions already
 -- available.
@@ -198,11 +210,11 @@ maybeFillChildrenWith (Just s) = Fill $ \_s (pth, Template tpl) l ->
 --
 -- > Bonnie Thunders
 maybeFillChildrenWith' :: StateT s IO (Maybe (Substitutions s)) -> Fill s
-maybeFillChildrenWith' sMSubs = Fill $ \_s (pth, Template tpl) l -> do
-  mSubs <- sMSubs
+maybeFillChildrenWith' sMSubs = Fill $ \_s (pth, Template tpl) l st -> do
+  (mSubs, newState) <- runStateT sMSubs st
   case mSubs of
-    Nothing -> return ""
-    Just s  -> tpl pth s l
+    Nothing -> return ("", newState)
+    Just s  -> tpl pth s l newState
 
 -- | Use attributes from the the blank as arguments to the fill.
 --

src/Web/Larceny/Internal.hs

@@ -96,22 +96,23 @@ toLarcenyNode _ (X.NodeInstruction _) = NodeContent ""
 mk :: Overrides -> [Node] -> Template s
 mk o = f
   where f nodes =
-          Template $ \pth m l ->
+          Template $ \pth m l st ->
                       let pc = ProcessContext pth m l o f nodes in
-                      do s <- get
-                         T.concat <$> toUserState (pc s) (process nodes)
+                      do (textList, st') <- toUserState (pc st) (process nodes)
+                         return (T.concat textList, st')
 
-toProcessState :: StateT s IO a -> StateT (ProcessContext s) IO a
+
+toProcessState :: (s -> IO (a, s)) -> StateT (ProcessContext s) IO a
 toProcessState f =
   do pc <- get
-     (result, s') <- liftIO $ runStateT f (_pcState pc)
+     (result, s') <- liftIO $ f (_pcState pc)
      pcState .= s'
      return result
 
-toUserState :: ProcessContext s -> StateT (ProcessContext s) IO a -> StateT s IO a
-toUserState pc f =
-  do s <- get
-     liftIO $ evalStateT f (pc { _pcState = s })
+toUserState :: ProcessContext s -> StateT (ProcessContext s) IO a -> IO (a, s)
+toUserState pc f = 
+  do (a, st) <- runStateT f pc
+     return (a, _pcState st)
 
 fillIn :: Blank -> Substitutions s -> Fill s
 fillIn tn m = fromMaybe (fallbackFill tn m) (M.lookup tn m)
@@ -120,9 +121,9 @@ fallbackFill :: Blank -> Substitutions s -> Fill s
 fallbackFill FallbackBlank m =  fromMaybe (textFill "") (M.lookup FallbackBlank m)
 fallbackFill (Blank tn) m =
   let fallback = fromMaybe (textFill "") (M.lookup FallbackBlank m) in
-  Fill $ \attr (pth, tpl) lib ->
-    do liftIO $ putStrLn ("Larceny: Missing fill for blank " <> show tn <> " in template " <> show pth)
-       unFill fallback attr (pth, tpl) lib
+  Fill $ \attr (pth, tpl) lib st ->
+    do putStrLn ("Larceny: Missing fill for blank " <> show tn <> " in template " <> show pth)
+       unFill fallback attr (pth, tpl) lib st
 
 data ProcessContext s = ProcessContext { _pcPath          :: Path
                                        , _pcSubs          :: Substitutions s
@@ -227,11 +228,11 @@ fillAttrs attrs =  M.fromList <$> mapM fill (M.toList attrs)
 
 fillAttr :: Either Text Blank -> StateT (ProcessContext s) IO Text
 fillAttr eBlankText =
-  do (ProcessContext pth m l _ mko _ _) <- get
+  do pc@(ProcessContext pth m l _ mko _ _) <- get
      toProcessState $
        case eBlankText of
          Right hole -> unFill (fillIn hole m) mempty (pth, mko []) l
-         Left text -> return text
+         Left text -> \s -> return (text, s)
 
 -- Look up the Fill for the hole.  Apply the Fill to a map of
 -- attributes, a Template made from the child nodes (adding in the

src/Web/Larceny/Legacy.hs

@@ -0,0 +1,98 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Web.Larceny.Legacy ( textFill
+                          , textFill'
+                          , rawTextFill
+                          , rawTextFill'
+                          , mapSubs
+                          , mapSubs'
+                          , fillChildren
+                          , fillChildrenWith
+                          , fillChildrenWith'
+                          , maybeFillChildrenWith
+                          , maybeFillChildrenWith'
+                          , ifFill
+                          , useAttrs
+                          , a
+                          , (%)
+                          , fill ) where
+
+import           Control.Exception
+import           Control.Monad       (foldM)
+import           Control.Monad.State (StateT, runStateT)
+import qualified Data.Map            as M
+import           Data.Maybe          (fromMaybe)
+import           Data.Text           (Text)
+import qualified Data.Text           as T
+import qualified HTMLEntities.Text   as HE
+------------
+import           Web.Larceny.Types
+import           Web.Larceny.Fills hiding (textFill', rawTextFill', mapSubs', fillChildrenWith', maybeFillChildrenWith')
+
+
+fill :: (Attributes -> (Path, Template s) -> Library s -> StateT s IO Text) -> Fill s
+fill f = Fill $ \attrs t lib st -> runStateT (f attrs t lib) st
+
+-- | Use state or IO, then fill in some text.
+--
+-- @
+-- -- getTextFromDatabase :: StateT () IO Text
+-- textFill' getTextFromDatabase
+-- @
+textFill' :: StateT s IO Text -> Fill s
+textFill' t = Fill $ \_m _t _l st -> do
+   (t, st') <- runStateT t st
+   return (HE.text t, st')
+
+-- | Use state or IO, then fill in some text.
+--
+-- @
+-- -- getTextFromDatabase :: StateT () IO Text
+-- textFill' getTextFromDatabase
+-- @
+rawTextFill' :: StateT s IO Text -> Fill s
+rawTextFill' t = Fill $ \_m _t _l -> runStateT t
+
+-- | Create substitutions for each element in a list (using IO/state if
+-- needed) and fill the child nodes with those substitutions.
+mapSubs' :: (a -> StateT s IO (Substitutions s)) -> [a] -> Fill s
+mapSubs' f xs = Fill $
+  \_m (pth, tpl) lib st ->
+    foldM
+      (\(text, st) item -> do
+        (s', st' ) <- runStateT (f item) st
+        (t , st'') <- runTemplate tpl pth s' lib st'
+        return (text <> t, st''))
+      ("", st)
+      xs
+
+-- | Use substitutions with State and IO.
+--
+-- @
+-- \<changeTheWorld>\<results \/>\<\/changeTheWorld>
+-- -- doABunchOfStuffAndGetSubstitutions :: StateT () IO (Substitutions ())
+-- ("changeTheWorld", fillChildrenWith' doStuffAndGetSubstitutions)
+-- @
+--
+-- > This template did IO!
+fillChildrenWith' :: StateT s IO (Substitutions s) -> Fill s
+fillChildrenWith' m = maybeFillChildrenWith' (Just <$> m)
+
+-- | Use state and IO and maybe fill in with some substitutions.
+--
+-- @
+-- \<ifLoggedIn>Logged in as \<userName \/>\<\/ifLoggedIn>
+-- ("ifLoggedIn", maybeFillChildrenWith' $ do
+--                  mUser <- getLoggedInUser -- returns (Just "Bonnie Thunders")
+--                  case mUser of
+--                    Just user -> Just $ subs' ("userName", textFill user)
+--                    Nothing   -> Nothing)
+-- @
+--
+-- > Bonnie Thunders
+maybeFillChildrenWith' :: StateT s IO (Maybe (Substitutions s)) -> Fill s
+maybeFillChildrenWith' sMSubs = Fill $ \_s (pth, Template tpl) l st -> do
+  (mSubs, newState) <- runStateT sMSubs st
+  case mSubs of
+    Nothing -> return ("", newState)
+    Just s  -> tpl pth s l newState

src/Web/Larceny/Types.hs

@@ -43,6 +43,9 @@ instance Hashable Blank where
   hashWithSalt s (Blank tn) = s + hash tn
   hashWithSalt s FallbackBlank = s + hash ("FallbackBlank" :: Text)
 
+-- A transitional type
+type StateTsIOText s = IO (Text, s)
+
 -- | A  Fill is how to fill in a Blank.
 --
 -- In most cases, you can use helper functions like `textFill` or
@@ -69,7 +72,8 @@ instance Hashable Blank where
 newtype Fill s = Fill { unFill :: Attributes
                                -> (Path, Template s)
                                -> Library s
-                               -> StateT s IO Text }
+                               -> s
+                               -> StateTsIOText s }
 
 -- | The Blank's attributes, a map from the attribute name to
 -- it's value.
@@ -118,7 +122,8 @@ fallbackSub fill = M.fromList [(FallbackBlank, fill)]
 newtype Template s = Template { runTemplate :: Path
                                             -> Substitutions s
                                             -> Library s
-                                            -> StateT s IO Text }
+                                            -> s
+                                            -> StateTsIOText s }
 
 -- | The path to a template.
 type Path = [Text]

test/Examples.hs

@@ -64,10 +64,10 @@ subst = subs [ ("site-title", textFill "Gotham Girls roster")
 
 modifyInnerText :: (Text -> Text) -> Fill ()
 modifyInnerText f = Fill $
-  \_attrs (_pth, tpl) _l ->
+  \_attrs (_pth, tpl) _l st ->
     liftIO $ do
-      t' <- evalStateT (runTemplate tpl ["default"] mempty mempty) ()
-      return $ f t'
+      (t', st') <- runTemplate tpl ["default"] mempty mempty st
+      return $ (f t', st')
 
 tplLib :: Library ()
 tplLib = M.fromList [(["skater"], parse "Beyonslay")]