Tissevert/hablo
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

Handle articles dates and tags into the articles JSON

Browse source
This commit is contained in:
Tissevert 2019-02-05 17:31:11 +01:00
parent ce3a061a73
commit 773689c4ff
1 changed files with 25 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

32
src/JSON.hs
View file

@ -1,4 +1,5 @@
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NamedFieldPuns #-}
module JSON ( module JSON (
generate generate
) where ) where
@ -8,40 +9,57 @@ import qualified Article (Article(..))
import Blog (Blog) import Blog (Blog)
import qualified Blog (Blog(..), get) import qualified Blog (Blog(..), get)
import Control.Monad.IO.Class (MonadIO(..)) 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.Aeson (ToJSON(..), genericToEncoding, defaultOptions, encode)
import Data.ByteString.Lazy (writeFile) 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.FilePath.Posix ((</>), (<.>))
import System.Posix.Files (modificationTime)
import System.Posix.Types (EpochTime, FileID)
import Prelude hiding (writeFile) import Prelude hiding (writeFile)
import GHC.Generics import GHC.Generics
type ArticleID = Int
data ArticleExport = ArticleExport { data ArticleExport = ArticleExport {
source :: String source :: String
, title :: String , title :: String
, date :: EpochTime
, tagged :: [String]
} deriving (Generic) } deriving (Generic)
instance ToJSON ArticleExport where instance ToJSON ArticleExport where
toEncoding = genericToEncoding defaultOptions toEncoding = genericToEncoding defaultOptions
data BlogDB = BlogDB { data BlogDB = BlogDB {
articles :: [ArticleExport] articles :: Map ArticleID ArticleExport
, tags :: Map String [ArticleID]
} deriving (Generic) } deriving (Generic)
instance ToJSON BlogDB where instance ToJSON BlogDB where
toEncoding = genericToEncoding defaultOptions toEncoding = genericToEncoding defaultOptions
export :: Article -> ArticleExport remap :: (Ord k1, Enum k2, Ord k2) => Map k1 a -> Map k1 k2
export article = ArticleExport { 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" source = "/" </> Article.urlPath article <.> "md"
, title = Article.title article , 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 :: ReaderT Blog IO BlogDB
exportBlog = do exportBlog = do
allArticles <- Blog.get Blog.articles blog <- ask
let reindex = remap $ Blog.articles blog
return $ BlogDB { 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 () generate :: ReaderT Blog IO ()