Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

yesod 1.1

  • Loading branch information...
commit 85e0fde05163193e99c4f704ba50cdeabcb56083 1 parent 6f528af
Michael Snoyman authored July 08, 2012

Showing 248 changed files with 13,248 additions and 496 deletions. Show diff stats Hide diff stats

  1. 98  Application.hs
  2. 244  Foundation.hs
  3. 9  Handler/Admin.hs
  4. 4  Handler/Bling.hs
  5. 4  Handler/Email.hs
  6. 5  Handler/Faq.hs
  7. 15  Handler/Job.hs
  8. 10  Handler/News.hs
  9. 2  Handler/Package.hs
  10. 2  Handler/Poll.hs
  11. 8  Handler/Profile.hs
  12. 9  Handler/Root.hs
  13. 8  Handler/Skills.hs
  14. 24  Handler/Team.hs
  15. 8  Handler/Topic.hs
  16. 15  Handler/User.hs
  17. 34  Import.hs
  18. 2  LICENSE
  19. 24  Model.hs
  20. 170  Settings.hs
  21. 14  Settings/Development.hs
  22. 18  Settings/StaticFiles.hs
  23. BIN  config/favicon.ico
  24. 4  config/keter.yaml
  25. 116  config/models
  26. 24  config/postgresql.yml
  27. 1  config/robots.txt
  28. 91  config/routes
  29. 19  config/settings.yml
  30. 203  haskellers.cabal
  31. 35  main.hs
  32. BIN  static/img/glyphicons-halflings-white.png
  33. BIN  static/img/glyphicons-halflings.png
  34. 0  {cassius → templates}/admin-controls.cassius
  35. 0  {hamlet → templates}/admin-controls.hamlet
  36. 0  {cassius → templates}/admin-users.cassius
  37. 0  {hamlet → templates}/admin-users.hamlet
  38. 0  {julius → templates}/admin-users.julius
  39. 0  {julius → templates}/analytics.julius
  40. 0  {cassius → templates}/bling.cassius
  41. 0  {hamlet → templates}/bling.hamlet
  42. 48  templates/default-layout-wrapper.hamlet
  43. 0  {cassius → templates}/default-layout.cassius
  44. 0  {hamlet → templates}/default-layout.hamlet
  45. 0  {julius → templates}/default-layout.julius
  46. 0  {cassius → templates}/faq.cassius
  47. 0  {hamlet → templates}/faq.hamlet
  48. 0  {cassius → templates}/flag.cassius
  49. 0  {hamlet → templates}/flag.hamlet
  50. 0  {cassius → templates}/homepage.cassius
  51. 0  {hamlet → templates}/homepage.hamlet
  52. 0  {julius → templates}/homepage.julius
  53. 0  {cassius → templates}/job.cassius
  54. 0  {hamlet → templates}/job.hamlet
  55. 0  {cassius → templates}/jobs.cassius
  56. 0  {hamlet → templates}/jobs.hamlet
  57. 0  {cassius → templates}/login-status.cassius
  58. 0  {hamlet → templates}/login-status.hamlet
  59. 0  {hamlet → templates}/login.hamlet
  60. 0  {cassius → templates}/messages.cassius
  61. 0  {hamlet → templates}/messages.hamlet
  62. 0  {hamlet → templates}/navbar-section.hamlet
  63. 0  {cassius → templates}/news-admin.cassius
  64. 0  {hamlet → templates}/news-item.hamlet
  65. 0  {cassius → templates}/news.cassius
  66. 0  {hamlet → templates}/news.hamlet
  67. 439  templates/normalize.lucius
  68. 0  {hamlet → templates}/poll.hamlet
  69. 0  {lucius → templates}/poll.lucius
  70. 0  {hamlet → templates}/polls.hamlet
  71. 0  {cassius → templates}/profile.cassius
  72. 0  {hamlet → templates}/profile.hamlet
  73. 0  {julius → templates}/profile.julius
  74. 0  {hamlet → templates}/skill.hamlet
  75. 0  {cassius → templates}/skills.cassius
  76. 0  {hamlet → templates}/skills.hamlet
  77. 0  {hamlet → templates}/team-form.hamlet
  78. 0  {cassius → templates}/team.cassius
  79. 0  {hamlet → templates}/team.hamlet
  80. 0  {hamlet → templates}/teams-form.hamlet
  81. 0  {cassius → templates}/teams.cassius
  82. 0  {hamlet → templates}/teams.hamlet
  83. 0  {cassius → templates}/topic.cassius
  84. 0  {hamlet → templates}/topic.hamlet
  85. 0  {cassius → templates}/topics.cassius
  86. 0  {hamlet → templates}/topics.hamlet
  87. 0  {cassius → templates}/user.cassius
  88. 0  {hamlet → templates}/user.hamlet
  89. 0  {julius → templates}/user.julius
  90. 0  {cassius → templates}/users.cassius
  91. 0  {hamlet → templates}/users.hamlet
  92. 135  tests/Application.hs
  93. 592  tests/Foundation.hs
  94. 90  tests/Handler/Admin.hs
  95. 12  tests/Handler/Bling.hs
  96. 95  tests/Handler/Email.hs
  97. 46  tests/Handler/Faq.hs
  98. 106  tests/Handler/Job.hs
  99. 91  tests/Handler/News.hs
  100. 30  tests/Handler/Package.hs
  101. 120  tests/Handler/Poll.hs
  102. 311  tests/Handler/Profile.hs
  103. 230  tests/Handler/Root.hs
  104. 81  tests/Handler/Skills.hs
  105. 320  tests/Handler/Team.hs
  106. 167  tests/Handler/Topic.hs
  107. 172  tests/Handler/User.hs
  108. 24  tests/HomeTest.hs
  109. 34  tests/Import.hs
  110. 25  tests/LICENSE
  111. 51  tests/Model.hs
  112. 89  tests/Settings.hs
  113. 14  tests/Settings/Development.hs
  114. 18  tests/Settings/StaticFiles.hs
  115. BIN  tests/config/favicon.ico
  116. 4  tests/config/keter.yaml
  117. 116  tests/config/models
  118. 24  tests/config/postgresql.yml
  119. 1  tests/config/robots.txt
  120. 91  tests/config/routes
  121. 19  tests/config/settings.yml
  122. 97  tests/deploy/Procfile
  123. 26  tests/devel.hs
  124. 135  tests/haskellers.cabal
  125. 8  tests/main.hs
  126. 26  tests/messages/en.msg
  127. 2  tests/messages/he.msg
  128. 21  tests/messages/ja.msg
  129. 26  tests/messages/ru.msg
  130. 26  tests/messages/ua.msg
  131. BIN  tests/static/background.png
  132. BIN  tests/static/badge.png
  133. BIN  tests/static/bling/monads-in-disguise.png
  134. BIN  tests/static/browserid.png
  135. BIN  tests/static/buttons.png
  136. 3,990  tests/static/css/bootstrap.css
  137. BIN  tests/static/facebook.gif
  138. BIN  tests/static/google.gif
  139. BIN  tests/static/hslogo_16.png
  140. BIN  tests/static/images/ui-bg_diagonals-thick_65_a6a6a6_40x40.png
  141. BIN  tests/static/images/ui-bg_diagonals-thick_75_f3d8d8_40x40.png
  142. BIN  tests/static/images/ui-bg_dots-small_65_a6a6a6_2x2.png
  143. BIN  tests/static/images/ui-bg_flat_0_333333_40x100.png
  144. BIN  tests/static/images/ui-bg_flat_0_aaaaaa_40x100.png
  145. BIN  tests/static/images/ui-bg_flat_100_506982_40x100.png
  146. BIN  tests/static/images/ui-bg_flat_100_e5eef9_40x100.png
  147. BIN  tests/static/images/ui-bg_flat_100_fafafa_40x100.png
  148. BIN  tests/static/images/ui-bg_flat_10_333333_40x100.png
  149. BIN  tests/static/images/ui-bg_flat_15_2a2d38_40x100.png
  150. BIN  tests/static/images/ui-bg_flat_50_e5eef9_40x100.png
  151. BIN  tests/static/images/ui-bg_flat_65_506982_40x100.png
  152. BIN  tests/static/images/ui-bg_flat_75_506982_40x100.png
  153. BIN  tests/static/images/ui-bg_flat_75_ffffff_40x100.png
  154. BIN  tests/static/images/ui-bg_glass_55_fbf8ee_1x400.png
  155. BIN  tests/static/images/ui-bg_glass_55_fbf9ee_1x400.png
  156. BIN  tests/static/images/ui-bg_glass_65_ffffff_1x400.png
  157. BIN  tests/static/images/ui-bg_glass_75_dadada_1x400.png
  158. BIN  tests/static/images/ui-bg_glass_75_e6e6e6_1x400.png
  159. BIN  tests/static/images/ui-bg_glass_95_fef1ec_1x400.png
  160. BIN  tests/static/images/ui-bg_glow-ball_60_506982_600x600.png
  161. BIN  tests/static/images/ui-bg_highlight-soft_75_cccccc_1x100.png
  162. BIN  tests/static/images/ui-icons_004276_256x240.png
  163. BIN  tests/static/images/ui-icons_222222_256x240.png
  164. BIN  tests/static/images/ui-icons_2a2d38_256x240.png
  165. BIN  tests/static/images/ui-icons_2e83ff_256x240.png
  166. BIN  tests/static/images/ui-icons_454545_256x240.png
  167. BIN  tests/static/images/ui-icons_4b5057_256x240.png
  168. BIN  tests/static/images/ui-icons_888888_256x240.png
  169. BIN  tests/static/images/ui-icons_cc0000_256x240.png
  170. BIN  tests/static/images/ui-icons_cd0a0a_256x240.png
  171. BIN  tests/static/images/ui-icons_dbedff_256x240.png
  172. BIN  tests/static/images/ui-icons_fafafa_256x240.png
  173. BIN  tests/static/images/ui-icons_ffffff_256x240.png
  174. BIN  tests/static/img/glyphicons-halflings-white.png
  175. BIN  tests/static/img/glyphicons-halflings.png
  176. 96  tests/static/jquery-cookie.js
  177. 572  tests/static/jquery-ui.css
  178. BIN  tests/static/logo.png
  179. BIN  tests/static/openid-icon-small.gif
  180. BIN  tests/static/openid.gif
  181. 53  tests/static/reset.css
  182. 385  tests/static/tmp/1FeJJ045.css
  183. 1  tests/static/tmp/1tiBEplC.js
  184. 465  tests/static/tmp/4v_LoG7D.css
  185. 2  tests/static/tmp/GdF0ULLk.js
  186. 1  tests/static/tmp/Vr2Vi3z6.js
  187. 370  tests/static/tmp/YqZ5RxCQ.css
  188. 463  tests/static/tmp/myAOxsSB.css
  189. BIN  tests/static/yahoo.gif
  190. 4  tests/templates/admin-controls.cassius
  191. 25  tests/templates/admin-controls.hamlet
  192. 7  tests/templates/admin-users.cassius
  193. 26  tests/templates/admin-users.hamlet
  194. 3  tests/templates/admin-users.julius
  195. 10  tests/templates/analytics.julius
  196. 6  tests/templates/bling.cassius
  197. 13  tests/templates/bling.hamlet
  198. 48  tests/templates/default-layout-wrapper.hamlet
  199. 289  tests/templates/default-layout.cassius
  200. 87  tests/templates/default-layout.hamlet
  201. 27  tests/templates/default-layout.julius
  202. 28  tests/templates/faq.cassius
  203. 9  tests/templates/faq.hamlet
  204. 3  tests/templates/flag.cassius
  205. 14  tests/templates/flag.hamlet
  206. 6  tests/templates/homepage.cassius
  207. 25  tests/templates/homepage.hamlet
  208. 23  tests/templates/homepage.julius
  209. 20  tests/templates/job.cassius
  210. 37  tests/templates/job.hamlet
  211. 15  tests/templates/jobs.cassius
  212. 37  tests/templates/jobs.hamlet
  213. 9  tests/templates/login-status.cassius
  214. 13  tests/templates/login-status.hamlet
  215. 17  tests/templates/login.hamlet
  216. 4  tests/templates/messages.cassius
  217. 25  tests/templates/messages.hamlet
  218. 6  tests/templates/navbar-section.hamlet
  219. 18  tests/templates/news-admin.cassius
  220. 12  tests/templates/news-item.hamlet
  221. 5  tests/templates/news.cassius
  222. 15  tests/templates/news.hamlet
  223. 439  tests/templates/normalize.lucius
  224. 40  tests/templates/poll.hamlet
  225. 4  tests/templates/poll.lucius
  226. 19  tests/templates/polls.hamlet
  227. 69  tests/templates/profile.cassius
  228. 180  tests/templates/profile.hamlet
  229. 42  tests/templates/profile.julius
  230. 4  tests/templates/skill.hamlet
  231. 7  tests/templates/skills.cassius
  232. 27  tests/templates/skills.hamlet
  233. 6  tests/templates/team-form.hamlet
  234. 5  tests/templates/team.cassius
  235. 111  tests/templates/team.hamlet
  236. 6  tests/templates/teams-form.hamlet
  237. 3  tests/templates/teams.cassius
  238. 14  tests/templates/teams.hamlet
  239. 25  tests/templates/topic.cassius
  240. 38  tests/templates/topic.hamlet
  241. 0  tests/templates/topics.cassius
  242. 28  tests/templates/topics.hamlet
  243. 47  tests/templates/user.cassius
  244. 69  tests/templates/user.hamlet
  245. 7  tests/templates/user.julius
  246. 55  tests/templates/users.cassius
  247. 28  tests/templates/users.hamlet
  248. 5  upload.sh
98  Application.hs
... ...
@@ -1,31 +1,29 @@
1  
-{-# LANGUAGE TemplateHaskell #-}
2  
-{-# LANGUAGE MultiParamTypeClasses #-}
3  
-{-# LANGUAGE OverloadedStrings #-}
4  
-{-# LANGUAGE CPP #-}
5  
-{-# LANGUAGE TypeFamilies #-}
6 1
 {-# OPTIONS_GHC -fno-warn-orphans #-}
7 2
 module Application
8  
-    ( getApplication
  3
+    ( makeApplication
9 4
     , getApplicationDev
  5
+    , makeFoundation
10 6
     ) where
11 7
 
12  
-import Foundation hiding (approot)
  8
+import Import
13 9
 import Settings
14  
-import Yesod.Static
15 10
 import Yesod.Auth
16  
-import Database.Persist.GenericSql
  11
+import Yesod.Default.Config
  12
+import Yesod.Default.Main
  13
+import Yesod.Default.Handlers
  14
+import Network.Wai.Middleware.RequestLogger (logStdout, logStdoutDev)
  15
+import qualified Database.Persist.Store
  16
+import Database.Persist.GenericSql (runMigration)
  17
+import Network.HTTP.Conduit (newManager, def)
17 18
 import Data.IORef
18  
-import Data.Text (Text)
19  
-#if PRODUCTION
20  
-import Control.Concurrent (forkIO, threadDelay)
21  
-import Control.Monad (forever)
22  
-#endif
23  
-import Data.Maybe (catMaybes)
  19
+import Control.Monad
  20
+import Control.Concurrent
  21
+import Database.Persist.GenericSql
  22
+import Data.Maybe
24 23
 import qualified Data.Set as Set
25  
-import Data.ByteString (ByteString)
26  
-import Network.HTTP.Conduit (newManager, def)
27 24
 
28 25
 -- Import all relevant handler modules here.
  26
+-- Don't forget to add new modules to your cabal file!
29 27
 import Handler.Root
30 28
 import Handler.Profile
31 29
 import Handler.User
@@ -42,46 +40,56 @@ import Handler.Bling
42 40
 import Handler.Poll
43 41
 
44 42
 -- This line actually creates our YesodSite instance. It is the second half
45  
--- of the call to mkYesodData which occurs in Haskellers.hs. Please see
  43
+-- of the call to mkYesodData which occurs in Foundation.hs. Please see
46 44
 -- the comments there for more details.
47  
-mkYesodDispatch "Haskellers" resourcesHaskellers
48  
-
49  
--- Some default handlers that ship with the Yesod site template. You will
50  
--- very rarely need to modify this.
51  
-getFaviconR :: Handler ()
52  
-getFaviconR = sendFile "image/x-icon" "favicon.ico"
53  
-
54  
-getRobotsR :: Handler RepPlain
55  
-getRobotsR = return $ RepPlain $ toContent ("User-agent: *" :: ByteString)
  45
+mkYesodDispatch "App" resourcesApp
56 46
 
57 47
 -- This function allocates resources (such as a database connection pool),
58 48
 -- performs initialization and creates a WAI application. This is also the
59 49
 -- place to put your migrate statements to have automatic database
60 50
 -- migrations handled by Yesod.
61  
-getApplication :: Text -> IO Application
62  
-getApplication approot = do
63  
-    p <- Settings.createConnectionPool
  51
+makeApplication :: AppConfig DefaultEnv Extra -> IO Application
  52
+makeApplication conf = do
  53
+    foundation <- makeFoundation conf
  54
+    app <- toWaiAppPlain foundation
  55
+    return $ logWare app
  56
+  where
  57
+    logWare   = if development then logStdoutDev
  58
+                               else logStdout
  59
+
  60
+makeFoundation :: AppConfig DefaultEnv Extra -> IO App
  61
+makeFoundation conf = do
64 62
     manager <- newManager def
65  
-    flip runConnectionPool p $ runMigration migrateAll
  63
+    s <- staticSite
  64
+    dbconf <- withYamlEnvironment "config/postgresql.yml" (appEnv conf)
  65
+              Database.Persist.Store.loadConfig >>=
  66
+              Database.Persist.Store.applyEnv
  67
+    p <- Database.Persist.Store.createPoolConfig (dbconf :: Settings.PersistConfig)
  68
+    Database.Persist.Store.runPool dbconf (runMigration migrateAll) p
  69
+
66 70
     hprofs <- newIORef ([], 0)
67 71
     pprofs <- newIORef []
68  
-#if PRODUCTION
69  
-    _ <- forkIO $ forever $ fillProfs p hprofs pprofs
70  
-                         >> threadDelay (1000 * 1000 * 60 * 5)
71  
-#else
72  
-    fillProfs p hprofs pprofs
73  
-#endif
74  
-    s' <- s
75  
-    let h = Haskellers s' p hprofs pprofs approot manager
76  
-    toWaiApp h
77  
-  where
78  
-    s = static Settings.staticdir
  72
+    if production
  73
+        then do
  74
+            _ <- forkIO $ forever $ do
  75
+                _ <- fillProfs p hprofs pprofs
  76
+                threadDelay (1000 * 1000 * 60 * 5)
  77
+            return ()
  78
+        else fillProfs p hprofs pprofs
  79
+
  80
+    return $ App conf s p manager dbconf hprofs pprofs
79 81
 
  82
+-- for yesod devel
80 83
 getApplicationDev :: IO (Int, Application)
81  
-getApplicationDev = ((,) 3000) `fmap` getApplication "http://localhost:3000"
  84
+getApplicationDev =
  85
+    defaultDevelApp loader makeApplication
  86
+  where
  87
+    loader = loadConfig (configSettings Development)
  88
+        { csParseExtra = parseExtra
  89
+        }
82 90
 
83 91
 getHomepageProfs :: ConnectionPool -> IO [Profile]
84  
-getHomepageProfs pool = flip runConnectionPool pool $ do
  92
+getHomepageProfs pool = flip runSqlPool pool $ do
85 93
     users <-
86 94
         selectList [ UserVerifiedEmail ==. True
87 95
                    , UserVisible ==. True
@@ -92,7 +100,7 @@ getHomepageProfs pool = flip runConnectionPool pool $ do
92 100
     fmap catMaybes $ mapM userToProfile users
93 101
 
94 102
 getPublicProfs :: ConnectionPool -> IO [Profile]
95  
-getPublicProfs pool = flip runConnectionPool pool $ do
  103
+getPublicProfs pool = flip runSqlPool pool $ do
96 104
     users <-
97 105
         selectList [ UserVerifiedEmail ==. True
98 106
                    , UserVisible ==. True
244  Foundation.hs
... ...
@@ -1,20 +1,15 @@
1  
-{-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies, MultiParamTypeClasses #-}
2  
-{-# LANGUAGE FlexibleInstances #-}
3  
-{-# LANGUAGE CPP #-}
4  
-{-# LANGUAGE OverloadedStrings #-}
5 1
 module Foundation
6  
-    ( Haskellers (..)
7  
-    , HaskellersMessage (..)
  2
+    ( App (..)
8 3
     , Route (..)
9  
-    , resourcesHaskellers
  4
+    , AppMessage (..)
  5
+    , resourcesApp
10 6
     , Handler
11 7
     , Widget
  8
+    , Form
12 9
     , maybeAuth
13 10
     , requireAuth
14 11
     , maybeAuth'
15  
-    , maybeAuthId
16 12
     , requireAuth'
17  
-    , module Yesod
18 13
     , module Settings
19 14
     , module Model
20 15
     , login
@@ -28,62 +23,59 @@ module Foundation
28 23
     , userFullName
29 24
     ) where
30 25
 
31  
-#define debugRunDB debugRunDBInner __FILE__ __LINE__
32  
-
33  
-import Yesod hiding (Route)
  26
+import Prelude
  27
+import Yesod
34 28
 import Yesod.Static
35 29
 import Yesod.Auth
  30
+import Yesod.Auth.BrowserId
  31
+import Yesod.Auth.GoogleEmail hiding (forwardUrl)
36 32
 import Yesod.Auth.OpenId
37 33
 import Yesod.Auth.Facebook
38  
-import Yesod.Message
  34
+import Facebook (Credentials (Credentials))
  35
+import Yesod.Default.Config
  36
+import Yesod.Default.Util (addStaticContentExternal)
  37
+import Network.HTTP.Conduit (Manager)
  38
+import Control.Monad (unless)
39 39
 import Data.Char (isSpace)
40 40
 import qualified Settings
41  
-import System.Directory
42  
-import qualified Data.ByteString.Lazy as L
  41
+import qualified Database.Persist.Store
  42
+import Settings.StaticFiles
43 43
 import Database.Persist.GenericSql
44  
-import Settings (hamletFile, cassiusFile, juliusFile, widgetFile, hostname)
  44
+import Settings (widgetFile, Extra (..))
45 45
 import Model hiding (userFullName)
46  
-import qualified Model
47  
-import StaticFiles (logo_png, jquery_ui_css, google_gif, yahoo_gif,
48  
-                    facebook_gif, background_png, browserid_png,
49  
-                    buttons_png, reset_css, hslogo_16_png)
50  
-import Yesod.Form.Jquery
51  
-import Yesod.Form.Nic
52  
-import Data.IORef (IORef)
53  
-import qualified Data.Set as Set
54  
-
55  
-import Control.Concurrent.STM
56  
-import System.IO.Unsafe
57  
-import qualified Data.Map as Map
58  
-
59  
-import Data.Time
60  
-import System.Locale
61  
-import Text.Jasmine
62  
-import Control.Monad (unless)
63  
-import Data.Text (Text, pack, unpack)
64  
-import qualified Data.Text as T
  46
+import qualified Model (userFullName)
  47
+import Text.Jasmine (minifym)
  48
+import Web.ClientSession (getKey)
  49
+import Text.Hamlet
65 50
 import Blaze.ByteString.Builder.Char.Utf8 (fromText)
66 51
 import Data.Monoid (mappend)
67 52
 import Network.HTTP.Types (encodePath, queryTextToQuery)
68  
-import Text.Hamlet (HtmlUrlI18n, ihamletFile)
  53
+import Data.Text (Text)
  54
+import qualified Data.Text as T
69 55
 import qualified Data.Text.Read
70 56
 import Data.Maybe (fromJust)
71  
-import Web.Authenticate.BrowserId (checkAssertion)
72  
-import Network.HTTP.Conduit (Manager)
73  
-import Data.Conduit (runResourceT)
74  
-import Facebook (Credentials (..))
  57
+import Data.Time
  58
+import qualified Data.Set as Set
  59
+import System.Locale
  60
+import Yesod.Form.Jquery
  61
+import Yesod.Form.Nic
  62
+import Control.Concurrent.STM
  63
+import qualified Data.Map as Map
  64
+import System.IO.Unsafe
  65
+import Data.IORef (IORef)
75 66
 
76 67
 -- | The site argument for your application. This can be a good place to
77 68
 -- keep settings and values requiring initialization before your application
78 69
 -- starts running, such as database connections. Every handler will have
79 70
 -- access to the data present here.
80  
-data Haskellers = Haskellers
81  
-    { getStatic :: Static -- ^ Settings for static file serving.
82  
-    , connPool :: Settings.ConnectionPool -- ^ Database connection pool.
  71
+data App = App
  72
+    { settings :: AppConfig DefaultEnv Extra
  73
+    , getStatic :: Static -- ^ Settings for static file serving.
  74
+    , connPool :: Database.Persist.Store.PersistConfigPool Settings.PersistConfig -- ^ Database connection pool.
  75
+    , httpManager :: Manager
  76
+    , persistConfig :: Settings.PersistConfig
83 77
     , homepageProfiles :: IORef ([Profile], Int)
84 78
     , publicProfiles :: IORef [Profile]
85  
-    , theApproot :: Text
86  
-    , httpManager :: Manager
87 79
     }
88 80
 
89 81
 data Profile = Profile
@@ -99,30 +91,33 @@ data Profile = Profile
99 91
 prettyTime :: UTCTime -> String
100 92
 prettyTime = formatTime defaultTimeLocale "%B %e, %Y %r"
101 93
 
102  
-mkMessage "Haskellers" "messages" "en"
  94
+-- Set up i18n messages. See the message folder.
  95
+mkMessage "App" "messages" "en"
103 96
 
104 97
 -- This is where we define all of the routes in our application. For a full
105 98
 -- explanation of the syntax, please see:
106  
--- http://docs.yesodweb.com/book/web-routes-quasi/
  99
+-- http://www.yesodweb.com/book/handler
107 100
 --
108 101
 -- This function does three things:
109 102
 --
110  
--- * Creates the route datatype Route Haskellers. Every valid URL in your
  103
+-- * Creates the route datatype AppRoute. Every valid URL in your
111 104
 --   application can be represented as a value of this type.
112 105
 -- * Creates the associated type:
113  
---       type instance Route Haskellers = Route Haskellers
114  
--- * Creates the value resourcesHaskellers which contains information on the
115  
---   resources declared below. This is used in Controller.hs by the call to
  106
+--       type instance Route App = AppRoute
  107
+-- * Creates the value resourcesApp which contains information on the
  108
+--   resources declared below. This is used in Handler.hs by the call to
116 109
 --   mkYesodDispatch
117 110
 --
118 111
 -- What this function does *not* do is create a YesodSite instance for
119  
--- Haskellers. Creating that instance requires all of the handler functions
  112
+-- App. Creating that instance requires all of the handler functions
120 113
 -- for our application to be in scope. However, the handler functions
121  
--- usually require access to the Route Haskellers datatype. Therefore, we
  114
+-- usually require access to the AppRoute datatype. Therefore, we
122 115
 -- split these actions into two functions and place them in separate files.
123  
-mkYesodData "Haskellers" $(parseRoutesFile "routes")
  116
+mkYesodData "App" $(parseRoutesFile "config/routes")
124 117
 
125  
-maybeAuth' :: GHandler s Haskellers (Maybe ((UserId, User), Maybe Username))
  118
+type Form x = Html -> MForm App App (FormResult x, Widget)
  119
+
  120
+maybeAuth' :: GHandler s App (Maybe ((UserId, User), Maybe Username))
126 121
 maybeAuth' = do
127 122
     x <- maybeAuth
128 123
     case x of
@@ -131,7 +126,7 @@ maybeAuth' = do
131 126
             y <- runDB $ getBy $ UniqueUsernameUser uid
132 127
             return $ Just ((uid, u), fmap entityVal y)
133 128
 
134  
-requireAuth' :: GHandler s Haskellers ((UserId, User), Maybe Username)
  129
+requireAuth' :: GHandler s App ((UserId, User), Maybe Username)
135 130
 requireAuth' = do
136 131
     Entity uid u <- requireAuth
137 132
     y <- runDB $ getBy $ UniqueUsernameUser uid
@@ -139,7 +134,7 @@ requireAuth' = do
139 134
 
140 135
 -- Please see the documentation for the Yesod typeclass. There are a number
141 136
 -- of settings which can be configured by overriding methods here.
142  
-instance Yesod Haskellers where
  137
+instance Yesod App where
143 138
     joinPath _ ar pieces qs' =
144 139
         fromText ar
145 140
         `mappend` encodePath pieces' (queryTextToQuery qs)
@@ -156,7 +151,7 @@ instance Yesod Haskellers where
156 151
       where
157 152
         corrected = filter (not . T.null) s
158 153
 
159  
-    approot = ApprootMaster theApproot
  154
+    approot = ApprootMaster $ appRoot . settings
160 155
 
161 156
     defaultLayout widget = do
162 157
         mmsg <- getMessage
@@ -179,26 +174,26 @@ instance Yesod Haskellers where
179 174
         let title = if fmap tm current == Just RootR
180 175
                         then "Haskellers"
181 176
                         else title'
182  
-        let isCurrent :: Route Haskellers -> Bool
  177
+        let isCurrent :: Route App -> Bool
183 178
             isCurrent RootR = fmap tm current == Just RootR
184 179
             isCurrent x = Just x == fmap tm current || x `elem` map fst parents
185  
-        let navbarSection :: (String, [(String, Route Haskellers)])
186  
-                          -> HtmlUrlI18n HaskellersMessage (Route Haskellers)
187  
-            navbarSection section = $(ihamletFile "hamlet/navbar-section.hamlet")
  180
+        let navbarSection :: (String, [(String, Route App)])
  181
+                          -> HtmlUrlI18n AppMessage (Route App)
  182
+            navbarSection section = $(ihamletFile "templates/navbar-section.hamlet")
188 183
         pc <- widgetToPageContent $ do
189 184
             case ma of
190 185
                 Nothing -> return ()
191  
-                Just ((uid, _), _) -> toWidgetHead [hamlet|<link href="@{UserFeedR uid}" type="application/atom+xml" rel="alternate" title="Your Haskellers Updates">
  186
+                Just ((uid, _), _) -> toWidgetHead [hamlet|<link href="@{UserFeedR uid}" type="application/atom+xml" rel="alternate" title="Your App Updates">
192 187
 |]
193  
-            toWidget $(Settings.cassiusFile "default-layout")
  188
+            toWidget $(Settings.cassiusFile "templates/default-layout.cassius")
194 189
             addScriptEither $ urlJqueryJs y
195 190
             addScriptEither $ urlJqueryUiJs y
196 191
             addStylesheetEither $ urlJqueryUiCss y
197  
-            toWidget $(Settings.juliusFile "analytics")
198  
-            toWidget $(Settings.juliusFile "default-layout")
  192
+            toWidget $(Settings.juliusFile "templates/analytics.julius")
  193
+            toWidget $(Settings.juliusFile "templates/default-layout.julius")
199 194
             addScriptRemote "https://browserid.org/include.js"
200 195
             addWidget widget
201  
-        let login' = $(ihamletFile "hamlet/login.hamlet")
  196
+        let login' = $(ihamletFile "templates/login.hamlet")
202 197
         let langs :: [(Text, Text)]
203 198
             langs =
204 199
                 [ ("en", "English")
@@ -208,12 +203,18 @@ instance Yesod Haskellers where
208 203
                 , ("ru", "Russian")
209 204
                 , ("ua", "Ukrainian")
210 205
                 ]
211  
-        ihamletToRepHtml $(ihamletFile "hamlet/default-layout.hamlet")
  206
+        ihamletToRepHtml $(ihamletFile "templates/default-layout.hamlet")
  207
+
  208
+    -- Store session data on the client in encrypted cookies,
  209
+    -- default session idle timeout is 120 minutes
  210
+    makeSessionBackend _ = do
  211
+        key <- getKey "config/client_session_key.aes"
  212
+        return . Just $ clientSessionBackend key 120
212 213
 
213 214
     -- This is done to provide an optimization for serving static files from
214  
-    -- a separate domain. Please see the staticroot setting in Settings.hs
215  
-    urlRenderOverride a (StaticR s) =
216  
-        Just $ uncurry (joinPath a $ Settings.staticroot $ theApproot a) $ renderRoute s
  215
+    -- a separate domain. Please see the staticRoot setting in Settings.hs
  216
+    urlRenderOverride y (StaticR s) =
  217
+        Just $ uncurry (joinPath y (Settings.staticRoot $ settings y)) $ renderRoute s
217 218
     urlRenderOverride _ _ = Nothing
218 219
 
219 220
     -- The page to be redirected to when authentication is required.
@@ -223,24 +224,12 @@ instance Yesod Haskellers where
223 224
     -- and names them based on a hash of their content. This allows
224 225
     -- expiration dates to be set far in the future without worry of
225 226
     -- users receiving stale content.
226  
-    addStaticContent ext' _ content = do
227  
-        let fn = base64md5 content ++ '.' : unpack ext'
228  
-        let content' =
229  
-                if ext' == "js"
230  
-                    then case minifym content of
231  
-                            Left _ -> content
232  
-                            Right y -> y
233  
-                    else content
234  
-        let statictmp = Settings.staticdir ++ "/tmp/"
235  
-        liftIO $ createDirectoryIfMissing True statictmp
236  
-        let fn' = statictmp ++ fn
237  
-        exists <- liftIO $ doesFileExist fn'
238  
-        unless exists $ liftIO $ L.writeFile fn' content'
239  
-        return $ Just $ Right (StaticR $ StaticRoute ["tmp", pack fn] [], [])
240  
-
241  
-    -- FIXME clientSessionDuration _ = 60 * 24 * 14 -- 2 weeks
242  
-
243  
-navbar :: [(String, [(String, Route Haskellers)])]
  227
+    addStaticContent = addStaticContentExternal minifym base64md5 Settings.staticDir (StaticR . flip StaticRoute [])
  228
+
  229
+    -- Place Javascript at bottom of the body tag so the rest of the page loads first
  230
+    jsLoader _ = BottomOfBody
  231
+
  232
+navbar :: [(String, [(String, Route App)])]
244 233
 navbar =
245 234
     [ ("General",
246 235
         [ ("Homepage", RootR)
@@ -264,7 +253,7 @@ navbar =
264 253
     ]
265 254
 
266 255
 userbar :: ((UserId, User), Maybe Username)
267  
-        -> [(String, [(String, Route Haskellers)])]
  256
+        -> [(String, [(String, Route App)])]
268 257
 userbar ((uid, u), a) = (:) ("Your Profile",
269 258
     [ ("Edit Profile", ProfileR)
270 259
     , ("View Profile", userR ((uid, u), a))
@@ -277,10 +266,10 @@ userbar ((uid, u), a) = (:) ("Your Profile",
277 266
                 ])]
278 267
         else []
279 268
 
280  
-loginbar :: (String, [(String, Route Haskellers)])
  269
+loginbar :: (String, [(String, Route App)])
281 270
 loginbar = ("Account", [("Login", AuthR LoginR)])
282 271
 
283  
-instance YesodBreadcrumbs Haskellers where
  272
+instance YesodBreadcrumbs App where
284 273
     breadcrumb RootR = return ("Homepage", Nothing)
285 274
     breadcrumb FaqR = return ("Frequently Asked Questions", Just RootR)
286 275
     breadcrumb BlingR = return ("Bling", Just RootR)
@@ -303,12 +292,12 @@ instance YesodBreadcrumbs Haskellers where
303 292
                     case x of
304 293
                         Nothing -> lift notFound
305 294
                         Just (Entity _ un) -> get404 $ usernameUser un
306  
-        return (userFullName u, Nothing)
  295
+        return (Foundation.userFullName u, Nothing)
307 296
     breadcrumb ProfileR = return ("Edit Your Profile", Just RootR)
308 297
     breadcrumb VerifyEmailR{} = return ("Verify Your Email Address", Nothing)
309 298
     breadcrumb AdminUsersR = return ("User List- Admin", Nothing)
310 299
     breadcrumb MessagesR = return ("Messages- Admin", Nothing)
311  
-    breadcrumb (AuthR LoginR) = return ("Log in to Haskellers", Just RootR)
  300
+    breadcrumb (AuthR LoginR) = return ("Log in to App", Just RootR)
312 301
     breadcrumb DebugR = return ("Database pool debug info", Just RootR)
313 302
     breadcrumb PollsR = return ("Polls", Just RootR)
314 303
     breadcrumb (PollR pollid) = do
@@ -383,19 +372,26 @@ instance YesodBreadcrumbs Haskellers where
383 372
     breadcrumb PollCloseR{} = return ("", Nothing)
384 373
 
385 374
 -- How to run database actions.
386  
-instance YesodPersist Haskellers where
387  
-    type YesodPersistBackend Haskellers = SqlPersist
388  
-    runDB db = fmap connPool getYesod >>= Settings.runConnectionPool db
389  
-
390  
-instance YesodJquery Haskellers where
  375
+instance YesodPersist App where
  376
+    type YesodPersistBackend App = SqlPersist
  377
+    runDB f = do
  378
+        master <- getYesod
  379
+        Database.Persist.Store.runPool
  380
+            (persistConfig master)
  381
+            f
  382
+            (connPool master)
  383
+
  384
+instance YesodJquery App where
391 385
     urlJqueryUiCss _ = Left $ StaticR jquery_ui_css
392  
-instance YesodNic Haskellers
  386
+instance YesodNic App
393 387
 
394  
-instance RenderMessage Haskellers FormMessage where
  388
+-- This instance is required to use forms. You can modify renderMessage to
  389
+-- achieve customized and internationalized form validation messages.
  390
+instance RenderMessage App FormMessage where
395 391
     renderMessage _ _ = defaultFormMessage
396 392
 
397  
-instance YesodAuth Haskellers where
398  
-    type AuthId Haskellers = UserId
  393
+instance YesodAuth App where
  394
+    type AuthId App = UserId
399 395
 
400 396
     loginDest _ = ProfileR
401 397
     logoutDest _ = RootR
@@ -456,27 +452,34 @@ instance YesodAuth Haskellers where
456 452
             _ <- insertBy $ Ident claimed uid
457 453
             return ()
458 454
 
459  
-    authPlugins _ = [ authOpenId
  455
+    authPlugins _ = [ authOpenId OPLocal []
460 456
                   , authFacebook
461 457
                         (Credentials
462  
-                            "Haskellers.com"
  458
+                            "App.com"
463 459
                             "157813777573244"
464 460
                             "327e6242e855954b16f9395399164eec")
465 461
                         []
466  
-                  , authBrowserId hostname
  462
+                  , authBrowserId
467 463
                   ]
468 464
 
469 465
     authHttpManager = httpManager
470 466
 
  467
+-- Note: previous versions of the scaffolding included a deliver function to
  468
+-- send emails. Unfortunately, there are too many different options for us to
  469
+-- give a reasonable default. Instead, the information is available on the
  470
+-- wiki:
  471
+--
  472
+-- https://github.com/yesodweb/yesod/wiki/Sending-email
  473
+
471 474
     loginHandler = defaultLayout $ do
472 475
         [whamlet|\
473 476
 <div style="width:500px;margin:0 auto">^{login}
474 477
 |]
475 478
 
476  
-login :: GWidget s Haskellers ()
477  
-login = {-addCassius $(cassiusFile "login") >> -}$(hamletFile "login")
  479
+login :: GWidget s App ()
  480
+login = toWidget $ {-addCassius $(cassiusFile "login") >> -}$(hamletFile "templates/login.hamlet")
478 481
 
479  
-userR :: ((UserId, User), Maybe Username) -> Route Haskellers
  482
+userR :: ((UserId, User), Maybe Username) -> Route App
480 483
 userR (_, Just (Username _ un)) = UserR un
481 484
 userR ((uid, _), _) = UserR $ toPathPiece uid
482 485
 
@@ -507,7 +510,7 @@ getDebugR = do
507 510
 prettyDay :: Day -> String
508 511
 prettyDay = formatTime defaultTimeLocale "%B %e, %Y"
509 512
 
510  
-addTeamNews :: TeamId -> Text -> Html -> Route Haskellers -> SqlPersist Handler ()
  513
+addTeamNews :: TeamId -> Text -> Html -> Route App -> SqlPersist Handler ()
511 514
 addTeamNews tid title content url = do
512 515
     render <- lift getUrlRender
513 516
     now <- liftIO getCurrentTime
@@ -571,26 +574,7 @@ userFullName =
571 574
 browserIdDest :: AuthRoute
572 575
 browserIdDest = PluginR "browserid" []
573 576
 
574  
-authBrowserId :: YesodAuth master => Text -> AuthPlugin master
575  
-authBrowserId host = AuthPlugin
576  
-    { apName = "browserid"
577  
-    , apDispatch = \method pieces ->
578  
-        case (method, pieces) of
579  
-            ("GET", [assertion]) -> do
580  
-                h <- getYesod
581  
-                memail <- runResourceT $ checkAssertion host assertion (authHttpManager h)
582  
-                case memail of
583  
-                    Nothing -> permissionDenied $ "Invalid BrowserID assertion"
584  
-                    Just email -> setCreds True Creds
585  
-                        { credsPlugin = "browserid"
586  
-                        , credsIdent = email
587  
-                        , credsExtra = []
588  
-                        }
589  
-            (_, _) -> notFound
590  
-    , apLogin = const $ return ()
591  
-    }
592  
-
593  
-fixBrowserId :: Creds Haskellers -> GHandler sub Haskellers ()
  577
+fixBrowserId :: Creds App -> GHandler sub App ()
594 578
 fixBrowserId creds
595 579
     | credsPlugin creds == "browserid" = runDB $ do
596 580
         liftIO $ putStrLn "here i am"
9  Handler/Admin.hs
@@ -15,7 +15,7 @@ module Handler.Admin
15 15
     , requireAdmin
16 16
     ) where
17 17
 
18  
-import Foundation
  18
+import Import
19 19
 import Control.Monad (unless)
20 20
 import Handler.User (adminControls) -- FIXME includes style too many times
21 21
 import Handler.Root (gravatar)
@@ -71,8 +71,7 @@ getMessagesR = do
71 71
         )
72 72
     defaultLayout $ do
73 73
         setTitle "Admin Messages"
74  
-        addCassius $(cassiusFile "messages")
75  
-        addWidget $(hamletFile "messages")
  74
+        $(widgetFile "messages")
76 75
 
77 76
 postCloseMessageR :: MessageId -> Handler ()
78 77
 postCloseMessageR mid = do
@@ -87,7 +86,5 @@ getAdminUsersR = do
87 86
     y <- getYesod
88 87
     defaultLayout $ do
89 88
         setTitle "Admin list of users"
90  
-        addCassius $(cassiusFile "admin-users")
91 89
         addScriptEither $ urlJqueryJs y
92  
-        addJulius $(juliusFile "admin-users")
93  
-        $(hamletFile "admin-users")
  90
+        $(widgetFile "admin-users")
4  Handler/Bling.hs
@@ -3,8 +3,8 @@ module Handler.Bling
3 3
     ( getBlingR
4 4
     ) where
5 5
 
6  
-import Foundation
7  
-import StaticFiles (bling_monads_in_disguise_png)
  6
+import Import
  7
+import Settings.StaticFiles (bling_monads_in_disguise_png)
8 8
 
9 9
 getBlingR :: Handler RepHtml
10 10
 getBlingR = defaultLayout $ do
4  Handler/Email.hs
@@ -6,14 +6,14 @@ module Handler.Email
6 6
     , getVerifyEmailR
7 7
     ) where
8 8
 
9  
-import Foundation
  9
+import Import
10 10
 import Control.Monad (when)
11 11
 import Network.Mail.Mime
12 12
 import Network.Mail.Mime.SES
13 13
 import System.Random (newStdGen)
14 14
 import Data.Maybe (isJust)
15 15
 import qualified Data.ByteString.Lazy.UTF8 as LU
16  
-import StaticFiles (logo_png)
  16
+import Settings.StaticFiles (logo_png)
17 17
 import Data.Text (Text, pack, unpack)
18 18
 import SESCreds (access, secret)
19 19
 import Data.Text.Encoding (encodeUtf8)
5  Handler/Faq.hs
@@ -3,7 +3,7 @@ module Handler.Faq
3 3
     ( getFaqR
4 4
     ) where
5 5
 
6  
-import Foundation
  6
+import Import
7 7
 import Text.Hamlet (shamlet)
8 8
 
9 9
 data Faq = Faq
@@ -43,5 +43,4 @@ faqs =
43 43
 getFaqR :: Handler RepHtml
44 44
 getFaqR = defaultLayout $ do
45 45
     setTitle "Haskellers Frequently Asked Questions"
46  
-    addCassius $(cassiusFile "faq")
47  
-    $(hamletFile "faq")
  46
+    $(widgetFile "faq")
15  Handler/Job.hs
@@ -6,7 +6,7 @@ module Handler.Job
6 6
     , getJobsFeedR
7 7
     ) where
8 8
 
9  
-import Foundation
  9
+import Import
10 10
 import Control.Applicative
11 11
 import Data.Maybe (fromMaybe)
12 12
 import Data.Time
@@ -52,9 +52,8 @@ getJobsR = do
52 52
                         return $ Just form
53 53
                     else return Nothing
54 54
     defaultLayout $ do
55  
-        addCassius $(cassiusFile "jobs")
56  
-        addCassius $(cassiusFile "login-status")
57  
-        addWidget $(hamletFile "jobs")
  55
+        addCassius $(cassiusFile "templates/login-status.cassius")
  56
+        $(widgetFile "jobs")
58 57
 
59 58
 postJobsR :: Handler RepHtml
60 59
 postJobsR = do
@@ -71,17 +70,13 @@ postJobsR = do
71 70
         _ -> return ()
72 71
     let jobs = []
73 72
     let isUnverEmail = False
74  
-    defaultLayout $ do
75  
-        addCassius $(cassiusFile "jobs")
76  
-        $(hamletFile "jobs")
  73
+    defaultLayout $(widgetFile "jobs")
77 74
 
78 75
 getJobR :: JobId -> Handler RepHtml
79 76
 getJobR jid = do
80 77
     job <- runDB $ get404 jid
81 78
     poster <- runDB $ get404 $ jobPostedBy job
82  
-    defaultLayout $ do
83  
-        addCassius $(cassiusFile "job")
84  
-        $(hamletFile "job")
  79
+    defaultLayout $(widgetFile "job")
85 80
 
86 81
 getJobsFeedR :: Handler RepAtomRss
87 82
 getJobsFeedR = do
10  Handler/News.hs
@@ -7,7 +7,7 @@ module Handler.News
7 7
     , getNewsFeedR
8 8
     ) where
9 9
 
10  
-import Foundation
  10
+import Import
11 11
 import Yesod.Feed
12 12
 import Control.Applicative
13 13
 import Yesod.Form.Nic
@@ -34,9 +34,9 @@ getNewsR = do
34 34
 
35 35
     defaultLayout $ do
36 36
         setTitle "Haskellers News Archive"
37  
-        addWidget $(hamletFile "news")
  37
+        $(widgetFile "news")
38 38
   where
39  
-    newsAdmin = $(cassiusFile "news-admin")
  39
+    newsAdmin = $(cassiusFile "templates/news-admin.cassius")
40 40
 
41 41
 postNewsR :: Handler RepHtml
42 42
 postNewsR = do
@@ -66,8 +66,8 @@ getNewsItemR nid = do
66 66
     n <- runDB $ get404 nid
67 67
     defaultLayout $ do
68 68
         setTitle $ toHtml $ newsTitle n
69  
-        addCassius $(cassiusFile "news")
70  
-        $(hamletFile "news-item")
  69
+        addCassius $(cassiusFile "templates/news.cassius")
  70
+        $(widgetFile "news-item")
71 71
 
72 72
 getNewsFeedR :: Handler RepAtomRss
73 73
 getNewsFeedR = do
2  Handler/Package.hs
@@ -5,7 +5,7 @@ module Handler.Package
5 5
     , postPackagesR
6 6
     ) where
7 7
 
8  
-import Foundation
  8
+import Import
9 9
 import Control.Monad (unless)
10 10
 import Yesod.Auth (requireAuthId)
11 11
 
2  Handler/Poll.hs
@@ -8,7 +8,7 @@ module Handler.Poll
8 8
     , postPollCloseR
9 9
     ) where
10 10
 
11  
-import Foundation
  11
+import Import
12 12
 import Control.Monad (unless, when)
13 13
 import qualified Data.Text as T
14 14
 import Data.Time (getCurrentTime, addUTCTime)
8  Handler/Profile.hs
@@ -16,12 +16,12 @@ module Handler.Profile
16 16
     , postDeleteScreenNameR
17 17
     ) where
18 18
 
19  
-import Foundation
  19
+import Import
20 20
 import Handler.Root (yearField)
21 21
 import Control.Applicative
22 22
 import Handler.Root (gravatar)
23 23
 import Yesod.Form.Jquery
24  
-import StaticFiles (jquery_cookie_js, badge_png)
  24
+import Settings.StaticFiles (jquery_cookie_js, badge_png)
25 25
 import Data.Maybe (isJust)
26 26
 import Control.Monad (filterM, forM_, unless)
27 27
 import Yesod.Form
@@ -116,10 +116,8 @@ getProfileR = do
116 116
         addScriptEither $ urlJqueryUiJs y
117 117
         addStylesheetEither $ urlJqueryUiCss y
118 118
         setTitle "Edit Your Profile"
119  
-        addCassius $(cassiusFile "profile")
120 119
         addScriptRemote "http://maps.google.com/maps/api/js?sensor=false"
121  
-        addJulius $(juliusFile "profile")
122  
-        $(hamletFile "profile")
  120
+        $(widgetFile "profile")
123 121
   where
124 122
     notOne [_] = False
125 123
     notOne _ = True
9  Handler/Root.hs
@@ -9,7 +9,7 @@ module Handler.Root
9 9
     , postLangR
10 10
     ) where
11 11
 
12  
-import Foundation hiding (Filter)
  12
+import Import hiding (Filter)
13 13
 import qualified Model
14 14
 import Yesod.Form
15 15
 import qualified Data.ByteString.Lazy.UTF8 as L
@@ -65,8 +65,8 @@ getRootR = do
65 65
         addScriptEither $ urlJqueryUiJs y
66 66
         addStylesheetEither $ urlJqueryUiCss y
67 67
         addScriptRemote "http://maps.google.com/maps/api/js?sensor=false"
68  
-        addCassius $(cassiusFile "jobs")
69  
-        addCassius $(cassiusFile "users")
  68
+        addCassius $(cassiusFile "templates/jobs.cassius")
  69
+        addCassius $(cassiusFile "templates/users.cassius")
70 70
         $(widgetFile "homepage")
71 71
 
72 72
 data Filter = Filter
@@ -87,6 +87,7 @@ applyFilter f p = and
87 87
     , go parttime (Just . filterPartTime)
88 88
     ]
89 89
   where
  90
+    go :: (z -> Bool) -> (Filter -> Maybe z) -> Bool
90 91
     go x y =
91 92
         case y f of
92 93
             Nothing -> True
@@ -217,7 +218,7 @@ getLocationsR = do
217 218
         ]
218 219
     go _ _ = error "getLocationsR"
219 220
 
220  
-profileUserR :: Profile -> Route Haskellers
  221
+profileUserR :: Profile -> Route App
221 222
 profileUserR p = userR ((profileUserId p, profileUser p), profileUsername p)
222 223
 
223 224
 postLangR :: Handler ()
8  Handler/Skills.hs
@@ -6,9 +6,8 @@ module Handler.Skills
6 6
     , getSkillR
7 7
     ) where
8 8
 
9  
-import Foundation
  9
+import Import
10 10
 import Handler.Admin (requireAdmin)
11  
-import Control.Applicative
12 11
 
13 12
 skillFormlet :: Html -> MForm Haskellers Haskellers (FormResult Skill, Widget)
14 13
 skillFormlet = renderTable $ Skill
@@ -45,8 +44,7 @@ getAllSkillsR = do
45 44
     render <- getUrlRender
46 45
     defaultLayoutJson (do
47 46
         setTitle "Browse all skills"
48  
-        addCassius $(cassiusFile "skills")
49  
-        addWidget $(hamletFile "skills")
  47
+        $(widgetFile "skills")
50 48
         ) $ object
51 49
         [ "skills" .= array (flip map skills' $ \((sid, Skill name), users) ->
52 50
             object
@@ -71,7 +69,7 @@ getSkillR sid = do
71 69
     render <- getUrlRender
72 70
     defaultLayoutJson (do
73 71
         setTitle $ toHtml $ skillName skill
74  
-        $(hamletFile "skill")
  72
+        $(widgetFile "skill")
75 73
         ) $ object
76 74
         [ "users" .= array (flip map users $ \x@((uid, u), _) -> object
77 75
             [ "id"   .= toPathPiece uid
24  Handler/Team.hs
@@ -18,7 +18,7 @@ module Handler.Team
18 18
     , loginStatus
19 19
     ) where
20 20
 
21  
-import Foundation
  21
+import Import
22 22
 import Yesod.Feed
23 23
 import Data.List (sortBy)
24 24
 import Data.Ord (comparing)
@@ -32,9 +32,7 @@ import Network.HTTP.Types (status301)
32 32
 import Yesod.Auth
33 33
 
34 34
 loginStatus :: Maybe (Entity User) -> Widget
35  
-loginStatus ma = do
36  
-    addCassius $(cassiusFile "login-status")
37  
-    addWidget $(hamletFile "login-status")
  35
+loginStatus ma = $(widgetFile "login-status")
38 36
 
39 37
 canAddTeam :: Maybe (Entity User) -> Handler Bool
40 38
 canAddTeam ma = do
@@ -69,8 +67,7 @@ getTeamsR = do
69 67
     let teams = reverse $ sortBy (comparing snd) teams'
70 68
     defaultLayout $ do
71 69
         addWidget $ loginStatus ma
72  
-        addCassius $(cassiusFile "teams")
73  
-        addWidget $(hamletFile "teams")
  70
+        $(widgetFile "teams")
74 71
 
75 72
 postTeamsR :: Handler RepHtml
76 73
 postTeamsR = do
@@ -85,8 +82,8 @@ postTeamsR = do
85 82
             lift $ setMessage "Your new group has been created"
86 83
             lift $ redirect $ TeamR tid
87 84
         _ -> defaultLayout $ do
88  
-            addCassius $(cassiusFile "teams")
89  
-            addWidget $(hamletFile "teams-form")
  85
+            addCassius $(cassiusFile "templates/teams.cassius")
  86
+            $(widgetFile "teams-form")
90 87
 
91 88
 canEditTeam :: TeamId -> Handler (Bool, Maybe TeamUserStatus)
92 89
 canEditTeam tid = do
@@ -123,9 +120,8 @@ getTeamR tid = do
123 120
     ((_, addPackage), _) <- runFormPost $ packageFormlet tid Nothing
124 121
     defaultLayout $ do
125 122
         addWidget $ loginStatus ma
126  
-        addCassius $(cassiusFile "teams")
127  
-        addCassius $(cassiusFile "team")
128  
-        addWidget $(hamletFile "team")
  123
+        addCassius $(cassiusFile "templates/teams.cassius")
  124
+        $(widgetFile "team")
129 125
         addHamletHead [hamlet|<link href="@{TeamFeedR tid}" type="application/atom+xml" rel="alternate" title="#{teamName t} Updates">
130 126
 |]
131 127
 
@@ -141,8 +137,8 @@ postTeamR tid = do
141 137
             setMessage "Group information updated"
142 138
             redirect $ TeamR tid
143 139
         _ -> defaultLayout $ do
144  
-            addCassius $(cassiusFile "teams")
145  
-            addWidget $(hamletFile "team-form")
  140
+            addCassius $(cassiusFile "templates/teams.cassius")
  141
+            $(widgetFile "team-form")
146 142
 
147 143
 postLeaveTeamR :: TeamId -> Handler ()
148 144
 postLeaveTeamR tid = do
@@ -250,6 +246,7 @@ getTeamFeedR tid = runDB $ do
250 246
         , feedEntries = map toAtomEntry news
251 247
         , feedDescription = toHtml $ teamName t `T.append` " on Haskellers"
252 248
         , feedLanguage = "en"
  249
+        , feedAuthor = "Haskellers.com"
253 250
         }
254 251
 
255 252
 getUserFeedR :: UserId -> Handler RepAtomRss
@@ -269,6 +266,7 @@ getUserFeedR uid = runDB $ do
269 266
         , feedEntries = map toAtomEntry news
270 267
         , feedDescription = "Personal Haskellers feed"
271 268
         , feedLanguage = "en"
  269
+        , feedAuthor = "Haskellers.com"
272 270
         }
273 271
 
274 272
 toAtomEntry :: Entity TeamNews -> FeedEntry (Route Haskellers)
8  Handler/Topic.hs
@@ -7,7 +7,7 @@ module Handler.Topic
7 7
     , postTopicMessageR
8 8
     ) where
9 9
 
10  
-import Foundation
  10
+import Import
11 11
 import Handler.Team (loginStatus)
12 12
 import Yesod.Form.Nic
13 13
 import Data.Time
@@ -41,8 +41,7 @@ getTopicsR tid = do
41 41
             _ -> return Nothing
42 42
     defaultLayout $ do
43 43
         addWidget $ loginStatus ma
44  
-        addWidget $(hamletFile "topics")
45  
-        addCassius $(cassiusFile "topics")
  44
+        $(widgetFile "topics")
46 45
 
47 46
 postTopicsR :: TeamId -> Handler RepHtml
48 47
 postTopicsR tid = do
@@ -110,8 +109,7 @@ getTopicR toid = do
110 109
         )
111 110
     defaultLayout $ do
112 111
         addWidget $ loginStatus ma
113  
-        addWidget $(hamletFile "topic")
114  
-        addCassius $(cassiusFile "topic")
  112
+        $(widgetFile "topic")
115 113
 
116 114
 postTopicR :: TopicId -> Handler ()
117 115
 postTopicR toid = do
15  Handler/User.hs
@@ -9,7 +9,7 @@ module Handler.User
9 9
     , adminControls
10 10
     ) where
11 11
 
12  
-import Foundation
  12
+import Import
13 13
 import Handler.Root (gravatar)
14 14
 import Data.List (sortBy, intercalate)
15 15
 import Data.Ord (comparing)
@@ -96,10 +96,8 @@ getUserR input = do
96 96
                 (map (\x -> "package=" ++ percentEncode x) packages)
97 97
     flip defaultLayoutJson json $ do
98 98
         setTitle $ toHtml $ "Haskellers profile for " `mappend` userFullName u
99  
-        addCassius $(cassiusFile "user")
100 99
         addScriptEither $ urlJqueryJs y
101  
-        addJulius $(juliusFile "user")
102  
-        $(hamletFile "user")
  100
+        $(widgetFile "user")
103 101
   where
104 102
     notOne 1 = False
105 103
     notOne _ = True
@@ -148,12 +146,11 @@ getFlagR uid = do
148 146
     let userLink = userR ((uid, u), Nothing)
149 147
     defaultLayout $ do
150 148
         setTitle "Report a user"
151  
-        addCassius $(cassiusFile "flag")
152  
-        addWidget $(hamletFile "flag")
  149
+        addWidget $(widgetFile "flag")
153 150
 
154 151
 postFlagR :: UserId -> Handler ()
155 152
 postFlagR uid = do
156  
-    mvid <- maybeAuthId
  153
+    mvid <- fmap (fmap entityKey) maybeAuth
157 154
     mmsg <- runInputPost $ iopt textField "message"
158 155
     let msg = fromMaybe "" mmsg
159 156
 
@@ -172,6 +169,4 @@ postFlagR uid = do
172 169
     redirect $ userR ((uid, u), Nothing)
173 170
 
174 171
 adminControls :: UserId -> User -> Widget
175  
-adminControls uid u = do
176  
-    addCassius $(cassiusFile "admin-controls")
177  
-    $(hamletFile "admin-controls")
  172
+adminControls uid u = $(widgetFile "admin-controls")
34  Import.hs
... ...
@@ -0,0 +1,34 @@
  1
+module Import
  2
+    ( module Prelude
  3
+    , module Yesod
  4
+    , module Foundation
  5
+    , module Settings.StaticFiles
  6
+    , module Settings.Development
  7
+    , module Data.Monoid
  8
+    , module Control.Applicative
  9
+    , Text
  10
+    , cassiusFile
  11
+    , juliusFile
  12
+    , Haskellers
  13
+#if __GLASGOW_HASKELL__ < 704
  14
+    , (<>)
  15
+#endif
  16
+    ) where
  17
+
  18
+import Prelude hiding (writeFile, readFile, head, tail, init, last)
  19
+import Yesod   hiding (Route(..))
  20
+import Foundation
  21
+import Data.Monoid (Monoid (mappend, mempty, mconcat))
  22
+import Control.Applicative ((<$>), (<*>), pure)
  23
+import Data.Text (Text)
  24
+import Settings
  25
+import Settings.StaticFiles
  26
+import Settings.Development
  27
+
  28
+type Haskellers = App
  29
+
  30
+#if __GLASGOW_HASKELL__ < 704
  31
+infixr 5 <>
  32
+(<>) :: Monoid m => m -> m -> m
  33
+(<>) = mappend
  34
+#endif
2  LICENSE
... ...
@@ -1,7 +1,7 @@
1 1
 The following license covers this documentation, and the source code, except
2 2
 where otherwise indicated.
3 3
 
4  
-Copyright 2010, Michael Snoyman. All rights reserved.
  4
+Copyright 2012, Michael Snoyman. All rights reserved.
5 5
 
6 6
 Redistribution and use in source and binary forms, with or without
7 7
 modification, are permitted provided that the following conditions are met:
24  Model.hs
... ...
@@ -1,18 +1,12 @@
1  
-{-# LANGUAGE QuasiQuotes, TypeFamilies, GeneralizedNewtypeDeriving #-}
2  
-{-# LANGUAGE FlexibleInstances #-}
3  
-{-# LANGUAGE MultiParamTypeClasses #-}
4  
-{-# LANGUAGE TemplateHaskell #-}
5  
-{-# LANGUAGE OverloadedStrings #-}
6  
-{-# LANGUAGE GADTs #-}