diff --git a/hablo.cabal b/hablo.cabal index b426c5c..9e23312 100644 --- a/hablo.cabal +++ b/hablo.cabal @@ -37,6 +37,7 @@ executable hablo , Blog.Skin , Blog.URL , Blog.Wording + , Collection , DOM , DOM.Card , Files @@ -45,6 +46,7 @@ executable hablo , JSON , Paths_hablo , Pretty + , RSS -- other-extensions: build-depends: aeson >= 1.4.0 && < 1.5 , base >= 4.9.1 && < 4.13 diff --git a/src/Collection.hs b/src/Collection.hs new file mode 100644 index 0000000..ae2c5c2 --- /dev/null +++ b/src/Collection.hs @@ -0,0 +1,47 @@ +{-# LANGUAGE NamedFieldPuns #-} +module Collection ( + Collection(..) + , getAll + ) where + +import Article(Article(..)) +import Blog (Blog(..), Path(..)) +import Control.Monad.IO.Class (MonadIO(..)) +import Control.Monad.Reader (MonadReader(..), ReaderT, asks) +import Data.List (sortOn) +import Data.Map ((!)) +import qualified Data.Map as Map (elems, filterWithKey, toList) +import Data.Ord (Down(..)) +import qualified Data.Set as Set (member) +import Pretty ((.$)) +import System.Directory (createDirectoryIfMissing) +import System.FilePath.Posix (()) + +data Collection = Collection { + articlesFeatured :: [Article] + , basePath :: FilePath + , tag :: Maybe String + } + +build :: MonadIO m => [Article] -> Maybe String -> ReaderT Blog m Collection +build articlesFeatured tag = do + root <- asks $path.$root + let basePath = maybe root (root ) tag + liftIO $ createDirectoryIfMissing False basePath + return $ Collection { + articlesFeatured = sortByDate articlesFeatured, basePath, tag + } + where + sortByDate = sortOn (Down . (! "date") . metadata) + +getAll :: ReaderT Blog IO [Collection] +getAll = do + Blog {articles, tags} <- ask + (:) + <$> (build (Map.elems articles) Nothing) + <*> (flip mapM (Map.toList tags) $ + \(tag, tagged) -> build (getArticles tagged articles) $ Just tag + ) + where + getArticles tagged = + Map.elems . Map.filterWithKey (\k _ -> Set.member k tagged) diff --git a/src/HTML.hs b/src/HTML.hs index ea1d90f..25efb21 100644 --- a/src/HTML.hs +++ b/src/HTML.hs @@ -7,42 +7,20 @@ module HTML ( import Article(Article(..)) import ArticlesList (ArticlesList(..)) import Blog (Blog(..), Path(..), Skin(..)) -import qualified Blog (get) -import Control.Monad (forM) +import Collection (Collection(..)) +import qualified Collection (getAll) import Control.Monad.IO.Class (MonadIO(..)) -import Control.Monad.Reader (MonadReader(..), ReaderT) -import Data.List (sortOn) -import Data.Map ((!)) -import qualified Data.Map as Map (elems, filterWithKey, toList) -import Data.Ord (Down(..)) -import qualified Data.Set as Set (member) +import Control.Monad.Reader (ReaderT, asks) +import qualified Data.Map as Map (elems) import qualified Data.Text.Lazy.IO as TextIO (writeFile) import DOM (page) import Lucid import Pretty ((.$)) -import System.Directory (createDirectoryIfMissing) import System.FilePath.Posix ((), (<.>)) -data Collection = Collection { - articlesFeatured :: [Article] - , basePath :: FilePath - , tag :: Maybe String - } - -collection :: Monad m => [Article] -> Maybe String -> ReaderT Blog m Collection -collection articlesFeatured tag = do - root <- Blog.get $path.$root - return $ Collection { - articlesFeatured = sortByDate articlesFeatured - , basePath = maybe root (root ) tag - , tag - } - where - sortByDate = sortOn (Down . (! "date") . metadata) - articlesLists :: Monad m => Collection -> ReaderT Blog m [(FilePath, ArticlesList)] articlesLists (Collection {articlesFeatured, basePath, tag}) = do - limit <- take <$> (Blog.get $skin.$previewArticlesCount) + limit <- take <$> (asks $skin.$previewArticlesCount) return [ (basePath "index.html", ArticlesList { tagged = tag @@ -58,14 +36,13 @@ articlesLists (Collection {articlesFeatured, basePath, tag}) = do generateArticles :: [Article] -> ReaderT Blog IO () generateArticles = mapM_ $ \article -> do - baseDir <- () <$> (Blog.get $path.$root) <*> (Blog.get $path.$articlesPath) + baseDir <- () <$> (asks $path.$root) <*> (asks $path.$articlesPath) (renderTextT $ page article) >>= liftIO . TextIO.writeFile (baseDir key article <.> "html") generateCollection :: Collection -> ReaderT Blog IO () generateCollection (Collection {articlesFeatured = []}) = return () generateCollection aCollection = do - liftIO . createDirectoryIfMissing False $ basePath aCollection articlesLists aCollection >>= (mapM_ $ \(filePath, articlesList) -> (renderTextT $ page articlesList) @@ -74,11 +51,5 @@ generateCollection aCollection = do generate :: ReaderT Blog IO () generate = do - Blog {articles, tags} <- ask - generateArticles $ Map.elems articles - collection (Map.elems articles) Nothing >>= generateCollection - forM (Map.toList tags) $ - \(tag, tagged) -> collection (getArticles tagged articles) $ Just tag - >>= mapM_ generateCollection - where - getArticles tagged = Map.elems . Map.filterWithKey (\k _ -> Set.member k tagged) + asks articles >>= generateArticles . Map.elems + Collection.getAll >>= mapM_ generateCollection