mathblog-0.6: tests/src/MB/StartupTests.hs
module MB.StartupTests where
import Test.Framework
( testGroup
, Test)
import Test.Framework.Providers.HUnit
import Test.HUnit
( (@=?), assertFailure )
import MB.Startup
import MB.Types
tests :: Test
tests = testGroup "Startup configuration tests" [
testGroup "Data directory tests" $ map (testBaseDir dataDirectory) [
-- (desc, cmdline, env, base dir result)
("base dir in environment only"
, [], [ (htmlOutputDirEnvName, "pth")
, (baseDirEnvName, "foo")
]
, "foo")
, ("base dir on command line only"
, [DataDir "foo"]
, [(htmlOutputDirEnvName, "pth")]
, "foo")
, ("base dir in both places, command line takes precedence"
, [DataDir "foo"]
, [(baseDirEnvName, "bar"), (htmlOutputDirEnvName, "pth")]
, "foo")
]
, testGroup "HTML output directory tests" $ map (testBaseDir htmlOutputDirectory) [
-- (desc, cmdline, env, base dir result)
("html dir in environment only"
, [], [ (htmlOutputDirEnvName, "pth")
, (baseDirEnvName, "foo")
]
, "pth")
, ("html dir on command line only"
, [HtmlOutputDir "pth"]
, [(baseDirEnvName, "foo")]
, "pth")
, ("html dir in both places, command line takes precedence"
, [HtmlOutputDir "pth1"]
, [(baseDirEnvName, "bar"), (htmlOutputDirEnvName, "pth2")]
, "pth1")
]
, testGroup "No base directory specified" $
[ testCase "HTML output dir in environment" $ Nothing @=? startupConfig [] [(htmlOutputDirEnvName, "foo")]
, testCase "HTML output dir in args" $ Nothing @=? startupConfig [HtmlOutputDir "foo"] []
]
, testGroup "No html output directory specified" $
[ testCase "Data dir in environment" $ Nothing @=? startupConfig [] [(baseDirEnvName, "foo")]
, testCase "Data dir in args" $ Nothing @=? startupConfig [DataDir "foo"] []
]
]
testBaseDir :: (Show a, Eq a) => (StartupConfig -> a) -> (String, [Flag], [(String, String)], a) -> Test
testBaseDir f (desc, args, env, result) =
testCase desc assert
where mConfig = startupConfig args env
assert = case mConfig of
Nothing -> assertFailure "could not construct configuration"
Just cfg -> result @=? f cfg