64 lines
1.9 KiB
Haskell
64 lines
1.9 KiB
Haskell
{-# 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)
|