hablo/src/JSON.hs

60 lines
1.7 KiB
Haskell
Raw Normal View History

2019-02-04 18:30:23 +01:00
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NamedFieldPuns #-}
2019-01-27 21:41:21 +01:00
module JSON (
exportBlog
2019-01-27 21:41:21 +01:00
) where
2019-02-04 18:30:23 +01:00
import Article (Article)
import qualified Article (Article(..))
import Blog (Blog, Path, Skin, URL, Wording)
import qualified Blog (Blog(..))
import Control.Monad.Reader (ReaderT, ask)
2019-02-04 18:30:23 +01:00
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)
2019-02-04 18:30:23 +01:00
import GHC.Generics
data ArticleExport = ArticleExport {
title :: String
, bodyOffset :: Int
2019-02-15 14:13:43 +01:00
, metadata :: Map String String
, tagged :: [String]
2019-02-04 18:30:23 +01:00
} deriving (Generic)
instance ToJSON ArticleExport where
toEncoding = genericToEncoding defaultOptions
data BlogDB = BlogDB {
articles :: Map String ArticleExport
, path :: Path
, skin :: Skin
, tags :: Map String [String]
, urls :: URL
, wording :: Wording
2019-02-04 18:30:23 +01:00
} 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
2019-02-15 14:13:43 +01:00
, metadata = Article.metadata article
, tagged = Map.keys . Map.filter (Set.member key) $ Blog.tags blog
2019-02-04 18:30:23 +01:00
}
exportBlog :: ReaderT Blog IO ByteString
2019-02-04 18:30:23 +01:00
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
, urls = Blog.urls blog
, wording = Blog.wording blog
2019-02-04 18:30:23 +01:00
}