BarSnaplet.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ExistentialQuantification #-}

module Snap.Snaplet.Test.Common.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           Data.Map.Syntax                     ((##))
import           Heist
import           Heist.Interpreted
import           Snap.Core
import           Snap.Snaplet
import           Snap.Snaplet.Heist
import           Snap.Snaplet.Test.Common.FooSnaplet
import           Snap.TestCommon                     (handlerConfig, shConfigSplice)

------------------------------------------------------------------------------
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