2019-02-04 18:30:23 +01:00
|
|
|
{-# LANGUAGE DeriveGeneric #-}
|
2019-02-05 17:31:11 +01:00
|
|
|
{-# LANGUAGE NamedFieldPuns #-}
|
2019-01-27 21:41:21 +01:00
|
|
|
module JSON (
|
2019-02-06 17:16:52 +01:00
|
|
|
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(..))
|
2019-12-21 12:50:38 +01:00
|
|
|
import Blog (Blog, Path, Skin, URL, Wording)
|
2019-02-22 23:29:35 +01:00
|
|
|
import qualified Blog (Blog(..))
|
2019-02-05 17:31:11 +01:00
|
|
|
import Control.Monad.Reader (ReaderT, ask)
|
2019-02-04 18:30:23 +01:00
|
|
|
import Data.Aeson (ToJSON(..), genericToEncoding, defaultOptions, encode)
|
2019-02-06 17:16:52 +01:00
|
|
|
import Data.ByteString.Lazy (ByteString)
|
2019-02-15 14:16:21 +01:00
|
|
|
import Data.Map (Map, mapWithKey)
|
|
|
|
import qualified Data.Map as Map (filter, keys)
|
2019-02-05 17:31:11 +01:00
|
|
|
import qualified Data.Set as Set (elems, member)
|
2019-02-04 18:30:23 +01:00
|
|
|
import GHC.Generics
|
|
|
|
|
|
|
|
data ArticleExport = ArticleExport {
|
2019-02-15 18:07:59 +01:00
|
|
|
title :: String
|
2019-02-15 14:16:21 +01:00
|
|
|
, bodyOffset :: Int
|
2019-02-15 14:13:43 +01:00
|
|
|
, metadata :: Map String String
|
2019-02-05 17:31:11 +01:00
|
|
|
, tagged :: [String]
|
2019-02-04 18:30:23 +01:00
|
|
|
} deriving (Generic)
|
|
|
|
|
|
|
|
instance ToJSON ArticleExport where
|
|
|
|
toEncoding = genericToEncoding defaultOptions
|
|
|
|
|
|
|
|
data BlogDB = BlogDB {
|
2019-02-15 14:16:21 +01:00
|
|
|
articles :: Map String ArticleExport
|
2019-02-22 23:29:35 +01:00
|
|
|
, path :: Path
|
|
|
|
, skin :: Skin
|
2019-02-15 15:11:31 +01:00
|
|
|
, tags :: Map String [String]
|
2019-12-21 12:50:38 +01:00
|
|
|
, urls :: URL
|
2019-02-22 23:29:35 +01:00
|
|
|
, wording :: Wording
|
2019-02-04 18:30:23 +01:00
|
|
|
} deriving (Generic)
|
|
|
|
|
|
|
|
instance ToJSON BlogDB where
|
|
|
|
toEncoding = genericToEncoding defaultOptions
|
|
|
|
|
2019-02-22 23:29:35 +01:00
|
|
|
exportArticle :: Blog -> String -> Article -> ArticleExport
|
|
|
|
exportArticle blog key article = ArticleExport {
|
2019-02-15 18:07:59 +01:00
|
|
|
title = Article.title article
|
2019-02-15 14:16:21 +01:00
|
|
|
, bodyOffset = Article.bodyOffset article
|
2019-02-15 14:13:43 +01:00
|
|
|
, metadata = Article.metadata article
|
2019-02-15 14:16:21 +01:00
|
|
|
, tagged = Map.keys . Map.filter (Set.member key) $ Blog.tags blog
|
2019-02-04 18:30:23 +01:00
|
|
|
}
|
|
|
|
|
2019-02-06 17:16:52 +01:00
|
|
|
exportBlog :: ReaderT Blog IO ByteString
|
2019-02-04 18:30:23 +01:00
|
|
|
exportBlog = do
|
2019-02-05 17:31:11 +01:00
|
|
|
blog <- ask
|
2019-02-06 17:16:52 +01:00
|
|
|
return . encode $ BlogDB {
|
2019-02-22 23:29:35 +01:00
|
|
|
articles = mapWithKey (exportArticle blog) $ Blog.articles blog
|
|
|
|
, path = Blog.path blog
|
|
|
|
, skin = Blog.skin blog
|
2019-02-15 15:11:31 +01:00
|
|
|
, tags = Set.elems <$> Blog.tags blog
|
2019-12-21 12:50:38 +01:00
|
|
|
, urls = Blog.urls blog
|
2019-02-22 23:29:35 +01:00
|
|
|
, wording = Blog.wording blog
|
2019-02-04 18:30:23 +01:00
|
|
|
}
|