{-# 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 }