{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE FlexibleContexts #-} module Collection ( Collection(..) , getAll , title ) 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 Markdown (Markdown(metadata), MarkdownContent(..)) import Pretty ((.$)) import System.Directory (createDirectoryIfMissing) import System.FilePath (()) data Collection = Collection { featured :: [Article] , basePath :: FilePath , tag :: Maybe String } build :: MonadIO m => [Article] -> Maybe String -> ReaderT Blog m Collection build featured tag = do root <- asks $path.$root let basePath = maybe root (root ) tag liftIO $ createDirectoryIfMissing False basePath return $ Collection { featured = sortByDate featured, basePath, tag } where sortByDate = sortOn (Down . (! "date") . metadata . getMarkdown) 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) title :: MonadReader Blog m => Collection -> m String title (Collection {tag}) = do asks $ (\name -> maybe name ((name ++ " - ") ++) tag) . name