Extract Collections out of HTML to make them available to RSS generator too

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

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)

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