{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE NamedFieldPuns #-} module JSON ( exportBlog ) where import Article (Article) import qualified Article (Article(..)) import Blog (Blog) import qualified Blog (Blog(..), Skin(..)) import Control.Monad.Reader (ReaderT, ask) import Data.Aeson (ToJSON(..), genericToEncoding, defaultOptions, encode) import Data.ByteString.Lazy (ByteString) import Data.Map (Map, (!), foldlWithKey, mapKeys, mapWithKey) import qualified Data.Map as Map (empty, filter, insert, keys) import qualified Data.Set as Set (elems, member) import System.FilePath.Posix ((), (<.>)) import System.Posix.Files (modificationTime) import System.Posix.Types (EpochTime, FileID) import GHC.Generics type ArticleID = Int data ArticleExport = ArticleExport { source :: String , title :: String , metadata :: Map String String , tagged :: [String] } deriving (Generic) instance ToJSON ArticleExport 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 ArticleID ArticleExport , tags :: Map String [ArticleID] , skin :: SkinExport } deriving (Generic) instance ToJSON BlogDB where toEncoding = genericToEncoding defaultOptions remap :: (Ord k1, Enum k2, Ord k2) => Map k1 a -> Map k1 k2 remap = snd . foldlWithKey (\(i, tempMap) key _ -> (succ i, Map.insert key i tempMap)) (toEnum 0, Map.empty) export :: Blog -> FileID -> Article -> ArticleExport export blog fileID article = ArticleExport { source = "/" Article.urlPath article <.> "md" , title = Article.title article , metadata = Article.metadata article , tagged = Map.keys . Map.filter (Set.member fileID) $ Blog.tags blog } exportBlog :: ReaderT Blog IO ByteString exportBlog = do blog <- ask let reindex = remap $ Blog.articles blog return . encode $ BlogDB { articles = mapKeys (reindex !) $ mapWithKey (export blog) (Blog.articles blog) , tags = fmap (reindex !) . Set.elems <$> Blog.tags blog , skin = SkinExport { previewArticlesCount = Blog.previewArticlesCount $ Blog.skin blog , previewLinesCount = Blog.previewLinesCount $ Blog.skin blog } }