{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
module HTML (
    generate
  ) where

import ArticlesList (ArticlesList(..))
import Blog (Blog(..), Path(..))
import Collection (Collection(..))
import qualified Collection (getAll)
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Reader (ReaderT, asks)
import qualified Data.Map as Map (elems)
import qualified Data.Text.Lazy.IO as TextIO (writeFile)
import DOM (HasContent, htmlDocument)
import Lucid (renderTextT)
import Markdown (Markdown(..), MarkdownContent(..))
import Pretty ((.$))
import System.FilePath.Posix ((</>), (<.>))

articlesLists :: Collection -> [(FilePath, ArticlesList)]
articlesLists :: Collection -> [(FilePath, ArticlesList)]
articlesLists collection :: Collection
collection@(Collection {FilePath
basePath :: Collection -> FilePath
basePath :: FilePath
basePath}) = [
    (Bool -> FilePath
path Bool
full, ArticlesList :: Bool -> Collection -> ArticlesList
ArticlesList {Collection
collection :: Collection
collection :: Collection
collection, Bool
full :: Bool
full :: Bool
full}) | Bool
full <- [Bool
False, Bool
True]
  ]
  where
    file :: Bool -> p
file Bool
bool = if Bool
bool then p
"all" else p
"index"
    path :: Bool -> FilePath
path Bool
bool = FilePath
basePath FilePath -> FilePath -> FilePath
</> Bool -> FilePath
forall p. IsString p => Bool -> p
file Bool
bool FilePath -> FilePath -> FilePath
<.> FilePath
"html"

generateMarkdown :: (HasContent a, MarkdownContent a) => [a] -> ReaderT Blog IO ()
generateMarkdown :: [a] -> ReaderT Blog IO ()
generateMarkdown = (a -> ReaderT Blog IO ()) -> [a] -> ReaderT Blog IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((a -> ReaderT Blog IO ()) -> [a] -> ReaderT Blog IO ())
-> (a -> ReaderT Blog IO ()) -> [a] -> ReaderT Blog IO ()
forall a b. (a -> b) -> a -> b
$ \a
content -> do
  let relativePath :: FilePath
relativePath = Markdown -> FilePath
Markdown.path (a -> Markdown
forall a. MarkdownContent a => a -> Markdown
getMarkdown a
content) FilePath -> FilePath -> FilePath
<.> FilePath
"html"
  FilePath
filePath <- (FilePath -> FilePath -> FilePath
</> FilePath
relativePath) (FilePath -> FilePath)
-> ReaderT Blog IO FilePath -> ReaderT Blog IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Blog -> FilePath) -> ReaderT Blog IO FilePath
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((Blog -> FilePath) -> ReaderT Blog IO FilePath)
-> (Blog -> FilePath) -> ReaderT Blog IO FilePath
forall a b. (a -> b) -> a -> b
$Blog -> Path
Blog.path(Blog -> Path) -> (Path -> FilePath) -> Blog -> FilePath
forall a b c. (a -> b) -> (b -> c) -> a -> c
.$Path -> FilePath
root)
  (HtmlT (ReaderT Blog IO) () -> ReaderT Blog IO Text
forall (m :: * -> *) a. Monad m => HtmlT m a -> m Text
renderTextT (HtmlT (ReaderT Blog IO) () -> ReaderT Blog IO Text)
-> HtmlT (ReaderT Blog IO) () -> ReaderT Blog IO Text
forall a b. (a -> b) -> a -> b
$ a -> HtmlT (ReaderT Blog IO) ()
forall a. HasContent a => a -> HtmlT (ReaderT Blog IO) ()
htmlDocument a
content) ReaderT Blog IO Text
-> (Text -> ReaderT Blog IO ()) -> ReaderT Blog IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> ReaderT Blog IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT Blog IO ())
-> (Text -> IO ()) -> Text -> ReaderT Blog IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text -> IO ()
TextIO.writeFile FilePath
filePath

generateCollection :: Collection -> ReaderT Blog IO ()
generateCollection :: Collection -> ReaderT Blog IO ()
generateCollection (Collection {featured :: Collection -> [Article]
featured = []}) = () -> ReaderT Blog IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
generateCollection Collection
collection =
  (((FilePath, ArticlesList) -> ReaderT Blog IO ())
 -> [(FilePath, ArticlesList)] -> ReaderT Blog IO ())
-> [(FilePath, ArticlesList)]
-> ((FilePath, ArticlesList) -> ReaderT Blog IO ())
-> ReaderT Blog IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((FilePath, ArticlesList) -> ReaderT Blog IO ())
-> [(FilePath, ArticlesList)] -> ReaderT Blog IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Collection -> [(FilePath, ArticlesList)]
articlesLists Collection
collection) (((FilePath, ArticlesList) -> ReaderT Blog IO ())
 -> ReaderT Blog IO ())
-> ((FilePath, ArticlesList) -> ReaderT Blog IO ())
-> ReaderT Blog IO ()
forall a b. (a -> b) -> a -> b
$ \(FilePath
filePath, ArticlesList
articlesList) ->
    (HtmlT (ReaderT Blog IO) () -> ReaderT Blog IO Text
forall (m :: * -> *) a. Monad m => HtmlT m a -> m Text
renderTextT (HtmlT (ReaderT Blog IO) () -> ReaderT Blog IO Text)
-> HtmlT (ReaderT Blog IO) () -> ReaderT Blog IO Text
forall a b. (a -> b) -> a -> b
$ ArticlesList -> HtmlT (ReaderT Blog IO) ()
forall a. HasContent a => a -> HtmlT (ReaderT Blog IO) ()
htmlDocument ArticlesList
articlesList)
      ReaderT Blog IO Text
-> (Text -> ReaderT Blog IO ()) -> ReaderT Blog IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> ReaderT Blog IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT Blog IO ())
-> (Text -> IO ()) -> Text -> ReaderT Blog IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text -> IO ()
TextIO.writeFile FilePath
filePath

generate :: ReaderT Blog IO ()
generate :: ReaderT Blog IO ()
generate = do
  (Blog -> Collection Article)
-> ReaderT Blog IO (Collection Article)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Blog -> Collection Article
articles ReaderT Blog IO (Collection Article)
-> (Collection Article -> ReaderT Blog IO ()) -> ReaderT Blog IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Article] -> ReaderT Blog IO ()
forall a.
(HasContent a, MarkdownContent a) =>
[a] -> ReaderT Blog IO ()
generateMarkdown ([Article] -> ReaderT Blog IO ())
-> (Collection Article -> [Article])
-> Collection Article
-> ReaderT Blog IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Collection Article -> [Article]
forall k a. Map k a -> [a]
Map.elems
  ReaderT Blog IO [Collection]
Collection.getAll ReaderT Blog IO [Collection]
-> ([Collection] -> ReaderT Blog IO ()) -> ReaderT Blog IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Collection -> ReaderT Blog IO ())
-> [Collection] -> ReaderT Blog IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Collection -> ReaderT Blog IO ()
generateCollection
  (Blog -> Collection Page) -> ReaderT Blog IO (Collection Page)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Blog -> Collection Page
pages ReaderT Blog IO (Collection Page)
-> (Collection Page -> ReaderT Blog IO ()) -> ReaderT Blog IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Page] -> ReaderT Blog IO ()
forall a.
(HasContent a, MarkdownContent a) =>
[a] -> ReaderT Blog IO ()
generateMarkdown ([Page] -> ReaderT Blog IO ())
-> (Collection Page -> [Page])
-> Collection Page
-> ReaderT Blog IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Collection Page -> [Page]
forall k a. Map k a -> [a]
Map.elems