on 21bdf8e help sign in
typeable/wai/TestApp.hs
32 lines 1.1 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 $ const $ do
26 x <- flip runSqlPool pool $ do
27 insert $ Dummy ""
28 count ([] :: [Filter Dummy])
29 return $ Response status200
30 [("Content-Type", "text/plain")]
31 $ ResponseLBS $ pack $ "Counter: " ++ show x
32 putStrLn "handler completed, this should only happen at the beginning of a reload"