Add unit tests for new behaviour : articles or pages, auto or custom, fail if none is present

This commit is contained in:
Tissevert 2020-10-23 15:39:49 +02:00
parent e74eadd6ba
commit 804d3aa644
8 changed files with 198 additions and 13 deletions

View file

@ -82,7 +82,8 @@ executable hablo
test-suite tests test-suite tests
type: detailed-0.9 type: detailed-0.9
test-module: Tests test-module: Tests
other-modules: Mock.Article other-modules: Mock.Arguments
, Mock.Article
, Mock.ArticlesList , Mock.ArticlesList
, Mock.Blog , Mock.Blog
, Mock.Blog.Path , Mock.Blog.Path
@ -92,12 +93,14 @@ test-suite tests
, Mock.Blog.Wording , Mock.Blog.Wording
, Mock.Collection , Mock.Collection
, Mock.Markdown , Mock.Markdown
, Structure
, Utils , Utils
, XML.Card , XML.Card
, XML.Card.Component , XML.Card.Component
, XML.Card.Output , XML.Card.Output
build-depends: base build-depends: base
, containers , containers
, directory
, filepath , filepath
, Cabal , Cabal
, hablo-internals , hablo-internals

86
test/Mock/Arguments.hs Normal file
View file

@ -0,0 +1,86 @@
module Mock.Arguments (
badCustomArticles
, badCustomPages
, bothCustom
, bothDefault
, customArticles
, customArticlesDefaultPages
, customPages
, customPagesDefaultArticles
, defaultArticles
, defaultPages
, emptyBlog
) where
import Arguments (Arguments(..))
import Utils (testDataPath)
defaultArticles :: Arguments
defaultArticles = BlogConfig {
sourceDir = testDataPath "Structure/defaultArticles"
, articlesPath = Nothing
, bannerPath = Nothing
, cardImage = Nothing
, commentsURL = Nothing
, favicon = Nothing
, headPath = Nothing
, name = Nothing
, openGraphCards = False
, pagesPath = Nothing
, previewArticlesCount = 3
, previewLinesCount = 10
, remarkableConfig = Nothing
, rss = False
, siteURL = Nothing
, wording = Nothing
}
defaultPages :: Arguments
defaultPages = defaultArticles {
sourceDir = testDataPath "Structure/defaultPages"
}
bothDefault :: Arguments
bothDefault = defaultArticles {
sourceDir = testDataPath "Structure/both"
}
emptyBlog :: Arguments
emptyBlog = defaultArticles {
sourceDir = testDataPath "Structure/custom"
}
customArticles :: Arguments
customArticles = emptyBlog {
articlesPath = Just "customArticles"
}
customArticlesDefaultPages :: Arguments
customArticlesDefaultPages = bothDefault {
articlesPath = Just "customArticles"
}
customPages :: Arguments
customPages = emptyBlog {
pagesPath = Just "customPages"
}
customPagesDefaultArticles :: Arguments
customPagesDefaultArticles = bothDefault {
pagesPath = Just "customPages"
}
bothCustom :: Arguments
bothCustom = customArticles {
pagesPath = Just "customPages"
}
badCustomArticles :: Arguments
badCustomArticles = bothDefault {
articlesPath = Just "missingDirectory"
}
badCustomPages :: Arguments
badCustomPages = bothDefault {
pagesPath = Just "missingDirectory"
}

View file

@ -9,7 +9,7 @@ import Blog (Blog(..))
import qualified Data.Map as Map (fromList) import qualified Data.Map as Map (fromList)
import qualified Data.Set as Set (fromList) import qualified Data.Set as Set (fromList)
import qualified Mock.Article (simple) import qualified Mock.Article (simple)
import qualified Mock.Blog.Path (simple) import qualified Mock.Blog.Path (defaultArticles)
import qualified Mock.Blog.Skin (simple) import qualified Mock.Blog.Skin (simple)
import qualified Mock.Blog.Template (simple) import qualified Mock.Blog.Template (simple)
import qualified Mock.Blog.URL (simple, noCards) import qualified Mock.Blog.URL (simple, noCards)
@ -24,7 +24,7 @@ simple =
, hasRSS = True , hasRSS = True
, name = "The Test Blog" , name = "The Test Blog"
, pages = Map.fromList [] , pages = Map.fromList []
, path = Mock.Blog.Path.simple , path = Mock.Blog.Path.defaultArticles
, skin = Mock.Blog.Skin.simple , skin = Mock.Blog.Skin.simple
, tags = Map.fromList [("testing", Set.fromList ["test"])] , tags = Map.fromList [("testing", Set.fromList ["test"])]
, templates , templates

View file

@ -1,13 +1,66 @@
module Mock.Blog.Path ( module Mock.Blog.Path (
simple bothCustom
, bothDefault
, customArticles
, customArticlesDefaultPages
, customPages
, customPagesDefaultArticles
, defaultArticles
, defaultPages
) where ) where
import Blog.Path (Path(..)) import Blog.Path (Path(..))
simple :: Path defaultArticles :: Path
simple = Path { defaultArticles = Path {
articlesPath = Just "articles" articlesPath = Just "articles"
, pagesPath = Nothing , pagesPath = Nothing
, remarkableConfig = Nothing , remarkableConfig = Nothing
, root = "/home/test/blog" , root = "test/Structure/defaultArticles"
}
defaultPages :: Path
defaultPages = Path {
articlesPath = Nothing
, pagesPath = Just "pages"
, remarkableConfig = Nothing
, root = "test/Structure/defaultPages"
}
bothDefault :: Path
bothDefault = Path {
articlesPath = Just "articles"
, pagesPath = Just "pages"
, remarkableConfig = Nothing
, root = "test/Structure/both"
}
customArticles :: Path
customArticles = Path {
articlesPath = Just "customArticles"
, pagesPath = Nothing
, remarkableConfig = Nothing
, root = "test/Structure/custom"
}
bothCustom :: Path
bothCustom = customArticles {
pagesPath = Just "customPages"
}
customPages :: Path
customPages = bothCustom {
articlesPath = Nothing
}
customArticlesDefaultPages :: Path
customArticlesDefaultPages = bothDefault {
articlesPath = Just "customArticles"
, pagesPath = Just "pages"
}
customPagesDefaultArticles :: Path
customPagesDefaultArticles = customArticlesDefaultPages {
articlesPath = Just "articles"
, pagesPath = Just "customPages"
} }

40
test/Structure.hs Normal file
View file

@ -0,0 +1,40 @@
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)
]

View file

@ -3,10 +3,12 @@ module Tests (
) where ) where
import Distribution.TestSuite import Distribution.TestSuite
import qualified Structure (test)
import Utils (tag) import Utils (tag)
import qualified XML.Card (test) import qualified XML.Card (test)
tests :: IO [Test] tests :: IO [Test]
tests = return $ tag "xml" <$> [ tests = return $ tag "xml" <$> [
XML.Card.test XML.Card.test
, Structure.test
] ]

View file

@ -4,9 +4,11 @@ module Utils (
, assertEqual , assertEqual
, simpleTest , simpleTest
, tag , tag
, testDataPath
) where ) where
import Distribution.TestSuite import Distribution.TestSuite
import System.FilePath ((</>))
import Text.Printf (printf) import Text.Printf (printf)
tagInstance :: String -> TestInstance -> TestInstance tagInstance :: String -> TestInstance -> TestInstance
@ -43,3 +45,5 @@ assertEqual :: (Show a, Eq a) => String -> a -> a -> (Bool, IO Progress, String)
assertEqual what a b = assertEqual what a b =
(a == b, wrong (what ++ " do not match !") a b, what ++ " ok") (a == b, wrong (what ++ " do not match !") a b, what ++ " ok")
testDataPath :: FilePath -> FilePath
testDataPath = ("test" </>)

View file

@ -16,16 +16,13 @@ import Mock.ArticlesList as ArticlesList (
) )
import Pretty ((.$)) import Pretty ((.$))
import System.FilePath ((</>)) import System.FilePath ((</>))
import Utils (assertAll, assertEqual, simpleTest, tag) import Utils (assertAll, assertEqual, simpleTest, tag, testDataPath)
testDataPath :: FilePath
testDataPath = "test/XML/Card/Output"
check :: HasCard a => IO Blog -> a -> FilePath -> IO Progress check :: HasCard a => IO Blog -> a -> FilePath -> IO Progress
check getBlog input expectedFile = check getBlog input expectedFile =
getBlog >>= runReaderT (do getBlog >>= runReaderT (do
actual <- renderTextT $ maybe (return ()) (DOM.Card.make input) =<< (asks $urls.$cards) actual <- renderTextT $ maybe (return ()) (DOM.Card.make input) =<< (asks $urls.$cards)
expected <- liftIO . Lazy.readFile $ testDataPath </> expectedFile expected <- liftIO . Lazy.readFile $ testDataPath "XML/Card/Output" </> expectedFile
liftIO $ assertAll [ liftIO $ assertAll [
assertEqual "card HTML output" expected actual assertEqual "card HTML output" expected actual
] ]