git.iko.soy/typeable/wai
on wai-extra/1.3.0 help sign in
typeable/wai/wai-handler-devel/FullApp.hs
44 lines 1.7 kB history raw
1{-# LANGUAGE QuasiQuotes, TypeFamilies, GeneralizedNewtypeDeriving, GADTs #-}
2{-# LANGUAGE TemplateHaskell #-}
3{-# LANGUAGE OverloadedStrings #-}
4module FullApp (fullApp) where
6import Network.Wai
7import Network.HTTP.Types
8import Data.ByteString.Lazy.Char8 (pack)
9import Database.Persist.TH
10import Database.Persist.Sqlite
11import System.Directory
12import Control.Monad (when)
13import Helper
14import Text.Hamlet
15import Text.Blaze.Renderer.Text (renderHtml)
16import Data.Text.Lazy.Encoding (encodeUtf16LE)
18mkPersist sqlSettings [persist|
19Dummy
20 dummy String
21|]
23testApp handler = do
24 putStrLn "testApp called, this should happen only once per reload"
25 -- Swap between the following two lines as necessary to generate errors
26 exi <- doesFileExist "db"
27 --let exi = True
28 when exi $ removeFile "db"
29 withSqlitePool "db" 10 $ \pool -> do
30 flip runSqlPool pool $ runMigration $ migrate $ Dummy ""
31 handler $ \req -> do
32 if pathInfo req == "/favicon.ico"
33 then return $ responseLBS status301 [("Location", "http://docs.yesodweb.com/favicon.ico")]
34 $ pack ""
35 else do
36 print $ pathInfo req
37 x <- flip runSqlPool pool $ do
38 insert $ Dummy ""
39 count ([] :: [Filter Dummy])
40 return $ responseLBS status200
41 [("Content-Type", "text/html; charset=utf-8")] $
42 encodeUtf16LE $ renderHtml
43 $(htmlFile "hamlet/testapp.hamlet")
44 putStrLn "handler completed, this should only happen at the beginning of a reload"