{-# 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