hablo-1.1.0.1: src/JSON.hs

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NamedFieldPuns #-}
module JSON (
    exportBlog
  ) where

import Blog (Blog, Path, Skin, URL, Wording)
import qualified Blog (Blog(..))
import Data.Aeson (Options(..), ToJSON(..), genericToEncoding, defaultOptions)
import Data.Map (Map, mapWithKey)
import qualified Data.Map as Map (filter, keys)
import qualified Data.Set as Set (elems, member)
import GHC.Generics
import Markdown (Markdown, MarkdownContent(..))
import qualified Markdown (Markdown(..))

data MarkdownExport = MarkdownExport {
      title :: String
    , metadata :: Map String String
    , bodyOffset :: Int
    , tagged :: Maybe [String]
  } deriving (Generic)

instance ToJSON MarkdownExport where
  toEncoding = genericToEncoding (defaultOptions {omitNothingFields = True})

exportMarkdown :: Maybe [String] -> Markdown -> MarkdownExport
exportMarkdown tagged markdown = MarkdownExport {
      title = Markdown.title markdown
    , metadata = Markdown.metadata markdown
    , bodyOffset = Markdown.bodyOffset markdown
    , tagged
  }

data BlogExport = BlogExport {
      articles :: Map String MarkdownExport
    , hasRSS :: Bool
    , path :: Path
    , pages :: Map String MarkdownExport
    , skin :: Skin
    , tags :: Map String [String]
    , urls :: URL
    , wording :: Wording
  } deriving (Generic)

instance ToJSON BlogExport where
  toEncoding = genericToEncoding defaultOptions

exportBlog :: Blog -> BlogExport
exportBlog blog = BlogExport {
      articles = getArticles $ getMarkdown <$> Blog.articles blog
    , hasRSS = Blog.hasRSS blog
    , pages = getPages $ getMarkdown <$> Blog.pages blog
    , path = Blog.path blog
    , skin = Blog.skin blog
    , tags = Set.elems <$> Blog.tags blog
    , urls = Blog.urls blog
    , wording = Blog.wording blog
  }
  where
    tag key = Just . Map.keys . Map.filter (Set.member key) $ Blog.tags blog
    getArticles = mapWithKey (exportMarkdown . tag)
    getPages = mapWithKey (\_-> exportMarkdown Nothing)