hablo/test/Mock/Blog.hs

{-# LANGUAGE NamedFieldPuns #-}
module Mock.Blog (
      noCards
    , noRSS
    , simple
    , subPath
  ) where

import Blog (Blog(..))
import qualified Data.Map as Map (fromList)
import qualified Data.Set as Set (fromList)
import qualified Mock.Article (simple)
import qualified Mock.Blog.Path (defaultArticles)
import qualified Mock.Blog.Skin (simple)
import qualified Mock.Blog.Template (simple)
import qualified Mock.Blog.URL (simple, subPath, noCards)
import qualified Mock.Blog.Wording (defaultWording)

simple :: IO Blog
simple =
  let wording = Mock.Blog.Wording.defaultWording in do
  templates <- Mock.Blog.Template.simple
  return $ Blog {
        articles = Map.fromList [("test", Mock.Article.simple)]
      , hasRSS = True
      , name = "The Test Blog"
      , pages = Map.fromList []
      , path = Mock.Blog.Path.defaultArticles
      , skin = Mock.Blog.Skin.simple
      , tags = Map.fromList [("testing", Set.fromList ["test"])]
      , templates
      , urls = Mock.Blog.URL.simple
      , wording
    }

subPath :: IO Blog
subPath = (\b -> b {urls = Mock.Blog.URL.subPath}) <$> simple

noCards :: IO Blog
noCards = (\b -> b {urls = Mock.Blog.URL.noCards}) <$> simple

noRSS :: IO Blog
noRSS = (\b -> b {hasRSS = False}) <$> simple