78 lines
2.3 KiB
Haskell
78 lines
2.3 KiB
Haskell
{-# LANGUAGE DeriveGeneric #-}
|
|
{-# LANGUAGE NamedFieldPuns #-}
|
|
module JSON (
|
|
exportBlog
|
|
) where
|
|
|
|
import Article (Article)
|
|
import qualified Article (Article(..))
|
|
import Blog (Blog)
|
|
import qualified Blog (Blog(..), Path(..), Skin(..))
|
|
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 PathExport = PathExport {
|
|
articlesPath :: FilePath
|
|
, pagesPath :: Maybe FilePath
|
|
} deriving (Generic)
|
|
|
|
instance ToJSON PathExport where
|
|
toEncoding = genericToEncoding defaultOptions
|
|
|
|
data SkinExport = SkinExport {
|
|
previewArticlesCount :: Int
|
|
, previewLinesCount :: Int
|
|
} deriving (Generic)
|
|
|
|
instance ToJSON SkinExport where
|
|
toEncoding = genericToEncoding defaultOptions
|
|
|
|
data BlogDB = BlogDB {
|
|
articles :: Map String ArticleExport
|
|
, path :: PathExport
|
|
, skin :: SkinExport
|
|
, tags :: Map String [String]
|
|
} deriving (Generic)
|
|
|
|
instance ToJSON BlogDB where
|
|
toEncoding = genericToEncoding defaultOptions
|
|
|
|
export :: Blog -> String -> Article -> ArticleExport
|
|
export 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 (export blog) $ Blog.articles blog
|
|
, path = PathExport {
|
|
articlesPath = Blog.articlesPath $ Blog.path blog
|
|
, pagesPath = Blog.pagesPath $ Blog.path blog
|
|
}
|
|
, skin = SkinExport {
|
|
previewArticlesCount = Blog.previewArticlesCount $ Blog.skin blog
|
|
, previewLinesCount = Blog.previewLinesCount $ Blog.skin blog
|
|
}
|
|
, tags = Set.elems <$> Blog.tags blog
|
|
}
|