-
Notifications
You must be signed in to change notification settings - Fork 68
/
NestTest.hs
78 lines (63 loc) · 2.24 KB
/
NestTest.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Main where
import Prelude hiding ((.))
import Control.Monad.State
import Data.Lens.Lazy
import Data.Lens.Template
import qualified Data.Text as T
import Snap.Http.Server.Config
import Snap.Core
import Snap.Util.FileServe
import Snap.Snaplet
import Snap.Snaplet.Heist
import Text.Templating.Heist
-- If we universally quantify FooSnaplet to get rid of the type parameter
-- mkLabels throws an error "Can't reify a GADT data constructor"
data FooSnaplet = FooSnaplet
{ _fooHeist :: Snaplet (Heist FooSnaplet)
, _fooVal :: Int
}
makeLenses [''FooSnaplet]
instance HasHeist FooSnaplet where
heistLens = subSnaplet fooHeist
fooInit :: SnapletInit FooSnaplet FooSnaplet
fooInit = makeSnaplet "foosnaplet" "foo snaplet" Nothing $ do
hs <- nestSnaplet "heist" fooHeist $ heistInit "templates"
addTemplates "foo"
rootUrl <- getSnapletRootURL
fooLens <- getLens
addRoutes [("fooRootUrl", writeBS rootUrl)
,("aoeuhtns", renderWithSplices "foo/foopage"
[("asplice", fooSplice fooLens)])
,("", heistServe)
]
return $ FooSnaplet hs 42
--fooSplice :: (Lens (Snaplet b) (Snaplet (FooSnaplet b)))
-- -> SnapletSplice (Handler b b)
fooSplice :: (Lens (Snaplet b) (Snaplet FooSnaplet))
-> SnapletHeist b v Template
fooSplice fooLens = do
val <- liftWith fooLens $ gets _fooVal
liftHeist $ textSplice $ T.pack $ "splice value" ++ (show val)
------------------------------------------------------------------------------
data App = App
{ _foo :: Snaplet (FooSnaplet)
}
makeLenses [''App]
app :: SnapletInit App App
app = makeSnaplet "app" "nested snaplet application" Nothing $ do
fs <- embedSnaplet "foo" foo fooInit
addRoutes [ ("/hello", writeText "hello world")
, ("/public", serveDirectory "public")
]
return $ App fs
main :: IO ()
main = serveSnaplet defaultConfig app