75 lines
2.3 KiB
Haskell
75 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(..), 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
|
|
}
|
|
}
|