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
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
|
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Prelude hiding (lookup)
import Control.Concurrent
import Control.Exception
import Control.Monad
import qualified Data.ByteString.Lazy.Char8 as L
import Data.Configurator
import Data.Configurator.Types
import Data.Functor
import Data.Int
import Data.Maybe
import Data.Text (Text)
import Data.Word
import System.Directory
import System.Environment
import System.FilePath
import System.IO
import Test.Framework
import Test.Framework.Providers.HUnit
import Test.HUnit hiding (Test)
main :: IO ()
main = defaultMain tests
tests :: [Test]
tests =
[ testCase "load" loadTest
, testCase "types" typesTest
, testCase "interp" interpTest
, testCase "scoped-interp" scopedInterpTest
, testCase "import" importTest
, testCase "reload" reloadTest
]
withLoad :: FilePath -> (Config -> IO ()) -> IO ()
withLoad name t = do
mb <- try $ load (testFile name)
case mb of
Left (err :: SomeException) -> assertFailure (show err)
Right cfg -> t cfg
withReload :: FilePath -> ([Maybe FilePath] -> Config -> IO ()) -> IO ()
withReload name t = do
tmp <- getTemporaryDirectory
temps <- forM (testFile name) $ \f -> do
exists <- doesFileExist (worth f)
if exists
then do
(p,h) <- openBinaryTempFile tmp "test.cfg"
L.hPut h =<< L.readFile (worth f)
hClose h
return (p <$ f, Just p)
else do
return (f, Nothing)
flip finally (mapM_ removeFile (catMaybes (map snd temps))) $ do
mb <- try $ autoReload autoConfig (map fst temps)
case mb of
Left (err :: SomeException) -> assertFailure (show err)
Right (cfg, tid) -> t (map snd temps) cfg >> killThread tid
testFile :: FilePath -> [Worth FilePath]
testFile name = [Required $ "tests" </> "resources" </> name]
takeMVarTimeout :: Int -> MVar a -> IO (Maybe a)
takeMVarTimeout millis v = do
w <- newEmptyMVar
tid <- forkIO $ do
putMVar w . Just =<< takeMVar v
forkIO $ do
threadDelay (millis * 1000)
killThread tid
tryPutMVar w Nothing
return ()
takeMVar w
loadTest :: Assertion
loadTest =
withLoad "pathological.cfg" $ \cfg -> do
aa <- lookup cfg "aa"
assertEqual "int property" aa $ (Just 1 :: Maybe Int)
ab <- lookup cfg "ab"
assertEqual "string property" ab (Just "foo" :: Maybe Text)
acx <- lookup cfg "ac.x"
assertEqual "nested int" acx (Just 1 :: Maybe Int)
acy <- lookup cfg "ac.y"
assertEqual "nested bool" acy (Just True :: Maybe Bool)
ad <- lookup cfg "ad"
assertEqual "simple bool" ad (Just False :: Maybe Bool)
ae <- lookup cfg "ae"
assertEqual "simple int 2" ae (Just 1 :: Maybe Int)
af <- lookup cfg "af"
assertEqual "list property" af (Just (2,3) :: Maybe (Int,Int))
deep <- lookup cfg "ag.q-e.i_u9.a"
assertEqual "deep bool" deep (Just False :: Maybe Bool)
typesTest :: Assertion
typesTest =
withLoad "pathological.cfg" $ \cfg -> do
asInt <- lookup cfg "aa" :: IO (Maybe Int)
assertEqual "int" asInt (Just 1)
asInteger <- lookup cfg "aa" :: IO (Maybe Integer)
assertEqual "int" asInteger (Just 1)
asWord <- lookup cfg "aa" :: IO (Maybe Word)
assertEqual "int" asWord (Just 1)
asInt8 <- lookup cfg "aa" :: IO (Maybe Int8)
assertEqual "int8" asInt8 (Just 1)
asInt16 <- lookup cfg "aa" :: IO (Maybe Int16)
assertEqual "int16" asInt16 (Just 1)
asInt32 <- lookup cfg "aa" :: IO (Maybe Int32)
assertEqual "int32" asInt32 (Just 1)
asInt64 <- lookup cfg "aa" :: IO (Maybe Int64)
assertEqual "int64" asInt64 (Just 1)
asWord8 <- lookup cfg "aa" :: IO (Maybe Word8)
assertEqual "word8" asWord8 (Just 1)
asWord16 <- lookup cfg "aa" :: IO (Maybe Word16)
assertEqual "word16" asWord16 (Just 1)
asWord32 <- lookup cfg "aa" :: IO (Maybe Word32)
assertEqual "word32" asWord32 (Just 1)
asWord64 <- lookup cfg "aa" :: IO (Maybe Word64)
assertEqual "word64" asWord64 (Just 1)
asTextBad <- lookup cfg "aa" :: IO (Maybe Text)
assertEqual "bad text" asTextBad Nothing
asTextGood <- lookup cfg "ab" :: IO (Maybe Text)
assertEqual "good text" asTextGood (Just "foo")
asStringGood <- lookup cfg "ab" :: IO (Maybe String)
assertEqual "string" asStringGood (Just "foo")
asInts <- lookup cfg "xs" :: IO (Maybe [Int])
assertEqual "ints" asInts (Just [1,2,3])
asChar <- lookup cfg "c" :: IO (Maybe Char)
assertEqual "char" asChar (Just 'x')
interpTest :: Assertion
interpTest =
withLoad "pathological.cfg" $ \cfg -> do
home <- getEnv "HOME"
cfgHome <- lookup cfg "ba"
assertEqual "home interp" (Just home) cfgHome
scopedInterpTest :: Assertion
scopedInterpTest = withLoad "interp.cfg" $ \cfg -> do
home <- getEnv "HOME"
lookup cfg "myprogram.exec"
>>= assertEqual "myprogram.exec" (Just $ home++"/services/myprogram/myprogram")
lookup cfg "myprogram.stdout"
>>= assertEqual "myprogram.stdout" (Just $ home++"/services/myprogram/stdout")
lookup cfg "top.layer1.layer2.dir"
>>= assertEqual "nested scope" (Just $ home++"/top/layer1/layer2")
importTest :: Assertion
importTest =
withLoad "import.cfg" $ \cfg -> do
aa <- lookup cfg "x.aa" :: IO (Maybe Int)
assertEqual "simple" aa (Just 1)
acx <- lookup cfg "x.ac.x" :: IO (Maybe Int)
assertEqual "nested" acx (Just 1)
reloadTest :: Assertion
reloadTest =
withReload "pathological.cfg" $ \[Just f] cfg -> do
aa <- lookup cfg "aa"
assertEqual "simple property 1" aa $ Just (1 :: Int)
dongly <- newEmptyMVar
wongly <- newEmptyMVar
subscribe cfg "dongly" $ \ _ _ -> putMVar dongly ()
subscribe cfg "wongly" $ \ _ _ -> putMVar wongly ()
L.appendFile f "\ndongly = 1"
r1 <- takeMVarTimeout 2000 dongly
assertEqual "notify happened" r1 (Just ())
r2 <- takeMVarTimeout 2000 wongly
assertEqual "notify not happened" r2 Nothing
|
