BarSnaplet.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ExistentialQuantification #-}
module Blackbox.BarSnaplet where

import Prelude hiding (lookup)

import Control.Lens
import Control.Monad.State
import qualified Data.ByteString as B
import Data.Configurator
import Data.Maybe
import Snap.Snaplet
import Snap.Snaplet.Heist
import Snap.Core
import Heist
import Heist.Interpreted

import Blackbox.Common
import Blackbox.FooSnaplet

data BarSnaplet b = BarSnaplet
    { _barField :: String
    , fooLens  :: SnapletLens b FooSnaplet
    }

makeLenses ''BarSnaplet

barsplice :: Splices (SnapletISplice b)
barsplice = "barsplice" ## textSplice "contents of the bar splice"

barInit :: HasHeist b
        => Snaplet (Heist b)
        -> SnapletLens b FooSnaplet
        -> SnapletInit b (BarSnaplet b)
barInit h l = makeSnaplet "barsnaplet" "An example snaplet called bar." Nothing $ do
    config <- getSnapletUserConfig
    addTemplates h ""
    rootUrl <- getSnapletRootURL
    _lens <- getLens
    addRoutes [("barconfig", liftIO (lookup config "barSnapletField") >>= writeLBS . fromJust)
              ,("barrooturl", writeBS $ "url" `B.append` rootUrl)
              ,("bazpage2",   renderWithSplices "bazpage" barsplice)
              ,("bazpage3",   heistServeSingle "bazpage")
              ,("bazpage4",   renderAs "text/html" "bazpage")
              ,("bazpage5",   renderWithSplices "bazpage"
                                ("barsplice" ## shConfigSplice _lens))
              ,("bazbadpage", heistServeSingle "cpyga")
              ,("bar/handlerConfig", handlerConfig)
              ]
    return $ BarSnaplet "bar snaplet data string" l