module Snap.Extras.SpliceUtils.Interpreted
( paramSplice
, utilSplices
, selectSplice
, runTextAreas
, scriptsSplice
, ifFlagSplice
, refererSplice
) where
import Control.Monad
import Control.Monad.Trans.Class
import qualified Data.Configurator as C
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Snap
import Snap.Extras.SpliceUtils.Common
import Snap.Snaplet.Heist.Interpreted
import Heist
import Heist.Splices
import Heist.Interpreted
import Text.XmlHtml
utilSplices :: [(Text, SnapletISplice b)]
utilSplices =
[ ("rqparam", paramSplice)
, ("refererLink", refererSplice)
]
refererSplice :: MonadSnap m => Splice m
refererSplice =
textSplice . maybe "/" T.decodeUtf8 =<< lift (getsRequest (getHeader "Referer"))
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 <- getHS
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", ifISplice $ maybe False (== val) defv)
, ("ifNotSelected", ifISplice $ maybe True (/= val) defv) ]
scriptsSplice :: MonadIO m
=> FilePath
-> String
-> m [Node]
scriptsSplice d prefix = do
scripts <- getScripts d
return $ concat $ map includeJavascript scripts
where
includeJavascript script =
[Element "script" [("src", T.pack $ prefix ++ script)] []]
ifFlagSplice :: SnapletISplice b
ifFlagSplice = do
Element _ ats es <- getParamNode
conf <- lift getSnapletUserConfig
case lookup "ref" ats of
Nothing -> return []
Just flag -> do
res <- liftIO $ C.lookup conf flag
case res of
Just True -> return es
_ -> return []