58 lines
1.7 KiB
Haskell
58 lines
1.7 KiB
Haskell
{-# LANGUAGE DeriveGeneric #-}
|
|
{-# LANGUAGE NamedFieldPuns #-}
|
|
module JSON (
|
|
exportBlog
|
|
) where
|
|
|
|
import Article (Article)
|
|
import qualified Article (Article(..))
|
|
import Blog (Blog, Path, Skin, Wording)
|
|
import qualified Blog (Blog(..))
|
|
import Control.Monad.Reader (ReaderT, ask)
|
|
import Data.Aeson (ToJSON(..), genericToEncoding, defaultOptions, encode)
|
|
import Data.ByteString.Lazy (ByteString)
|
|
import Data.Map (Map, mapWithKey)
|
|
import qualified Data.Map as Map (filter, keys)
|
|
import qualified Data.Set as Set (elems, member)
|
|
import GHC.Generics
|
|
|
|
data ArticleExport = ArticleExport {
|
|
title :: String
|
|
, bodyOffset :: Int
|
|
, metadata :: Map String String
|
|
, tagged :: [String]
|
|
} deriving (Generic)
|
|
|
|
instance ToJSON ArticleExport where
|
|
toEncoding = genericToEncoding defaultOptions
|
|
|
|
data BlogDB = BlogDB {
|
|
articles :: Map String ArticleExport
|
|
, path :: Path
|
|
, skin :: Skin
|
|
, tags :: Map String [String]
|
|
, wording :: Wording
|
|
} deriving (Generic)
|
|
|
|
instance ToJSON BlogDB where
|
|
toEncoding = genericToEncoding defaultOptions
|
|
|
|
exportArticle :: Blog -> String -> Article -> ArticleExport
|
|
exportArticle blog key article = ArticleExport {
|
|
title = Article.title article
|
|
, bodyOffset = Article.bodyOffset article
|
|
, metadata = Article.metadata article
|
|
, tagged = Map.keys . Map.filter (Set.member key) $ Blog.tags blog
|
|
}
|
|
|
|
exportBlog :: ReaderT Blog IO ByteString
|
|
exportBlog = do
|
|
blog <- ask
|
|
return . encode $ BlogDB {
|
|
articles = mapWithKey (exportArticle blog) $ Blog.articles blog
|
|
, path = Blog.path blog
|
|
, skin = Blog.skin blog
|
|
, tags = Set.elems <$> Blog.tags blog
|
|
, wording = Blog.wording blog
|
|
}
|