forked from snapframework/snap
/
TestSuite.hs
109 lines (92 loc) · 3.9 KB
/
TestSuite.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Main where
------------------------------------------------------------------------------
import Control.Concurrent
import Control.Exception
import Control.Monad
import qualified Data.ByteString.Lazy.Char8 as L
import qualified Data.ByteString.Char8 as S
import Network.Http.Client
import Prelude hiding (catch)
import Snap.Http.Server.Config
import Snap.Snaplet
import System.IO
import System.Posix.Process
import System.Posix.Signals
import System.Posix.Types
import Test.Framework
import Test.Framework.Providers.HUnit
import Test.HUnit hiding (Test, path)
------------------------------------------------------------------------------
--import Blackbox.App
--import qualified Blackbox.Tests
--import Snap.Http.Server (simpleHttpServe)
import qualified Snap.Snaplet.Internal.Lensed.Tests
import qualified Snap.Snaplet.Internal.LensT.Tests
import qualified Snap.Snaplet.Internal.RST.Tests
import qualified Snap.Snaplet.Internal.Tests
import qualified Snap.Snaplet.Auth.Tests
import qualified Snap.Snaplet.Test.Tests
import qualified Snap.Snaplet.Heist.Tests
import qualified Snap.Snaplet.Config.Tests
import SafeCWD
import Snap.Snaplet
import Snap.Snaplet.Test
import Snap.Snaplet.Auth
import Test.HUnit
------------------------------------------------------------------------------
main :: IO ()
main = do
-- Blackbox.Tests.remove
-- "non-cabal-appdir/snaplets/heist/templates/bad.tpl"
-- Blackbox.Tests.remove
-- "non-cabal-appdir/snaplets/heist/templates/good.tpl"
-- Blackbox.Tests.removeDir "non-cabal-appdir/snaplets/foosnaplet"
-- (tid, mvar) <- inDir False "non-cabal-appdir" startServer
defaultMain [tests] -- `finally` killThread tid
-- putStrLn "waiting for termination mvar"
-- takeMVar mvar
where tests = mutuallyExclusive $
testGroup "snap" [ --internalServerTests
Snap.Snaplet.Auth.Tests.tests
, Snap.Snaplet.Test.Tests.tests
, Snap.Snaplet.Heist.Tests.heistTests
, Snap.Snaplet.Config.Tests.configTests
, Snap.Snaplet.Internal.RST.Tests.tests
, Snap.Snaplet.Internal.LensT.Tests.tests
, Snap.Snaplet.Internal.Lensed.Tests.tests
]
{-
------------------------------------------------------------------------------
internalServerTests :: Test
internalServerTests =
mutuallyExclusive $
testGroup "internal server tests"
[ Blackbox.Tests.tests
, Snap.Snaplet.Internal.Lensed.Tests.tests
, Snap.Snaplet.Internal.LensT.Tests.tests
, Snap.Snaplet.Internal.RST.Tests.tests
, Snap.Snaplet.Internal.Tests.tests
]
------------------------------------------------------------------------------
startServer :: IO (ThreadId, MVar ())
startServer = do
mvar <- newEmptyMVar
t <- forkIO $ serve mvar (setPort 9753 defaultConfig) app
threadDelay $ 2*10^(6::Int)
return (t, mvar)
where
serve mvar config initializer =
flip finally (putMVar mvar ()) $
handle handleErr $ do
hPutStrLn stderr "initializing snaplet"
(_, handler, doCleanup) <- runSnaplet Nothing initializer
flip finally doCleanup $ do
(conf, site) <- combineConfig config handler
hPutStrLn stderr "bringing up server"
simpleHttpServe conf site
hPutStrLn stderr "server killed"
handleErr :: SomeException -> IO ()
handleErr e = hPutStrLn stderr $ "startServer exception: " ++ show e
-}