@@ -1,6 +1,7 @@
11{-# LANGUAGE QuasiQuotes, TypeFamilies, GeneralizedNewtypeDeriving, GADTs #-}
22{-# LANGUAGE TemplateHaskell #-}
33{-# LANGUAGE OverloadedStrings #-}
4+{-# LANGUAGE FlexibleContexts #-}
45module FullApp (fullApp) where
56
67import Network.Wai
@@ -12,33 +13,34 @@ import System.Directory
1213import Control.Monad (when)
1314import Helper
1415import Text.Hamlet
15−import Text.Blaze.Renderer.Text (renderHtml)
16+import Text.Blaze.Html.Renderer.Text (renderHtml)
1617import Data.Text.Lazy.Encoding (encodeUtf16LE)
18+import Control.Monad.Trans.Resource (runResourceT)
1719
18−mkPersist sqlSettings [persist|
20+share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persist|
1921Dummy
2022 dummy String
2123|]
2224
23−testApp handler = do
25+fullApp handler = do
2426 putStrLn "testApp called, this should happen only once per reload"
2527 -- Swap between the following two lines as necessary to generate errors
2628 exi <- doesFileExist "db"
2729 --let exi = True
2830 when exi $ removeFile "db"
2931 withSqlitePool "db" 10 $ \pool -> do
30− flip runSqlPool pool $ runMigration $ migrate $ Dummy ""
32+ flip runSqlPool pool $ runMigration migrateAll
3133 handler $ \req -> do
32− if pathInfo req == "/favicon.ico"
33− then return $ responseLBS status301 [("Location", "http://docs.yesodweb.com/favicon.ico")]
34+ if pathInfo req == ["favicon.ico"]
35+ then return $ responseLBS status301 [("Location", "http://www.yesodweb.com/favicon.ico")]
3436 $ pack ""
3537 else do
3638 print $ pathInfo req
37− x <- flip runSqlPool pool $ do
39+ x <- runResourceT $ flip runSqlPool pool $ do
3840 insert $ Dummy ""
3941 count ([] :: [Filter Dummy])
4042 return $ responseLBS status200
4143 [("Content-Type", "text/html; charset=utf-8")] $
4244 encodeUtf16LE $ renderHtml
43− $(htmlFile "hamlet/testapp.hamlet")
45+ $(shamletFile "hamlet/testapp.hamlet")
4446 putStrLn "handler completed, this should only happen at the beginning of a reload"