Remove redundant imports following simplifications in 9a11840

.gitignore

@@ -1,2 +1,5 @@
 /dist-newstyle/*
 .ghc.environment.*
+*.o
+*.hi
+Main

README.md

@@ -62,6 +62,18 @@ mkdir -p ~/.sjw
 cp -r src/ ~/.sjw/unitJS
 ```
 
+Then, the static data used by hablo need to be available in a XDG path. Depending on whether you are installing for your user or system-wide, you may want to perform something either
+
+```bash
+cp -R share ~/.local/share/hablo
+```
+
+or
+
+```bash
+sudo cp -R share /usr/local/share/hablo
+```
+
 ### Using hablo (tutorials)
 
 Wanna give it a try ? Start by [generating your blog](https://git.marvid.fr/Tissevert/hablo/wiki/Generating%20your%20blog)

ghc-template.scm

@@ -1,11 +1,7 @@
-(use-modules (gnu packages haskell-xyz)
-             (gnu packages haskell-web)
-             (guix build-system haskell)
-             (guix download)
-             (guix gexp)
-             (guix git-download)
-             (guix licenses)
-             (guix packages))
+(use-modules ((guix build-system haskell) #:select (hackage-uri haskell-build-system))
+             ((guix download) #:select (url-fetch))
+             ((guix licenses) #:select (bsd-3))
+             ((guix packages) #:select (base32 origin package)))
 
 (package
   (name "ghc-template")

guix.scm

@@ -1,4 +1,5 @@
-(use-modules (gnu packages haskell-xyz)
+(use-modules (gnu packages haskell-check)
+             (gnu packages haskell-xyz)
              (gnu packages haskell-web)
              (guix build-system haskell)
              (guix download)
@@ -19,9 +20,11 @@
           #:recursive? #t
           #:select? (git-predicate %source-dir)))
     (build-system haskell-build-system)
+    (propagated-inputs (list sjw-unitjs))
     (inputs
       (list ghc-aeson
             ghc-attoparsec
+            ghc-hunit
             ghc-lucid
             ghc-optparse-applicative
             ghc-parsec
@@ -29,10 +32,19 @@
             ghc-sjw
             ghc-template
             ghc-xdg-basedir))
+    (arguments
+      `(#:phases
+        (modify-phases %standard-phases
+          (add-after 'install 'copy-static-resources
+            (lambda* (#:key outputs #:allow-other-keys)
+              (let ((out (assoc-ref outputs "out")))
+                (copy-recursively "share" (string-append out "/share/hablo"))))))))
     (native-search-paths
       (list
         (search-path-specification (variable "SJW_PATH")
-                                   (files '("lib/SJW")))))
+                                   (files '("lib/SJW")))
+        (search-path-specification (variable "XDG_DATA_DIRS")
+                                   (files '("share")))))
     (home-page "https://git.marvid.fr/Tissevert/SJW")
     (synopsis "The Simple Javascript Wrench")
     (description

hablo.cabal

@@ -23,9 +23,6 @@ maintainer:          tissevert+devel@marvid.fr
 category:            Web
 extra-source-files:  CHANGELOG.md
 build-type:          Simple
-data-dir:            share
-data-files:          js/*.js
-                     defaultWording.conf
 
 library
   exposed-modules:     Arguments
@@ -46,7 +43,6 @@ library
                      , JSON
                      , Markdown
                      , Page
-                     , Paths_hablo
                      , Pretty
                      , RSS
   -- other-extensions:
@@ -65,13 +61,13 @@ library
                      , time >= 1.8.0 && < 1.12
                      , SJW >= 0.1.2 && < 0.2
                      , unix >= 2.7.2 && < 2.8
+                     , xdg-basedir >= 0.2.2 && < 0.3
   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
                      , hablo
@@ -80,8 +76,8 @@ executable hablo
   default-language:    Haskell2010
 
 test-suite tests
-  type:                detailed-0.9
-  test-module:         Tests
+  type:                exitcode-stdio-1.0
+  main-is:             Main.hs
   other-modules:       Mock.Arguments
                      , Mock.Article
                      , Mock.ArticlesList
@@ -99,11 +95,11 @@ test-suite tests
                      , XML.Card.Component
                      , XML.Card.Output
   build-depends:       base
-                     , Cabal
                      , containers
                      , directory
                      , filepath
                      , hablo
+                     , HUnit
                      , lucid
                      , mtl
                      , text

src/Arguments.hs

@@ -2,22 +2,23 @@
 module Arguments (
       Arguments(..)
     , get
+    , version
   ) where
 
 #if !MIN_VERSION_base(4,11,0)
 import Data.Monoid ((<>))
 #endif
-import Data.Version (showVersion)
-import Control.Applicative ((<|>), (<**>), optional)
-import Options.Applicative (
-      Parser, ReadM, argument, auto, eitherReader, execParser, flag', fullDesc
-    , header, help, helper, info, long, metavar, short, str, switch, value
-  )
+import Control.Applicative ((<**>), optional)
+import Options.Applicative
+  ( Parser, ReadM, argument, auto, eitherReader, execParser, fullDesc, header
+  , help, helper, info, infoOption, long, metavar, short, str, switch, value )
 import qualified Options.Applicative as Optparse (option)
-import qualified Paths_hablo as Hablo (version)
 import System.FilePath (dropTrailingPathSeparator, isValid)
 
-data Arguments = BlogConfig {
+version :: String
+version = "0.3.0.0"
+
+data Arguments = Arguments {
       sourceDir :: FilePath
     , articlesPath :: Maybe FilePath
     , bannerPath :: Maybe FilePath
@@ -35,7 +36,6 @@ data Arguments = BlogConfig {
     , siteURL :: Maybe String
     , wording :: Maybe FilePath
   }
-  | Version
 
 option :: ReadM a -> Char -> String -> String -> String -> Parser (Maybe a)
 option readM aShort aLong aMetavar aHelpMessage =
@@ -47,8 +47,8 @@ option readM aShort aLong aMetavar aHelpMessage =
       <> help aHelpMessage
     )
 
-blogConfig :: Parser Arguments
-blogConfig = BlogConfig
+arguments :: Parser Arguments
+arguments = Arguments
   <$> argument filePath (value "." <> metavar "INPUT_DIR")
   <*> option filePath 'a' "articles" "DIRECTORY"
         "relative path to the directory containing the articles within INPUT_DIR"
@@ -81,16 +81,6 @@ blogConfig = BlogConfig
   <*> option filePath 'u' "site-url" "URL" "URL where the blog is published"
   <*> option filePath 'w' "wording" "FILE" "path to the file containing the wording to use"
 
-version :: Parser Arguments
-version = flag' Version (
-      long "version"
-    <> short 'v'
-    <> help "print the version number"
-  )
-
-arguments :: Parser Arguments
-arguments = blogConfig <|> version
-
 filePath :: ReadM FilePath
 filePath = eitherReader $ \path ->
   if isValid path
@@ -98,8 +88,10 @@ filePath = eitherReader $ \path ->
     else Left "This string doesn't represent a valid path"
 
 get :: IO Arguments
-get = do
-  execParser $
-    info
-      (arguments <**> helper)
-      (fullDesc <> header ("Hablo v" ++ showVersion Hablo.version))
+get = execParser
+  (info (arguments <**> showVersion <**> helper)
+        (fullDesc <> header ("Hablo v" ++ version)))
+  where
+    showVersion = infoOption
+      version
+      (long "version" <> short 'v' <> help "print current version")

src/Blog/Wording.hs

@@ -12,7 +12,7 @@ import Data.Map (Map)
 import qualified Data.Map as Map (empty, fromList, keys, map, union)
 import Data.Text (Text)
 import qualified Data.Text as Text (pack)
-import Paths_hablo (getDataFileName)
+import Files (getXDGData)
 import Text.ParserCombinators.Parsec (
       Parser
     , (<|>)
@@ -64,6 +64,6 @@ wordingP = Map.map Text.pack . Map.fromList <$>
 
 build :: Arguments -> IO Wording
 build arguments = do
-  defaultWording <- getDataFileName "defaultWording.conf"
+  defaultWording <- getXDGData "defaultWording.conf"
   let wordingFiles = maybe id (:) (wording arguments) $ [defaultWording]
   Wording <$> foldM addWording Map.empty wordingFiles

src/Files.hs

@@ -3,9 +3,12 @@ module Files (
     , absoluteLink
     , filePath
     , find
+    , getXDGData
   ) where
 
-import System.Directory (doesDirectoryExist, doesFileExist, listDirectory)
+import System.Directory (doesDirectoryExist, doesFileExist, doesPathExist, listDirectory)
+import System.Environment.XDG.BaseDir (getAllDataDirs)
+import System.Exit (die)
 import System.FilePath ((</>))
 
 data File = File FilePath | Dir FilePath
@@ -30,3 +33,14 @@ find path =
   filePath (Dir path) >>= emptyIfMissing (fmap ((path </>) <$>) . listDirectory)
   where
     emptyIfMissing = either (\_ -> return [])
+
+getXDGData :: FilePath -> IO FilePath
+getXDGData resource = getAllDataDirs relativePath >>= findFirst
+  where
+    relativePath = "hablo" </> resource
+    findFirst [] = die ("Install is broken: "
+                       <> relativePath
+                       <> " directory wasn't found in any of $XDG_DATA_DIRS")
+    findFirst (path:paths) = do
+      fileExists <- doesPathExist path
+      if fileExists then pure path else findFirst paths

src/JS.hs

@@ -13,8 +13,8 @@ import Data.ByteString.Lazy (
   )
 import Data.ByteString.Lazy.Char8 (pack)
 import Data.Text.Encoding (encodeUtf8)
+import Files (getXDGData)
 import JSON (exportBlog)
-import Paths_hablo (getDataDir)
 import Pretty ((.$))
 import SJW (compile, source)
 import System.Directory (createDirectoryIfMissing)
@@ -44,7 +44,7 @@ generateConfig destinationDir = do
 
 generateMain :: FilePath -> IO ()
 generateMain destinationDir = do
-  habloSources <- (</> "js") <$> getDataDir
+  habloSources <- getXDGData "js"
   compile (source [destinationDir, "unitJS", habloSources])
     >>= either abort (output . fst)
   where

src/Main.hs

@@ -1,23 +1,16 @@
 module Main where
 
-import Arguments (Arguments(..))
+import Arguments (Arguments(..), version)
 import qualified Arguments (get)
 import qualified Blog (build)
 import Control.Monad.Reader (runReaderT)
-import Data.Version (showVersion)
 import qualified HTML (generate)
 import qualified JS (generate)
-import qualified Paths_hablo as Hablo (version)
 import qualified RSS (generate)
 import System.Exit (exitSuccess)
 
 main :: IO ()
-main = do
-  arguments <- Arguments.get
-  case arguments of
-    Version -> (putStrLn $ showVersion Hablo.version) >> exitSuccess
-    config@(BlogConfig {}) -> Blog.build config >>= runReaderT (do
-        HTML.generate
-        JS.generate
-        RSS.generate
-      )
+main = Arguments.get >>= Blog.build >>= runReaderT
+  (do HTML.generate
+      JS.generate
+      RSS.generate)

src/TODO

@@ -1,3 +1,6 @@
-pre {
-  white-space: pre-wrap;
-}
+- dans Arguments.hs, vérifier que l'implémentation de option est pas déjà dans la lib optparse-applicative
+		=> ah non en fait c'est une fonction locale au fichier juste mal nommée, corriger ça
+- le Wording, c'était quand même pas l'idée du siècle -> ça pourrait pas tout revenir dans un thème qui serait du HTML ?
+- faque Template aussi
+- «Pretty» Oo ? mais c'est juste des Utils en fait
+- améliorer un peu la gestion des erreurs ? (ExceptT IO…) pas prio mais ça nuirait pas

test/Main.hs

@@ -0,0 +1,10 @@
+module Main where
+
+import qualified Structure (test)
+import Test.HUnit (Test(..), runTestTTAndExit)
+import qualified XML.Card (test)
+
+main :: IO ()
+main = runTestTTAndExit $ TestList
+  [ XML.Card.test
+  , Structure.test ]

test/Mock/Arguments.hs

@@ -16,7 +16,7 @@ import Arguments (Arguments(..))
 import Utils (testDataPath)
 
 defaultArticles :: Arguments
-defaultArticles = BlogConfig {
+defaultArticles = Arguments {
       sourceDir = testDataPath "Structure/defaultArticles"
     , articlesPath = Nothing
     , bannerPath = Nothing

test/Structure.hs

@@ -5,36 +5,37 @@ module Structure (
 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)
+import Test.HUnit (Test(..), assertEqual)
+import Utils (labeled, testGroup)
 
-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
+checkPath :: Arguments -> Maybe Path -> Test
+checkPath input expected = TestCase . withCurrentDirectory root $
+    either (\_ -> Nothing) Just <$> Path.build root input
+      >>= assertEqual "Incorrect path detected by hablo" expected
   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)
-  ]
+test = testGroup "Blog structure" $ labeled
+  [ ("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) ]

test/Tests.hs

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

test/Utils.hs

@@ -1,49 +1,17 @@
 {-# LANGUAGE NamedFieldPuns #-}
-module Utils (
-      assertAll
-    , assertEqual
-    , simpleTest
-    , tag
-    , testDataPath
-  ) where
+module Utils
+  ( labeled
+  , testDataPath
+  , testGroup ) where
 
-import Distribution.TestSuite
 import System.FilePath ((</>))
-import Text.Printf (printf)
-
-tagInstance :: String -> TestInstance -> TestInstance
-tagInstance tagName testInstance = testInstance {
-    tags = tagName : (tags testInstance)
-  }
-
-tag :: String -> Test -> Test
-tag tagName (Test testInstance) = Test (tagInstance tagName testInstance)
-tag tagName group = group {groupTests = tag tagName <$> groupTests group}
-
-simpleTest :: (String, IO Progress) -> Test
-simpleTest (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")
+import Test.HUnit (Test(..))
 
 testDataPath :: FilePath -> FilePath
 testDataPath = ("test" </>)
+
+testGroup :: String -> [Test] -> Test
+testGroup name = TestLabel name . TestList
+
+labeled :: [(String, Test)] -> [Test]
+labeled = fmap (uncurry TestLabel)

test/XML/Card.hs

@@ -2,10 +2,10 @@ module XML.Card (
     test
   ) where
 
-import Distribution.TestSuite
-import Utils (tag)
+import Test.HUnit (Test)
+import Utils (testGroup)
 import qualified XML.Card.Component as Component (test)
 import qualified XML.Card.Output as Output (test)
 
 test :: Test
-test = tag "card" $ testGroup "Cards" [Component.test, Output.test]
+test = testGroup "Cards" [Component.test, Output.test]

test/XML/Card/Component.hs

@@ -7,83 +7,84 @@ 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)
+import Test.HUnit (Test(..), assertEqual)
+import Utils (labeled, testGroup)
 
-check :: HasCard a => IO Blog -> a -> (Text, Text, Maybe String, String, String) -> IO Progress
+check :: HasCard a => IO Blog -> a -> (Text, Text, Maybe String, String, String) -> IO ()
 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
-    )
+  getBlog >>= runReaderT checkCard
+  where
+    checkCard = do
+      liftIO . assertEqual "card types" expectedCT =<< cardType input
+      liftIO . assertEqual "descriptions" expectedD =<< description input
+      liftIO . assertEqual "images" expectedI =<< image input
+      liftIO . assertEqual "titles" expectedT =<< title input
+      liftIO . assertEqual "urls" expectedU =<< urlPath input
 
 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"
-        ))
-  ]
+articleCard = testGroup "Article cards" $ labeled
+  [ ("simple article components"
+    , TestCase $ check Blog.simple Article.simple
+        ( "article"
+        , "It's a test"
+        , Just "test.png"
+        , "Some test"
+        , "articles/test.html" ))
+  , ("article components without description"
+    , TestCase $ 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"
+    , TestCase $ 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"
-        )))
-  ]
+articlesListCard = testGroup "Articles list cards" $ labeled
+  [ ("short untagged page component"
+    , TestCase (ArticlesList.shortMain >>=
+                 (flip (check Blog.simple)
+                   ( "website"
+                   , "Latest articles"
+                   , Nothing
+                   , "The Test Blog"
+                   , "index.html"))))
+    , ("long untagged page component"
+      , TestCase (ArticlesList.longMain >>=
+                   (flip (check Blog.simple)
+                     ( "website"
+                     , "All articles"
+                     , Nothing
+                     , "The Test Blog"
+                     , "all.html"))))
+    , ("short tagged page component"
+      , TestCase (ArticlesList.shortTesting >>=
+                   (flip (check Blog.simple)
+                     ( "website"
+                     , "Latest articles tagged testing"
+                     , Nothing
+                     , "The Test Blog - testing"
+                     , "testing/index.html"))))
+    , ("long tagged page component"
+      , TestCase (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]
+test = testGroup "Cards components" [articleCard, articlesListCard]

test/XML/Card/Output.hs

@@ -6,7 +6,6 @@ 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)
@@ -16,34 +15,47 @@ import Mock.ArticlesList as ArticlesList (
   )
 import Pretty ((.$))
 import System.FilePath ((</>))
-import Utils (assertAll, assertEqual, simpleTest, tag, testDataPath)
+import Test.HUnit (Test(..), assertEqual)
+import Utils (labeled, testDataPath, testGroup)
 
-check :: HasCard a => IO Blog -> a -> FilePath -> IO Progress
-check getBlog input expectedFile =
-  getBlog >>= runReaderT (do
+check :: HasCard a => IO Blog -> a -> FilePath -> IO ()
+check getBlog input expectedFile = getBlog >>= runReaderT checkHTML
+  where
+    checkHTML = do
       actual <- renderTextT $ maybe (return ()) (DOM.Card.make input) =<< (asks $urls.$cards)
       expected <- liftIO . Lazy.readFile $ testDataPath "XML/Card/Output" </> expectedFile
-      liftIO $ assertAll [
-          assertEqual "card HTML output" expected actual
-        ]
-    )
+      liftIO $ 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")
-  ]
+articleCard = testGroup "Article cards" $ labeled
+  [ ("simple article output"
+    , TestCase $ check Blog.simple Article.simple "simple.html")
+  , ("article output without description"
+    , TestCase $ check Blog.simple Article.noDescription "noDescription.html")
+  , ("article output without image"
+    , TestCase $ check Blog.simple Article.noImage "noImage.html")
+  , ("no card article output"
+    , TestCase $ 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")
-  ]
+articlesListCard = testGroup "Article list cards" $ labeled
+  [ ("short untagged page output"
+    , TestCase
+        (ArticlesList.shortMain >>= flip (check Blog.simple) "shortMain.html"))
+  , ("long untagged page output"
+    , TestCase
+        (ArticlesList.longMain >>= flip (check Blog.simple) "longMain.html"))
+  , ("short tagged page output"
+    , TestCase
+        (ArticlesList.shortTesting
+          >>= flip (check Blog.simple) "shortTesting.html"))
+  , ("long tagged page output"
+    , TestCase
+        (ArticlesList.longTesting
+          >>= flip (check Blog.simple) "longTesting.html"))
+  , ("no card articlesList output"
+    , TestCase
+        (ArticlesList.shortMain >>= flip (check Blog.noCards) "/dev/null")) ]
 
 test :: Test
-test = tag "output" $ testGroup "Cards outputs" [articleCard, articlesListCard]
+test = testGroup "Cards outputs" [articleCard, articlesListCard]