diff --git a/hablo.cabal b/hablo.cabal
index 88e3628..f5e4f4c 100644
--- a/hablo.cabal
+++ b/hablo.cabal
@@ -94,11 +94,14 @@ test-suite tests
, Mock.Markdown
, Utils
, XML.Card
+ , XML.Card.Component
+ , XML.Card.Output
build-depends: base
, containers
, filepath
, Cabal
, hablo-internals
+ , lucid
, mtl
, text
hs-source-dirs: test
diff --git a/test/Mock/Blog.hs b/test/Mock/Blog.hs
index 92bd3d0..279646c 100644
--- a/test/Mock/Blog.hs
+++ b/test/Mock/Blog.hs
@@ -1,7 +1,8 @@
{-# LANGUAGE NamedFieldPuns #-}
module Mock.Blog (
- simple
+ noCards
, noRSS
+ , simple
) where
import Blog (Blog(..))
@@ -11,7 +12,7 @@ import qualified Mock.Article (simple)
import qualified Mock.Blog.Path (simple)
import qualified Mock.Blog.Skin (simple)
import qualified Mock.Blog.Template (simple)
-import qualified Mock.Blog.URL (simple)
+import qualified Mock.Blog.URL (simple, noCards)
import qualified Mock.Blog.Wording (defaultWording)
simple :: IO Blog
@@ -31,5 +32,8 @@ simple =
, wording
}
+noCards :: IO Blog
+noCards = (\b -> b {urls = Mock.Blog.URL.noCards}) <$> simple
+
noRSS :: IO Blog
noRSS = (\b -> b {hasRSS = False}) <$> simple
diff --git a/test/Mock/Blog/URL.hs b/test/Mock/Blog/URL.hs
index 6954787..5d14fa4 100644
--- a/test/Mock/Blog/URL.hs
+++ b/test/Mock/Blog/URL.hs
@@ -1,12 +1,16 @@
module Mock.Blog.URL (
- simple
+ noCards
+ , simple
) where
import Blog.URL (URL(..))
simple :: URL
simple = URL {
- cards = Nothing
+ cards = Just "https://test.net"
, comments = Nothing
, rss = Nothing
}
+
+noCards :: URL
+noCards = simple {cards = Nothing}
diff --git a/test/XML/Card.hs b/test/XML/Card.hs
index 58fb402..315ade7 100644
--- a/test/XML/Card.hs
+++ b/test/XML/Card.hs
@@ -1,96 +1,11 @@
-{-# LANGUAGE OverloadedStrings #-}
module XML.Card (
test
) where
-import Blog (Blog)
-import Control.Monad.IO.Class (MonadIO(..))
-import Control.Monad.Reader (runReaderT)
-import Data.Text (Text)
import Distribution.TestSuite
-import DOM.Card (HasCard(..))
-import Mock.Blog as Blog (simple)
-import Mock.Article as Article (noDescription, noImage, simple)
-import Mock.ArticlesList as ArticlesList (
- longMain, longTesting, shortMain, shortTesting
- )
-import Utils (assertAll, assertEqual, simpleTest, tag)
-
-checkCard :: HasCard a => IO Blog -> a -> (Text, Text, Maybe String, String, String) -> IO Progress
-checkCard getBlog input (expectedCT, expectedD, expectedI, expectedT, expectedU) =
- getBlog >>= runReaderT (
- sequence [
- assertEqual "card types" expectedCT <$> cardType input
- , assertEqual "descriptions" expectedD <$> description input
- , assertEqual "images" expectedI <$> image input
- , assertEqual "titles" expectedT <$> title input
- , assertEqual "urls" expectedU <$> urlPath input
- ] >>= liftIO . assertAll
- )
-
-articleCard :: Test
-articleCard = tag "article" . testGroup "Article cards" $ simpleTest <$> [
- ("simple article", checkCard Blog.simple Article.simple (
- "article"
- , "It's a test"
- , Just "test.png"
- , "Some test"
- , "articles/test.html"
- )
- )
- , ("article without description", checkCard Blog.simple Article.noDescription (
- "article"
- , "A new article on The Test Blog"
- , Just "test.png"
- , "Some test"
- , "articles/test.html"
- )
- )
- , ("article without image", checkCard Blog.simple Article.noImage (
- "article"
- , "It's a test"
- , Nothing
- , "Some test"
- , "articles/test.html"
- )
- )
- ]
-
-articlesListCard :: Test
-articlesListCard = tag "articlesList" . testGroup "Articles list cards" $ simpleTest <$> [
- ("short untagged page", ArticlesList.shortMain >>= (flip (checkCard Blog.simple) (
- "website"
- , "Latest articles"
- , Nothing
- , "The Test Blog"
- , "index.html"
- )
- ))
- , ("long untagged page", ArticlesList.longMain >>= (flip (checkCard Blog.simple) (
- "website"
- , "All articles"
- , Nothing
- , "The Test Blog"
- , "all.html"
- )
- ))
- , ("short tagged page", ArticlesList.shortTesting >>= (flip (checkCard Blog.simple) (
- "website"
- , "Latest articles tagged testing"
- , Nothing
- , "The Test Blog - testing"
- , "testing/index.html"
- )
- ))
- , ("long tagged page", ArticlesList.longTesting >>= (flip (checkCard Blog.simple) (
- "website"
- , "All articles tagged testing"
- , Nothing
- , "The Test Blog - testing"
- , "testing/all.html"
- )
- ))
- ]
+import Utils (tag)
+import qualified XML.Card.Component as Component (test)
+import qualified XML.Card.Output as Output (test)
test :: Test
-test = tag "card" $ testGroup "Cards" [articleCard, articlesListCard]
+test = tag "card" $ testGroup "Cards" [Component.test, Output.test]
diff --git a/test/XML/Card/Component.hs b/test/XML/Card/Component.hs
new file mode 100644
index 0000000..db5a4bc
--- /dev/null
+++ b/test/XML/Card/Component.hs
@@ -0,0 +1,89 @@
+{-# LANGUAGE OverloadedStrings #-}
+module XML.Card.Component (
+ test
+ ) where
+
+import Blog (Blog)
+import Control.Monad.IO.Class (MonadIO(..))
+import Control.Monad.Reader (runReaderT)
+import Data.Text (Text)
+import Distribution.TestSuite
+import DOM.Card (HasCard(..))
+import Mock.Blog as Blog (simple)
+import Mock.Article as Article (noDescription, noImage, simple)
+import Mock.ArticlesList as ArticlesList (
+ longMain, longTesting, shortMain, shortTesting
+ )
+import Utils (assertAll, assertEqual, simpleTest, tag)
+
+check :: HasCard a => IO Blog -> a -> (Text, Text, Maybe String, String, String) -> IO Progress
+check getBlog input (expectedCT, expectedD, expectedI, expectedT, expectedU) =
+ getBlog >>= runReaderT (
+ sequence [
+ assertEqual "card types" expectedCT <$> cardType input
+ , assertEqual "descriptions" expectedD <$> description input
+ , assertEqual "images" expectedI <$> image input
+ , assertEqual "titles" expectedT <$> title input
+ , assertEqual "urls" expectedU <$> urlPath input
+ ] >>= liftIO . assertAll
+ )
+
+articleCard :: Test
+articleCard = tag "article" . testGroup "Article cards" $ simpleTest <$> [
+ ("simple article components", check Blog.simple Article.simple (
+ "article"
+ , "It's a test"
+ , Just "test.png"
+ , "Some test"
+ , "articles/test.html"
+ ))
+ , ("article components without description", check Blog.simple Article.noDescription (
+ "article"
+ , "A new article on The Test Blog"
+ , Just "test.png"
+ , "Some test"
+ , "articles/test.html"
+ ))
+ , ("article components without image", check Blog.simple Article.noImage (
+ "article"
+ , "It's a test"
+ , Nothing
+ , "Some test"
+ , "articles/test.html"
+ ))
+ ]
+
+articlesListCard :: Test
+articlesListCard = tag "articlesList" . testGroup "Articles list cards" $ simpleTest <$> [
+ ("short untagged page component", ArticlesList.shortMain >>= (flip (check Blog.simple) (
+ "website"
+ , "Latest articles"
+ , Nothing
+ , "The Test Blog"
+ , "index.html"
+ )))
+ , ("long untagged page component", ArticlesList.longMain >>= (flip (check Blog.simple) (
+ "website"
+ , "All articles"
+ , Nothing
+ , "The Test Blog"
+ , "all.html"
+ )))
+ , ("short tagged page component", ArticlesList.shortTesting >>= (flip (check Blog.simple) (
+ "website"
+ , "Latest articles tagged testing"
+ , Nothing
+ , "The Test Blog - testing"
+ , "testing/index.html"
+ )))
+ , ("long tagged page component", ArticlesList.longTesting >>= (flip (check Blog.simple) (
+ "website"
+ , "All articles tagged testing"
+ , Nothing
+ , "The Test Blog - testing"
+ , "testing/all.html"
+ )))
+ ]
+
+test :: Test
+test = tag "component" $ testGroup "Cards components" [articleCard, articlesListCard]
diff --git a/test/XML/Card/Output.hs b/test/XML/Card/Output.hs
new file mode 100644
index 0000000..4e316e2
--- /dev/null
+++ b/test/XML/Card/Output.hs
@@ -0,0 +1,52 @@
+module XML.Card.Output (
+ test
+ ) where
+
+import Blog (Blog(..), URL(..))
+import Control.Monad.IO.Class (MonadIO(..))
+import Control.Monad.Reader (asks, runReaderT)
+import qualified Data.Text.Lazy.IO as Lazy (readFile)
+import Distribution.TestSuite
+import DOM.Card (HasCard(..), make)
+import Lucid (renderTextT)
+import Mock.Blog as Blog (noCards, simple)
+import Mock.Article as Article (noDescription, noImage, simple)
+import Mock.ArticlesList as ArticlesList (
+ longMain, longTesting, shortMain, shortTesting
+ )
+import Pretty ((.$))
+import System.FilePath ((>))
+import Utils (assertAll, assertEqual, simpleTest, tag)
+
+testDataPath :: FilePath
+testDataPath = "test/XML/Card/Output"
+
+check :: HasCard a => IO Blog -> a -> FilePath -> IO Progress
+check getBlog input expectedFile =
+ getBlog >>= runReaderT (do
+ actual <- renderTextT $ maybe (return ()) (DOM.Card.make input) =<< (asks $urls.$cards)
+ expected <- liftIO . Lazy.readFile $ testDataPath > expectedFile
+ liftIO $ assertAll [
+ assertEqual "card HTML output" expected actual
+ ]
+ )
+
+articleCard :: Test
+articleCard = tag "article" . testGroup "Article cards" $ simpleTest <$> [
+ ("simple article output", check Blog.simple Article.simple "simple.html")
+ , ("article output without description", check Blog.simple Article.noDescription "noDescription.html")
+ , ("article output without image", check Blog.simple Article.noImage "noImage.html")
+ , ("no card article output", check Blog.noCards Article.simple "/dev/null")
+ ]
+
+articlesListCard :: Test
+articlesListCard = tag "article" . testGroup "Article cards" $ simpleTest <$> [
+ ("short untagged page output", ArticlesList.shortMain >>= flip (check Blog.simple) "shortMain.html")
+ , ("long untagged page output", ArticlesList.longMain >>= flip (check Blog.simple) "longMain.html")
+ , ("short tagged page output", ArticlesList.shortTesting >>= flip (check Blog.simple) "shortTesting.html")
+ , ("long tagged page output", ArticlesList.longTesting >>= flip (check Blog.simple) "longTesting.html")
+ , ("no card articlesList output", ArticlesList.shortMain >>= flip (check Blog.noCards) "/dev/null")
+ ]
+
+test :: Test
+test = tag "output" $ testGroup "Cards outputs" [articleCard, articlesListCard]
diff --git a/test/XML/Card/Output/longMain.html b/test/XML/Card/Output/longMain.html
new file mode 100644
index 0000000..4c130b3
--- /dev/null
+++ b/test/XML/Card/Output/longMain.html
@@ -0,0 +1 @@
+
\ No newline at end of file
diff --git a/test/XML/Card/Output/longTesting.html b/test/XML/Card/Output/longTesting.html
new file mode 100644
index 0000000..90cdb49
--- /dev/null
+++ b/test/XML/Card/Output/longTesting.html
@@ -0,0 +1 @@
+
\ No newline at end of file
diff --git a/test/XML/Card/Output/noDescription.html b/test/XML/Card/Output/noDescription.html
new file mode 100644
index 0000000..2568e41
--- /dev/null
+++ b/test/XML/Card/Output/noDescription.html
@@ -0,0 +1 @@
+
\ No newline at end of file
diff --git a/test/XML/Card/Output/noImage.html b/test/XML/Card/Output/noImage.html
new file mode 100644
index 0000000..920bac5
--- /dev/null
+++ b/test/XML/Card/Output/noImage.html
@@ -0,0 +1 @@
+
\ No newline at end of file
diff --git a/test/XML/Card/Output/shortMain.html b/test/XML/Card/Output/shortMain.html
new file mode 100644
index 0000000..2442979
--- /dev/null
+++ b/test/XML/Card/Output/shortMain.html
@@ -0,0 +1 @@
+
\ No newline at end of file
diff --git a/test/XML/Card/Output/shortTesting.html b/test/XML/Card/Output/shortTesting.html
new file mode 100644
index 0000000..95c3cc5
--- /dev/null
+++ b/test/XML/Card/Output/shortTesting.html
@@ -0,0 +1 @@
+
\ No newline at end of file
diff --git a/test/XML/Card/Output/simple.html b/test/XML/Card/Output/simple.html
new file mode 100644
index 0000000..8477739
--- /dev/null
+++ b/test/XML/Card/Output/simple.html
@@ -0,0 +1 @@
+
\ No newline at end of file