70 lines
2.2 KiB
Haskell
70 lines
2.2 KiB
Haskell
{-# LANGUAGE DeriveGeneric #-}
|
|
{-# LANGUAGE NamedFieldPuns #-}
|
|
module JSON (
|
|
generate
|
|
) where
|
|
|
|
import Article (Article)
|
|
import qualified Article (Article(..))
|
|
import Blog (Blog)
|
|
import qualified Blog (Blog(..), get)
|
|
import Control.Monad.IO.Class (MonadIO(..))
|
|
import Control.Monad.Reader (ReaderT, ask)
|
|
import Data.Aeson (ToJSON(..), genericToEncoding, defaultOptions, encode)
|
|
import Data.ByteString.Lazy (writeFile)
|
|
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 Prelude hiding (writeFile)
|
|
import GHC.Generics
|
|
|
|
type ArticleID = Int
|
|
|
|
data ArticleExport = ArticleExport {
|
|
source :: String
|
|
, title :: String
|
|
, date :: EpochTime
|
|
, tagged :: [String]
|
|
} deriving (Generic)
|
|
|
|
instance ToJSON ArticleExport where
|
|
toEncoding = genericToEncoding defaultOptions
|
|
|
|
data BlogDB = BlogDB {
|
|
articles :: Map ArticleID ArticleExport
|
|
, tags :: Map String [ArticleID]
|
|
} 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
|
|
, date = modificationTime $ Article.fileStatus article
|
|
, tagged = Map.keys . Map.filter (Set.member fileID) $ Blog.tags blog
|
|
}
|
|
|
|
exportBlog :: ReaderT Blog IO BlogDB
|
|
exportBlog = do
|
|
blog <- ask
|
|
let reindex = remap $ Blog.articles blog
|
|
return $ BlogDB {
|
|
articles = mapKeys (reindex !) $ mapWithKey (export blog) (Blog.articles blog)
|
|
, tags = fmap (reindex !) . Set.elems <$> Blog.tags blog
|
|
}
|
|
|
|
generate :: ReaderT Blog IO ()
|
|
generate = do
|
|
path <- Blog.get Blog.root
|
|
jsonContent <- exportBlog
|
|
liftIO $ writeFile (path </> "articles.json") (encode jsonContent)
|