Skip to content
Newer
Older
100644 135 lines (98 sloc) 4.44 KB
c43c6fb @gregorycollins First checkin
authored Mar 23, 2009
1 {-# LANGUAGE NoMonomorphismRestriction, OverloadedStrings, FlexibleContexts #-}
2
3 -- | This module contains the top-level handler for the website.
4
5 module Homepage.Handlers (topLevelHandler) where
6
c356181 @gregorycollins Cleanup Blaaargh imports, fix 404 template
authored Jul 24, 2009
7 ------------------------------------------------------------------------------
8 import Blaaargh
9 import Control.Monad.Reader
c43c6fb @gregorycollins First checkin
authored Mar 23, 2009
10
c356181 @gregorycollins Cleanup Blaaargh imports, fix 404 template
authored Jul 24, 2009
11 ------------------------------------------------------------------------------
12 import Homepage.Types
13 import Homepage.Util.Delicious as Delicious
7c26b11 @gregorycollins Upgrade to blaaargh!
authored Jun 29, 2009
14
15 setDeliciousTemplate :: BlaaarghHandler -> HomepageMonad BlaaarghHandler
16 setDeliciousTemplate handler = do
17 bookmarks <- Delicious.getRecent
18
19 return $
20 (lift (addExtraTemplateArguments [("recentBookmarks", bookmarks)])
21 >> handler)
22
23
24 topLevelHandler :: HomepageHandler
25 topLevelHandler = do
26 handler <- lift $ setDeliciousTemplate serveBlaaargh
27 bs <- lift $ ask >>= return . homepageBlaaarghState
28
29 liftH $ runBlaaarghHandler bs handler
30
31 {-
c43c6fb @gregorycollins First checkin
authored Mar 23, 2009
32
33 topLevelHandler :: HomepageHandler
34 topLevelHandler =
35 -- gzip currently doesn't work. augh
36 --
37 -- do
38 -- compressedResponseFilter
39 frontpage `mappend`
40 aboutpage `mappend`
ced43db @gregorycollins Add contact page handler
authored Mar 28, 2009
41 contactpage `mappend`
c43c6fb @gregorycollins First checkin
authored Mar 23, 2009
42 (liftH staticfiles) `mappend`
43 temporaryPosts `mappend`
44 fourohfour
45
46
47 frontpage :: HomepageHandler
48 frontpage =
49 exactdir "/" $ do
50 bookmarks <- lift Delicious.getRecent
51 serveTemplate' "." "home" (setAttribute "recentBookmarks" bookmarks .
52 setAttribute "whichCss" ("home" :: String))
53
54 aboutpage :: HomepageHandler
55 aboutpage =
56 exactdir "/about" $ do
57 serveTemplate' "." "about" (setAttribute "whichCss"
733b7af @gregorycollins Add license
authored Mar 28, 2009
58 ("posts" :: String))
c43c6fb @gregorycollins First checkin
authored Mar 23, 2009
59
60
ced43db @gregorycollins Add contact page handler
authored Mar 28, 2009
61 contactpage :: HomepageHandler
62 contactpage =
b75c454 @gregorycollins Boy, I'm dumb today
authored Mar 28, 2009
63 exactdir "/contact" $ do
ced43db @gregorycollins Add contact page handler
authored Mar 28, 2009
64 serveTemplate' "." "contact" (setAttribute "whichCss"
65 ("posts" :: String))
66
67
136624a @gregorycollins Part 2 in the "building a website with haskell" series
authored Mar 29, 2009
68 tempPost1 :: HomepageHandler
69 tempPost1 = prefixdir "/posts/2009/03/28/building-a-website-part-1" $ do
c43c6fb @gregorycollins First checkin
authored Mar 23, 2009
70 postContent <- lift $ (getTemplate "." "temppost1") >>=
71 (return . B.unpack . render)
72
73 let attrs :: [(String,String)]
74 attrs = [ ("websiteTitleExtra",
75 ": Building a website with Haskell, part 1")
76 , ("whichCss", "posts")
77 , ("postContent", postContent)
78 , ("postTitle", "Building a website with Haskell, part 1")
79 , ("postSummary", "Using the <a href=\"\
80 \http://www.happstack.com/\">happstack</a> \
81 \web framework to power a simple personal \
82 \website.")
733b7af @gregorycollins Add license
authored Mar 28, 2009
83 , ("postDate", "march 28, 2009") ]
c43c6fb @gregorycollins First checkin
authored Mar 23, 2009
84
136624a @gregorycollins Part 2 in the "building a website with haskell" series
authored Mar 29, 2009
85 serveTemplate' "." "post" (setManyAttrib attrs)
86
87
88 tempPost2 :: HomepageHandler
89 tempPost2 = prefixdir "/posts/2009/03/30/building-a-website-part-2" $ do
90 postContent <- lift $ (getTemplate "." "temppost2") >>=
91 (return . B.unpack . render)
92
93 let attrs :: [(String,String)]
94 attrs = [ ("websiteTitleExtra",
95 ": Building a website with Haskell, part 2")
96 , ("whichCss", "posts")
97 , ("postContent", postContent)
98 , ("postTitle", "Building a website with Haskell, part 2")
99 , ("postSummary", "In the second part of the series, we \
100 \discuss the design of this <a href=\"\
101 \http://www.happstack.com/\">happstack</a> \
102 \website.")
103 , ("postDate", "march 30, 2009") ]
104
105 serveTemplate' "." "post" (setManyAttrib attrs)
106
107
108
109 temporaryPosts :: HomepageHandler
110 temporaryPosts = tempPost1 `mappend` tempPost2
c43c6fb @gregorycollins First checkin
authored Mar 23, 2009
111
112
689ae54 @gregorycollins Fix broken post page after comment
authored Mar 29, 2009
113 prefixdir :: (Monad m) => String -> ServerPartT m a -> ServerPartT m a
114 prefixdir staticPath sps = do
115 rq <- askRq
116 if staticPath `isPrefixOf` (rqURL rq) then sps else mzero
117
118
c43c6fb @gregorycollins First checkin
authored Mar 23, 2009
119 fourohfour :: HomepageHandler
3be41ee @gregorycollins Render 404 properly
authored Mar 28, 2009
120 fourohfour = serveTemplate' "." "404" (setAttribute "whichCss"
121 ("posts" :: String))
c43c6fb @gregorycollins First checkin
authored Mar 23, 2009
122
123
124 -- N.B. "fileServeStrict" here is like normal "fileServe" from
125 -- happstack 0.2.1, except modified to consume the file strictly
136624a @gregorycollins Part 2 in the "building a website with haskell" series
authored Mar 29, 2009
126 -- (avoiding handle leaks). You'll need the darcs truck version of
127 -- happstack to run this.
c43c6fb @gregorycollins First checkin
authored Mar 23, 2009
128 staticfiles :: WebHandler
129 staticfiles = staticserve "static"
130 where staticserve d = dir d (fileServeStrict [] d)
7c26b11 @gregorycollins Upgrade to blaaargh!
authored Jun 30, 2009
131
132
133
134 -}
Something went wrong with that request. Please try again.