Permalink
Browse files

Compiled tabs now run their children for splicing

  • Loading branch information...
1 parent 438391c commit 3f9a3b55eeecb04f6a3b983188fcce2db12ae60a @ozataman committed Oct 25, 2013
Showing with 19 additions and 15 deletions.
  1. +1 −1 snap-extras.cabal
  2. +18 −14 src/Snap/Extras/Tabs.hs
View
@@ -1,5 +1,5 @@
Name: snap-extras
-Version: 0.8
+Version: 0.8.1
Synopsis: A collection of useful helpers and utilities for Snap web applications.
Description: This package contains a collection of helper functions
that come in handy in most practical, real-world
View
@@ -21,21 +21,22 @@ module Snap.Extras.Tabs
) where
-------------------------------------------------------------------------------
+import qualified Blaze.ByteString.Builder as B
import Control.Error
import Control.Monad
import Control.Monad.Trans
import Data.Monoid
-import Data.Text (Text)
-import qualified Data.Text as T
-import qualified Data.Text.Encoding as T
+import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
+import Heist
+import qualified Heist.Compiled as C
+import Heist.Interpreted
import Snap.Core
import Snap.Snaplet
import Snap.Snaplet.Heist
-import Heist
-import qualified Heist.Compiled as C
-import Heist.Interpreted
import Text.XmlHtml
-import qualified Text.XmlHtml as X
+import qualified Text.XmlHtml as X
-------------------------------------------------------------------------------
@@ -74,6 +75,7 @@ tabCSplice :: Monad m => RuntimeSplice m Text -> C.Splice m
tabCSplice getCtx = do
(Element _ attrs ch) <- getParamNode
attrsAction <- C.runAttributesRaw attrs
+ nodes <- C.codeGen `fmap` C.runNodeList ch
let ps as context = do
m <- note "tab must specify a 'match' attribute" $ lookup "match" as
url <- note "tabs must specify a 'url' attribute" $ lookup "url" as
@@ -83,16 +85,18 @@ tabCSplice getCtx = do
"Infix" -> Right $ url `T.isInfixOf` context
"None" -> Right $ False
_ -> Left "Unknown match type"
- return (url, ch, m')
+ return (url, m')
return $ C.yieldRuntime $ do
ctx <- getCtx
as <- attrsAction
- let res = case ps as ctx of
- Left e -> error $ "Tab error: " ++ e
- Right (url, c, match) ->
- let attr' = if match then ("class", "active") : as else as
- a = X.Element "a" (("href", url) : as) c
- in X.renderHtmlFragment X.UTF8 [X.Element "li" attr' [a]]
+ ns <- nodes
+ let innerFrag = X.parseHTML "inner" $ B.toByteString ns
+ let res = either (error . ("Tab errror: " ++) ) id $ do
+ (url, match) <- ps as ctx
+ inner <- innerFrag
+ let attr' = if match then ("class", "active") : as else as
+ a = X.Element "a" (("href", url) : as) (X.docContent inner)
+ return $ X.renderHtmlFragment X.UTF8 [X.Element "li" attr' [a]]
return res

0 comments on commit 3f9a3b5

Please sign in to comment.