on 482f546 help sign in
typeable/wai/TestApp.hs
37 lines 1.4 kB history raw
1{-# LANGUAGE QuasiQuotes, TypeFamilies, GeneralizedNewtypeDeriving #-}
2{-# LANGUAGE OverloadedStrings #-}
3module TestApp (testApp) where
5import Network.Wai
6import Data.ByteString.Lazy.Char8 (pack)
7import Database.Persist.Sqlite
8import System.Directory
9import Control.Monad (when)
11mkPersist [$persist|
12Dummy
13 dummy String
14|]
16testApp handler = do
17 putStrLn "testApp called, this should happen only once per reload"
18 let db = "test.db3"
19 -- Swap between the following two lines as necessary to generate errors
20 exi <- doesFileExist db
21 --let exi = True
22 when exi $ removeFile db
23 withSqlitePool db 10 $ \pool -> do
24 flip runSqlPool pool $ runMigration $ migrate $ Dummy ""
25 handler $ \req -> do
26 if pathInfo req == "/favicon.ico"
27 then return $ Response status301 [("Location", "http://docs.yesodweb.com/favicon.ico")]
28 $ ResponseLBS $ pack ""
29 else do
30 print $ pathInfo req
31 x <- flip runSqlPool pool $ do
32 insert $ Dummy ""
33 count ([] :: [Filter Dummy])
34 return $ Response status200
35 [("Content-Type", "text/plain")]
36 $ ResponseLBS $ pack $ "Counter: " ++ show x
37 putStrLn "handler completed, this should only happen at the beginning of a reload"