hablo/test/Structure.hs

40 lines
1.7 KiB
Haskell

module Structure (
test
) where
import Arguments (Arguments(..))
import Blog (Path)
import qualified Blog.Path as Path (build)
import Distribution.TestSuite
import qualified Mock.Arguments as Arguments
import qualified Mock.Blog.Path as Path
import System.Directory (withCurrentDirectory)
import Utils (simpleTest, tag)
checkPath :: Arguments -> Maybe Path -> IO Progress
checkPath input expected = do
withCurrentDirectory root $ do
actual <- either (\_ -> Nothing) Just <$> Path.build root input
return . Finished $
if actual == expected
then Pass
else Fail $ "Expected " ++ show expected ++ " but got " ++ show actual
where
root = sourceDir input
test :: Test
test = tag "structure" . testGroup "Blog structure" $ simpleTest <$> [
("empty structure", checkPath Arguments.emptyBlog Nothing)
, ("default articles", checkPath Arguments.defaultArticles $ Just Path.defaultArticles)
, ("default pages", checkPath Arguments.defaultPages $ Just Path.defaultPages)
, ("both default", checkPath Arguments.bothDefault $ Just Path.bothDefault)
, ("custom articles", checkPath Arguments.customArticles $ Just Path.customArticles)
, ("custom pages", checkPath Arguments.customPages $ Just Path.customPages)
, ("both custom", checkPath Arguments.bothCustom $ Just Path.bothCustom)
, ("custom articles, default pages"
, checkPath Arguments.customArticlesDefaultPages $ Just Path.customArticlesDefaultPages)
, ("custom pages, default articles"
, checkPath Arguments.customPagesDefaultArticles $ Just Path.customPagesDefaultArticles)
, ("bad custom articles", checkPath Arguments.badCustomArticles $ Nothing)
, ("bad custom pages", checkPath Arguments.badCustomPages $ Nothing)
]