@@ -1,6 +1,7 @@
1{-# LANGUAGE QuasiQuotes, TypeFamilies, GeneralizedNewtypeDeriving, GADTs #-}
1{-# LANGUAGE QuasiQuotes, TypeFamilies, GeneralizedNewtypeDeriving, GADTs #-}
2{-# LANGUAGE TemplateHaskell #-}
2{-# LANGUAGE TemplateHaskell #-}
3{-# LANGUAGE OverloadedStrings #-}
3{-# LANGUAGE OverloadedStrings #-}
4+{-# LANGUAGE FlexibleContexts #-}
4module FullApp (fullApp) where
5module FullApp (fullApp) where
6import Network.Wai
7import Network.Wai
@@ -12,33 +13,34 @@ import System.Directory
12import Control.Monad (when)
13import Control.Monad (when)
13import Helper
14import Helper
14import Text.Hamlet
15import Text.Hamlet
15−import Text.Blaze.Renderer.Text (renderHtml)
16+import Text.Blaze.Html.Renderer.Text (renderHtml)
16import Data.Text.Lazy.Encoding (encodeUtf16LE)
17import Data.Text.Lazy.Encoding (encodeUtf16LE)
18+import Control.Monad.Trans.Resource (runResourceT)
18−mkPersist sqlSettings [persist|
20+share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persist|
20 dummy String
22 dummy String
23−testApp handler = do
25+fullApp handler = do
24 putStrLn "testApp called, this should happen only once per reload"
26 putStrLn "testApp called, this should happen only once per reload"
25 -- Swap between the following two lines as necessary to generate errors
27 -- Swap between the following two lines as necessary to generate errors
26 exi <- doesFileExist "db"
28 exi <- doesFileExist "db"
27 --let exi = True
29 --let exi = True
28 when exi $ removeFile "db"
30 when exi $ removeFile "db"
29 withSqlitePool "db" 10 $ \pool -> do
31 withSqlitePool "db" 10 $ \pool -> do
30− flip runSqlPool pool $ runMigration $ migrate $ Dummy ""
32+ flip runSqlPool pool $ runMigration migrateAll
31 handler $ \req -> do
33 handler $ \req -> do
32− if pathInfo req == "/favicon.ico"
34+ if pathInfo req == ["favicon.ico"]
33− then return $ responseLBS status301 [("Location", "http://docs.yesodweb.com/favicon.ico")]
35+ then return $ responseLBS status301 [("Location", "http://www.yesodweb.com/favicon.ico")]
36 print $ pathInfo req
38 print $ pathInfo req
37− x <- flip runSqlPool pool $ do
39+ x <- runResourceT $ flip runSqlPool pool $ do
38 insert $ Dummy ""
40 insert $ Dummy ""
39 count ([] :: [Filter Dummy])
41 count ([] :: [Filter Dummy])
40 return $ responseLBS status200
42 return $ responseLBS status200
41 [("Content-Type", "text/html; charset=utf-8")] $
43 [("Content-Type", "text/html; charset=utf-8")] $
42 encodeUtf16LE $ renderHtml
44 encodeUtf16LE $ renderHtml
43− $(htmlFile "hamlet/testapp.hamlet")
45+ $(shamletFile "hamlet/testapp.hamlet")
44 putStrLn "handler completed, this should only happen at the beginning of a reload"
46 putStrLn "handler completed, this should only happen at the beginning of a reload"