Lay the basis for a very simple test suite

hablo.cabal

@@ -27,9 +27,8 @@ data-dir:            share
 data-files:          js/*.js
                      defaultWording.conf
 
-executable hablo
-  main-is:             Main.hs
-  other-modules:       Arguments
+library hablo-internals
+  exposed-modules:     Arguments
                      , Article
                      , ArticlesList
                      , Blog
@@ -66,6 +65,32 @@ executable hablo
                      , time >= 1.8.0 && < 1.9
                      , SJW >= 0.1.2 && < 0.2
                      , unix >= 2.7.2 && < 2.8
-  ghc-options:         -Wall -dynamic
+  ghc-options:         -Wall
   hs-source-dirs:      src
   default-language:    Haskell2010
+
+executable hablo
+  main-is:             src/Main.hs
+  other-modules:       Paths_hablo
+  -- other-extensions:
+  build-depends:       base >= 4.9.1 && < 4.13
+                     , hablo-internals
+                     , mtl >= 2.2.2 && < 2.3
+  ghc-options:         -Wall -dynamic
+  default-language:    Haskell2010
+
+test-suite tests
+  type:                detailed-0.9
+  test-module:         Tests
+  other-modules:       Mock.Article
+                     , Mock.Blog
+                     , XML.Card
+  build-depends:       base
+                     , containers
+                     , Cabal
+                     , hablo-internals
+                     , mtl
+                     , text
+  hs-source-dirs:      test
+  ghc-options:         -Wall
+  default-language:    Haskell2010

test/Mock/Article.hs

@@ -0,0 +1,53 @@
+module Mock.Article (
+      noDescription
+    , noImage
+    , noMeta
+    , simple
+  ) where
+
+import Article (Article(..))
+import qualified Data.Map as Map (fromList)
+import Markdown (Markdown(..))
+
+simple :: Article
+simple = Article (Markdown {
+      key = "test"
+    , path = "article/test"
+    , Markdown.title = "Some test"
+    , metadata = Map.fromList [
+            ("summary", "It's a test")
+          , ("featuredImage", "test.png")
+        ]
+    , bodyOffset = 3
+    , body = []
+  })
+
+noImage :: Article
+noImage = Article (Markdown {
+      key = "test"
+    , path = "article/test"
+    , Markdown.title = "Some test"
+    , metadata = Map.fromList [("summary", "It's a test")]
+    , bodyOffset = 3
+    , body = []
+  })
+
+noDescription :: Article
+noDescription = Article (Markdown {
+      key = "test"
+    , path = "article/test"
+    , Markdown.title = "Some test"
+    , metadata = Map.fromList [("featuredImage", "test.png")]
+    , bodyOffset = 3
+    , body = []
+  })
+
+noMeta :: Article
+noMeta = Article (Markdown {
+      key = "test"
+    , path = "article/test"
+    , Markdown.title = "Some test"
+    , metadata = Map.fromList []
+    , bodyOffset = 3
+    , body = []
+  })

test/Mock/Blog.hs

@@ -0,0 +1,8 @@
+module Mock.Blog (
+    simple
+  ) where
+
+import Blog (Blog)
+
+simple :: Blog
+simple = undefined

test/Tests.hs

@@ -0,0 +1,11 @@
+module Tests (
+    tests
+  ) where
+
+import Distribution.TestSuite
+import qualified XML.Card (test)
+
+tests :: IO [Test]
+tests = return [
+    XML.Card.test
+  ]

test/XML/Card.hs

@@ -0,0 +1,68 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+module XML.Card (
+    test
+  ) where
+
+import Article (Article(..))
+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, noMeta, simple)
+import Text.Printf (printf)
+
+simpleTest :: [String] -> (String, IO Progress) -> Test
+simpleTest tags (name, run) = Test testInstance
+  where
+    testInstance = TestInstance {
+          run
+        , name
+        , tags
+        , options = []
+        , setOption = \_ _ -> Right testInstance
+      }
+
+wrong :: Show a => String -> a -> a -> IO Progress
+wrong message expected actual = return . Finished . Fail $
+  printf "%s: %s vs. %s" message (show expected) (show actual)
+
+assertAll :: [(Bool, IO Progress, String)] -> IO Progress
+assertAll = foldr assert (return $ Finished Pass)
+  where
+    assert (bool, badIssue, checkMessage) next =
+      if bool then return $ Progress checkMessage next else badIssue
+
+assertEqual :: (Show a, Eq a) => String -> a -> a -> (Bool, IO Progress, String)
+assertEqual what a b =
+  (a == b, wrong (what ++ " do not match !") a b, what ++ " ok")
+
+checkCard :: Blog -> Article -> (Text, Text, Maybe String, String, String) -> IO Progress
+checkCard blog article (expectedCT, expectedD, expectedI, expectedT, expectedU) =
+  flip runReaderT blog $
+    sequence [
+          assertEqual "card types" expectedCT <$> cardType article
+        , assertEqual "descriptions" expectedD <$> description article
+        , assertEqual "images" expectedI <$> image article
+        , assertEqual "titles" expectedT <$> title article
+        , assertEqual "urls" expectedU <$> urlPath article
+      ] >>= liftIO . assertAll
+
+articleCard :: Test
+articleCard =
+  testGroup "Article cards" $ simpleTest ["xml", "card", "article"] <$> [
+      ("simple article", checkCard Blog.simple Article.simple (
+              "article"
+            , "It's a test"
+            , Just "test.png"
+            , "Some test"
+            , "https://test.net/articles/test.html"
+          )
+        )
+    ]
+
+test :: Test
+test = testGroup "Cards" [articleCard]