Use plain old functions instead of StateT

Author: emhoracek

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

@@ -1,28 +1,34 @@
 {-# LANGUAGE OverloadedStrings #-}
 
-module Web.Larceny.Fills ( textFill
-                         , textFill'
-                         , rawTextFill
-                         , rawTextFill'
-                         , mapSubs
-                         , mapSubs'
-                         , fillChildren
-                         , fillChildrenWith
-                         , fillChildrenWith'
-                         , maybeFillChildrenWith
-                         , maybeFillChildrenWith'
-                         , ifFill
-                         , useAttrs
-                         , a
-                         , (%)) where
+module Web.Larceny.Fills
+  ( textFill
+  , textFill'
+  , rawTextFill
+  , rawTextFill'
+  , mapSubs
+  , mapSubs'
+  , fillChildren
+  , fillChildrenWith
+  , fillChildrenWith'
+  , maybeFillChildrenWith
+  , maybeFillChildrenWith'
+  , ifFill
+  , useAttrs
+  , a
+  , (%)
+  )
+where
 
 import           Control.Exception
-import           Control.Monad.State (StateT)
-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           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
 
@@ -64,18 +70,20 @@ import           Web.Larceny.Types
 -- @
 -- > This list is not empty.
 ifFill :: Fill s
-ifFill =
-  useAttrs (a "condition" % a "exists") ifFill'
-  where ifFill' :: Maybe Bool -> Maybe Text -> Fill s
-        ifFill' mCondition mExisting =
-          let condition = fromMaybe True mCondition
-              existing = fromMaybe "exist" mExisting
-              bool = condition && existing /= ""
-              thenElseSubs = subs [("then", thenFill bool)
-                                  ,("else", thenFill (not bool))] in
-          fillChildrenWith thenElseSubs
-        thenFill True = fillChildren
-        thenFill False = textFill ""
+ifFill = useAttrs (a "condition" % a "exists") ifFill'
+ where
+  ifFill' :: Maybe Bool -> Maybe Text -> Fill s
+  ifFill' mCondition mExisting =
+    let
+      condition = fromMaybe True mCondition
+      existing  = fromMaybe "exist" mExisting
+      bool      = condition && existing /= ""
+      thenElseSubs =
+        subs [("then", thenFill bool), ("else", thenFill (not bool))]
+    in
+      fillChildrenWith thenElseSubs
+  thenFill True  = fillChildren
+  thenFill False = textFill ""
 
 -- | A plain text fill.
 --
@@ -100,7 +108,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 +119,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 st -> runStateT t st
 
 -- | Create substitutions for each element in a list and fill the child nodes
 -- with those substitutions.
@@ -121,20 +131,26 @@ rawTextFill' t = Fill $ \_m _t _l -> t
 -- @
 --
 -- > Bonnie Thunders Donna Matrix Beyonslay
-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 :: (a -> Substitutions s) -> [a] -> Fill s
+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
+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
 
 -- | Fill in the child nodes of the blank with substitutions already
 -- available.
@@ -182,8 +198,8 @@ fillChildrenWith' m = maybeFillChildrenWith' (Just <$> m)
 -- > Bonnie Thunders
 maybeFillChildrenWith :: Maybe (Substitutions s) -> Fill s
 maybeFillChildrenWith Nothing = textFill ""
-maybeFillChildrenWith (Just s) = Fill $ \_s (pth, Template tpl) l ->
-  tpl pth s l
+maybeFillChildrenWith (Just s) =
+  Fill $ \_a (pth, Template tpl) l st -> tpl pth s l st
 
 -- | Use state and IO and maybe fill in with some substitutions.
 --
@@ -198,11 +214,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 s -> do
+  (mSubs, s') <- runStateT sMSubs s
   case mSubs of
-    Nothing -> return ""
-    Just s  -> tpl pth s l
+    Nothing -> return ("", s)
+    Just s  -> tpl pth s l s'
 
 -- | Use attributes from the the blank as arguments to the fill.
 --
@@ -220,11 +236,9 @@ maybeFillChildrenWith' sMSubs = Fill $ \_s (pth, Template tpl) l -> do
 -- attributes that you can use in Fills. You can use `a` and `%` to
 -- create these. The second argument is a function that uses the
 -- values of those attributes to create a Fill.
-useAttrs :: (Attributes -> k -> Fill s)
-         ->  k
-         ->  Fill s
-useAttrs k fill= Fill $ \atrs (pth, tpl) lib ->
-  unFill (k atrs fill) atrs (pth, tpl) lib
+useAttrs :: (Attributes -> k -> Fill s) -> k -> Fill s
+useAttrs k fill =
+  Fill $ \atrs (pth, tpl) lib s -> unFill (k atrs fill) atrs (pth, tpl) lib s
 
 -- | Prepend `a` to the name of an attribute to pass the value of that
 -- attribute to the fill.
@@ -234,8 +248,8 @@ useAttrs k fill= Fill $ \atrs (pth, tpl) lib ->
 -- is rendered.
 a :: (FromAttribute a) => Text -> Attributes -> (a -> b) -> b
 a attrName attrs k =
-  let mAttr = M.lookup attrName attrs in
-  k (either (\e -> throw $ e attrName) id (fromAttribute mAttr))
+  let mAttr = M.lookup attrName attrs
+  in  k (either (\e -> throw $ e attrName) id (fromAttribute mAttr))
 
 -- | Use with `a` to use multiple attributes in the fill.
 --
@@ -250,7 +264,5 @@ a attrName attrs k =
 -- @
 --
 -- > A really l...
-(%) :: (Attributes -> a -> b)
-    -> (Attributes -> b -> c)
-    ->  Attributes -> a -> c
+(%) :: (Attributes -> a -> b) -> (Attributes -> b -> c) -> Attributes -> a -> c
 (%) f1 f2 attrs k = f2 attrs (f1 attrs k)