module Snap.Extras.SpliceUtils
( ifSplice
, paramSplice
, utilSplices
, addUtilSplices
, selectSplice
, runTextAreas
) where
import Control.Monad
import Control.Monad.Trans.Class
import Data.Text (Text)
import qualified Data.Text.Encoding as T
import Snap.Core
import Snap.Snaplet
import Snap.Snaplet.Heist
import Text.Templating.Heist
import Text.XmlHtml
addUtilSplices :: HasHeist b => Initializer b v ()
addUtilSplices = addSplices utilSplices
utilSplices :: [(Text, SnapletSplice b v)]
utilSplices =
[("rqparam", liftHeist paramSplice)]
ifSplice :: Monad m => Bool -> Splice m
ifSplice cond =
case cond of
False -> return []
True -> runChildren
paramSplice :: MonadSnap m => Splice m
paramSplice = do
at <- liftM (getAttribute "name") getParamNode
val <- case at of
Just at' -> lift . getParam $ T.encodeUtf8 at'
Nothing -> return Nothing
return $ maybe [] ((:[]) . TextNode . T.decodeUtf8) val
runTextAreas :: Monad m => HeistState m -> HeistState m
runTextAreas = bindSplices [ ("textarea", ta)]
where
ta = do
hs <- getTS
n@(Element t ats _) <- getParamNode
let nm = nodeText n
case lookupSplice nm hs of
Just spl -> do
ns <- spl
return [Element t ats ns]
Nothing -> return $ [Element t ats []]
selectSplice
:: Monad m
=> Text
-> Text
-> [(Text, Text)]
-> Maybe Text
-> Splice m
selectSplice nm fid xs defv =
callTemplate "_select"
[("options", opts), ("name", textSplice nm), ("id", textSplice fid)]
where
opts = mapSplices gen xs
gen (val,txt) = runChildrenWith
[ ("val", textSplice val)
, ("text", textSplice txt)
, ("ifSelected", ifSplice $ maybe False (== val) defv)
, ("ifNotSelected", ifSplice $ maybe True (/= val) defv) ]