Browse files

Add compiled splices for NavTrails

  • Loading branch information...
1 parent 83864ed commit c66ddad381506b638b2dd5950ea436b8a5f6b4c3 @mightybyte mightybyte committed Jan 31, 2013
Showing with 39 additions and 11 deletions.
  1. +39 −11 src/Snap/Extras/NavTrails.hs
View
50 src/Snap/Extras/NavTrails.hs
@@ -4,10 +4,12 @@
module Snap.Extras.NavTrails where
+import Blaze.ByteString.Builder.ByteString
import Control.Monad.State.Strict
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as B
import Data.Maybe
+import Data.Monoid
import qualified Data.Set as S
import Data.Text (Text)
import qualified Data.Text.Encoding as T
@@ -16,6 +18,7 @@ import Snap.Snaplet
import Snap.Snaplet.Heist
import Snap.Snaplet.Session
import Heist
+import qualified Heist.Compiled as C
import Heist.Interpreted
@@ -28,17 +31,23 @@ data NavTrail b = NavTrail {
-------------------------------------------------------------------------------
-initNavTrail
- :: HasHeist b
- => SnapletLens b SessionManager
- -> Bool
- -- ^ Auto-add all splices?
- -> SnapletInit b (NavTrail b)
-initNavTrail ses addSpl =
+--initNavTrail
+-- :: HasHeist b
+-- => SnapletLens b SessionManager
+-- -> Bool
+-- -- ^ Auto-add all splices?
+-- -> SnapletInit b (NavTrail b)
+initNavTrail :: SnapletLens b SessionManager
+ -- ^ Lens to the session snaplet
+ -> Maybe (Snaplet (Heist b))
+ -- ^ The heist snaplet (not a lens), if you want splices to be
+ -- added automatically.
+ -> SnapletInit b (NavTrail b)
+initNavTrail ses heist =
makeSnaplet "NavTrail"
"Makes it easier for you to navigate back to key app points."
Nothing $ do
- when addSpl $ addNavTrailSplices
+ maybe (return ()) addNavTrailSplices heist
return $ NavTrail ses
@@ -89,21 +98,40 @@ redirFocus def = do
-------------------------------------------------------------------------------
-- |
+backSplice :: MonadSnap m => HeistT m m Template
backSplice = do
f <- rqURI `fmap` getRequest
textSplice $ T.decodeUtf8 f
+backCSplice :: C.Splice (Handler b v)
+backCSplice = return $ C.yieldRuntime $ do
+ lift $ (fromByteString . rqURI) `fmap` getRequest
-------------------------------------------------------------------------------
-- |
+focusSplice :: SnapletLens (Snaplet v) (NavTrail b)
+ -> Splice (Handler b v)
focusSplice lens = do
uri <- lift $ with' lens getFocus
maybe (return []) textSplice uri
+focusCSplice :: SnapletLens (Snaplet v) (NavTrail b)
+ -> C.Splice (Handler b v)
+focusCSplice lens = return $ C.yieldRuntimeText $ do
+ uri <- lift $ with' lens getFocus
+ return $ fromMaybe "" uri
-------------------------------------------------------------------------------
-- |
-addNavTrailSplices = do
+addNavTrailSplices heist = do
lens <- getLens
- addSplices [ ("linkToFocus", focusSplice lens)
- , ("linkToBack", backSplice) ]
+ addConfig heist $
+ mempty { hcCompiledSplices =
+ [ ("linkToFocus", focusCSplice lens)
+ , ("linkToBack", backCSplice) ]
+ , hcInterpretedSplices =
+ [ ("linkToFocus", focusSplice lens)
+ , ("linkToBack", backSplice) ]
+ }
+
+

0 comments on commit c66ddad

Please sign in to comment.