Handle articles dates and tags into the articles JSON
This commit is contained in:
parent
ce3a061a73
commit
773689c4ff
1 changed files with 25 additions and 7 deletions
32
src/JSON.hs
32
src/JSON.hs
|
@ -1,4 +1,5 @@
|
|||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
module JSON (
|
||||
generate
|
||||
) where
|
||||
|
@ -8,40 +9,57 @@ import qualified Article (Article(..))
|
|||
import Blog (Blog)
|
||||
import qualified Blog (Blog(..), get)
|
||||
import Control.Monad.IO.Class (MonadIO(..))
|
||||
import Control.Monad.Reader (ReaderT)
|
||||
import Control.Monad.Reader (ReaderT, ask)
|
||||
import Data.Aeson (ToJSON(..), genericToEncoding, defaultOptions, encode)
|
||||
import Data.ByteString.Lazy (writeFile)
|
||||
import qualified Data.Map as Map (elems)
|
||||
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 :: [ArticleExport]
|
||||
articles :: Map ArticleID ArticleExport
|
||||
, tags :: Map String [ArticleID]
|
||||
} deriving (Generic)
|
||||
|
||||
instance ToJSON BlogDB where
|
||||
toEncoding = genericToEncoding defaultOptions
|
||||
|
||||
export :: Article -> ArticleExport
|
||||
export article = ArticleExport {
|
||||
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
|
||||
allArticles <- Blog.get Blog.articles
|
||||
blog <- ask
|
||||
let reindex = remap $ Blog.articles blog
|
||||
return $ BlogDB {
|
||||
articles = export <$> Map.elems allArticles
|
||||
articles = mapKeys (reindex !) $ mapWithKey (export blog) (Blog.articles blog)
|
||||
, tags = fmap (reindex !) . Set.elems <$> Blog.tags blog
|
||||
}
|
||||
|
||||
generate :: ReaderT Blog IO ()
|
||||
|
|
Loading…
Reference in a new issue