{-# 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 {
      Collection -> [Article]
featured :: [Article]
    , Collection -> FilePath
basePath :: FilePath
    , Collection -> Maybe FilePath
tag :: Maybe String
  }

build :: MonadIO m => [Article] -> Maybe String -> ReaderT Blog m Collection
build :: [Article] -> Maybe FilePath -> ReaderT Blog m Collection
build [Article]
featured Maybe FilePath
tag = do
  FilePath
root <- (Blog -> FilePath) -> ReaderT Blog m FilePath
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((Blog -> FilePath) -> ReaderT Blog m FilePath)
-> (Blog -> FilePath) -> ReaderT Blog m FilePath
forall a b. (a -> b) -> a -> b
$Blog -> Path
path(Blog -> Path) -> (Path -> FilePath) -> Blog -> FilePath
forall a b c. (a -> b) -> (b -> c) -> a -> c
.$Path -> FilePath
root
  let basePath :: FilePath
basePath = FilePath -> (FilePath -> FilePath) -> Maybe FilePath -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
root (FilePath
root FilePath -> FilePath -> FilePath
</>) Maybe FilePath
tag
  IO () -> ReaderT Blog m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT Blog m ()) -> IO () -> ReaderT Blog m ()
forall a b. (a -> b) -> a -> b
$ Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
False FilePath
basePath
  Collection -> ReaderT Blog m Collection
forall (m :: * -> *) a. Monad m => a -> m a
return (Collection -> ReaderT Blog m Collection)
-> Collection -> ReaderT Blog m Collection
forall a b. (a -> b) -> a -> b
$ Collection :: [Article] -> FilePath -> Maybe FilePath -> Collection
Collection {
      featured :: [Article]
featured = [Article] -> [Article]
sortByDate [Article]
featured, FilePath
basePath :: FilePath
basePath :: FilePath
basePath, Maybe FilePath
tag :: Maybe FilePath
tag :: Maybe FilePath
tag
    }
  where
    sortByDate :: [Article] -> [Article]
sortByDate = (Article -> Down FilePath) -> [Article] -> [Article]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (FilePath -> Down FilePath
forall a. a -> Down a
Down (FilePath -> Down FilePath)
-> (Article -> FilePath) -> Article -> Down FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map FilePath FilePath -> FilePath -> FilePath
forall k a. Ord k => Map k a -> k -> a
! FilePath
"date") (Map FilePath FilePath -> FilePath)
-> (Article -> Map FilePath FilePath) -> Article -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Markdown -> Map FilePath FilePath
metadata (Markdown -> Map FilePath FilePath)
-> (Article -> Markdown) -> Article -> Map FilePath FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Article -> Markdown
forall a. MarkdownContent a => a -> Markdown
getMarkdown)

getAll :: ReaderT Blog IO [Collection]
getAll :: ReaderT Blog IO [Collection]
getAll = do
  Blog {Collection Article
articles :: Blog -> Collection Article
articles :: Collection Article
articles, Collection (Set FilePath)
tags :: Blog -> Collection (Set FilePath)
tags :: Collection (Set FilePath)
tags} <- ReaderT Blog IO Blog
forall r (m :: * -> *). MonadReader r m => m r
ask
  (:)
    (Collection -> [Collection] -> [Collection])
-> ReaderT Blog IO Collection
-> ReaderT Blog IO ([Collection] -> [Collection])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Article] -> Maybe FilePath -> ReaderT Blog IO Collection
forall (m :: * -> *).
MonadIO m =>
[Article] -> Maybe FilePath -> ReaderT Blog m Collection
build (Collection Article -> [Article]
forall k a. Map k a -> [a]
Map.elems Collection Article
articles) Maybe FilePath
forall a. Maybe a
Nothing)
    ReaderT Blog IO ([Collection] -> [Collection])
-> ReaderT Blog IO [Collection] -> ReaderT Blog IO [Collection]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((((FilePath, Set FilePath) -> ReaderT Blog IO Collection)
 -> [(FilePath, Set FilePath)] -> ReaderT Blog IO [Collection])
-> [(FilePath, Set FilePath)]
-> ((FilePath, Set FilePath) -> ReaderT Blog IO Collection)
-> ReaderT Blog IO [Collection]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((FilePath, Set FilePath) -> ReaderT Blog IO Collection)
-> [(FilePath, Set FilePath)] -> ReaderT Blog IO [Collection]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Collection (Set FilePath) -> [(FilePath, Set FilePath)]
forall k a. Map k a -> [(k, a)]
Map.toList Collection (Set FilePath)
tags) (((FilePath, Set FilePath) -> ReaderT Blog IO Collection)
 -> ReaderT Blog IO [Collection])
-> ((FilePath, Set FilePath) -> ReaderT Blog IO Collection)
-> ReaderT Blog IO [Collection]
forall a b. (a -> b) -> a -> b
$ 
            \(FilePath
tag, Set FilePath
tagged) -> [Article] -> Maybe FilePath -> ReaderT Blog IO Collection
forall (m :: * -> *).
MonadIO m =>
[Article] -> Maybe FilePath -> ReaderT Blog m Collection
build (Set FilePath -> Collection Article -> [Article]
forall k a. Ord k => Set k -> Map k a -> [a]
getArticles Set FilePath
tagged Collection Article
articles) (Maybe FilePath -> ReaderT Blog IO Collection)
-> Maybe FilePath -> ReaderT Blog IO Collection
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
tag
          )
  where
    getArticles :: Set k -> Map k a -> [a]
getArticles Set k
tagged =
      Map k a -> [a]
forall k a. Map k a -> [a]
Map.elems (Map k a -> [a]) -> (Map k a -> Map k a) -> Map k a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k -> a -> Bool) -> Map k a -> Map k a
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\k
k a
_ -> k -> Set k -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member k
k Set k
tagged)

title :: MonadReader Blog m => Collection -> m String
title :: Collection -> m FilePath
title (Collection {Maybe FilePath
tag :: Maybe FilePath
tag :: Collection -> Maybe FilePath
tag}) = do
  (Blog -> FilePath) -> m FilePath
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((Blog -> FilePath) -> m FilePath)
-> (Blog -> FilePath) -> m FilePath
forall a b. (a -> b) -> a -> b
$ (\FilePath
name -> FilePath -> (FilePath -> FilePath) -> Maybe FilePath -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
name ((FilePath
name FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" - ") FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++) Maybe FilePath
tag) (FilePath -> FilePath) -> (Blog -> FilePath) -> Blog -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blog -> FilePath
name