{-# LANGUAGE OverloadedStrings #-}
module Rules.TopPage (rules) where

import           Control.Monad.Extra  (mconcatMapM)
import           Control.Monad.Reader (ReaderT (..), asks)
import           Control.Monad.Trans  (MonadTrans (..))
import           Data.List.Extra      (mconcatMap)
import           Data.Time.Format     (formatTime)
import           Hakyll
import           System.FilePath      (joinPath, (</>))

import           Config               (contentsRoot, defaultTimeLocale',
                                       siteName)
import           Config.Blog
import           Config.Contributions
import           Config.TopPage
import           Contexts             (siteCtx)
import qualified Contexts.Blog        as CtxBlog
import           Rules.Blog.Type
import           Rules.PageType
import           Utils                (mconcatM, modifyExternalLinkAttr)
import qualified Vendor.FontAwesome   as FA

lastUpdate :: (MonadMetadata m, MonadFail m) => [Item a] -> m String
lastUpdate :: forall (m :: * -> *) a.
(MonadMetadata m, MonadFail m) =>
[Item a] -> m String
lastUpdate [] = String -> m String
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> m String) -> String -> m String
forall a b. (a -> b) -> a -> b
$ TopPageConfig -> String
noPostsAlt TopPageConfig
topPageConfig
lastUpdate (Item a
x:[Item a]
_) = TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale' (TopPageConfig -> String
postDateFormat TopPageConfig
topPageConfig)
    (UTCTime -> String) -> m UTCTime -> m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TimeLocale -> Identifier -> m UTCTime
forall (m :: * -> *).
(MonadMetadata m, MonadFail m) =>
TimeLocale -> Identifier -> m UTCTime
getItemUTC TimeLocale
defaultTimeLocale' (Item a -> Identifier
forall a. Item a -> Identifier
itemIdentifier Item a
x)

introDateCtx :: [Item a] -> BlogConfReader m Compiler (Context String)
introDateCtx :: forall a (m :: * -> *).
[Item a] -> BlogConfReader m Compiler (Context String)
introDateCtx [Item a]
posts = String -> String -> Context String
forall a. String -> String -> Context a
constField
    (String -> String -> Context String)
-> ReaderT (BlogConfig m) Compiler String
-> ReaderT (BlogConfig m) Compiler (String -> Context String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (BlogConfig m -> String) -> ReaderT (BlogConfig m) Compiler String
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"-intro-date") (String -> String)
-> (BlogConfig m -> String) -> BlogConfig m -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlogConfig m -> String
forall (m :: * -> *). BlogConfig m -> String
blogName)
    ReaderT (BlogConfig m) Compiler (String -> Context String)
-> ReaderT (BlogConfig m) Compiler String
-> ReaderT (BlogConfig m) Compiler (Context String)
forall a b.
ReaderT (BlogConfig m) Compiler (a -> b)
-> ReaderT (BlogConfig m) Compiler a
-> ReaderT (BlogConfig m) Compiler b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Compiler String -> ReaderT (BlogConfig m) Compiler String
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (BlogConfig m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ([Item a] -> Compiler String
forall (m :: * -> *) a.
(MonadMetadata m, MonadFail m) =>
[Item a] -> m String
lastUpdate [Item a]
posts)

listPostsCtx :: [Item String] -> BlogConfReader m Compiler (Context String)
listPostsCtx :: forall (m :: * -> *).
[Item String] -> BlogConfReader m Compiler (Context String)
listPostsCtx [Item String]
posts = do
    String
name <- (BlogConfig m -> String) -> ReaderT (BlogConfig m) Compiler String
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"-posts") (String -> String)
-> (BlogConfig m -> String) -> BlogConfig m -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlogConfig m -> String
forall (m :: * -> *). BlogConfig m -> String
blogName)
    Context String -> BlogConfReader m Compiler (Context String)
forall a. a -> ReaderT (BlogConfig m) Compiler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Context String -> BlogConfReader m Compiler (Context String))
-> Context String -> BlogConfReader m Compiler (Context String)
forall a b. (a -> b) -> a -> b
$ String
-> Context String -> Compiler [Item String] -> Context String
forall a b. String -> Context a -> Compiler [Item a] -> Context b
listField String
name (Context String
siteCtx Context String -> Context String -> Context String
forall a. Semigroup a => a -> a -> a
<> Context String
defaultContext) ([Item String] -> Compiler [Item String]
forall a. a -> Compiler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Item String]
posts)

mkBlogCtx :: BlogConfReader m Compiler (Context String)
mkBlogCtx :: forall (m :: * -> *). BlogConfReader m Compiler (Context String)
mkBlogCtx = do
    Pattern
ep <- (BlogConfig m -> Pattern)
-> ReaderT (BlogConfig m) Compiler Pattern
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks BlogConfig m -> Pattern
forall (m :: * -> *). BlogConfig m -> Pattern
blogEntryPattern
    String
cs <- (BlogConfig m -> String) -> ReaderT (BlogConfig m) Compiler String
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks BlogConfig m -> String
forall (m :: * -> *). BlogConfig m -> String
blogContentSnapshot
    [Item String]
posts <- Compiler [Item String]
-> ReaderT (BlogConfig m) Compiler [Item String]
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (BlogConfig m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Compiler [Item String]
 -> ReaderT (BlogConfig m) Compiler [Item String])
-> Compiler [Item String]
-> ReaderT (BlogConfig m) Compiler [Item String]
forall a b. (a -> b) -> a -> b
$ ([Item String] -> [Item String])
-> Compiler [Item String] -> Compiler [Item String]
forall a b. (a -> b) -> Compiler a -> Compiler b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> [Item String] -> [Item String]
forall a. Int -> [a] -> [a]
take (Int -> [Item String] -> [Item String])
-> Int -> [Item String] -> [Item String]
forall a b. (a -> b) -> a -> b
$ TopPageConfig -> Int
maxTitleNum TopPageConfig
topPageConfig) (Compiler [Item String] -> Compiler [Item String])
-> ([Item String] -> Compiler [Item String])
-> [Item String]
-> Compiler [Item String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Item String] -> Compiler [Item String]
forall (m :: * -> *) a.
(MonadMetadata m, MonadFail m) =>
[Item a] -> m [Item a]
recentFirst ([Item String] -> Compiler [Item String])
-> Compiler [Item String] -> Compiler [Item String]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Pattern -> String -> Compiler [Item String]
forall a.
(Binary a, Typeable a) =>
Pattern -> String -> Compiler [Item a]
loadAllSnapshots Pattern
ep String
cs
    [BlogConfReader m Compiler (Context String)]
-> BlogConfReader m Compiler (Context String)
forall (m :: * -> *) b. (Monad m, Monoid b) => [m b] -> m b
mconcatM [
        [Item String] -> BlogConfReader m Compiler (Context String)
forall (m :: * -> *).
[Item String] -> BlogConfReader m Compiler (Context String)
listPostsCtx [Item String]
posts
      , BlogConfReader m Compiler (Context String)
forall (m :: * -> *) (n :: * -> *).
Monad m =>
BlogConfReader n m (Context String)
CtxBlog.title
      , BlogConfReader m Compiler (Context String)
forall (m :: * -> *) (n :: * -> *).
Monad m =>
BlogConfReader n m (Context String)
CtxBlog.description
      , [Item String] -> BlogConfReader m Compiler (Context String)
forall a (m :: * -> *).
[Item a] -> BlogConfReader m Compiler (Context String)
introDateCtx [Item String]
posts
      , Context String -> BlogConfReader m Compiler (Context String)
forall a. a -> ReaderT (BlogConfig m) Compiler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Context String
siteCtx
      , Context String -> BlogConfReader m Compiler (Context String)
forall a. a -> ReaderT (BlogConfig m) Compiler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Context String
defaultContext
      ]

rules :: [BlogConfig m] -> PageConfReader Rules ()
rules :: forall (m :: * -> *). [BlogConfig m] -> PageConfReader Rules ()
rules [BlogConfig m]
bcs = do
    FontAwesomeIcons
faIcons <- (PageConf -> FontAwesomeIcons)
-> ReaderT PageConf Rules FontAwesomeIcons
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PageConf -> FontAwesomeIcons
pcFaIcons
    String
projs <- Rules String -> ReaderT PageConf Rules String
forall (m :: * -> *) a. Monad m => m a -> ReaderT PageConf m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Rules String -> ReaderT PageConf Rules String)
-> Rules String -> ReaderT PageConf Rules String
forall a b. (a -> b) -> a -> b
$ IO String -> Rules String
forall a. IO a -> Rules a
preprocess IO String
renderProjectsList
    String
conts <- Rules String -> ReaderT PageConf Rules String
forall (m :: * -> *) a. Monad m => m a -> ReaderT PageConf m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Rules String -> ReaderT PageConf Rules String)
-> Rules String -> ReaderT PageConf Rules String
forall a b. (a -> b) -> a -> b
$ IO String -> Rules String
forall a. IO a -> Rules a
preprocess IO String
renderContributionsTable
    let baseCtx :: Context a
baseCtx = ((String, String) -> Context a) -> [(String, String)] -> Context a
forall b a. Monoid b => (a -> b) -> [a] -> b
mconcatMap ((String -> String -> Context a) -> (String, String) -> Context a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> String -> Context a
forall a. String -> String -> Context a
constField) [
            (String
"title", String
siteName)
          , (String
"projs", String
projs)
          , (String
"contable", String
conts)
          ]
    Rules () -> PageConfReader Rules ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT PageConf m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Rules () -> PageConfReader Rules ())
-> Rules () -> PageConfReader Rules ()
forall a b. (a -> b) -> a -> b
$ Pattern -> Rules () -> Rules ()
match Pattern
indexPath (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$ do
        Routes -> Rules ()
route (Routes -> Rules ()) -> Routes -> Rules ()
forall a b. (a -> b) -> a -> b
$ String -> (String -> String) -> Routes
gsubRoute (String
contentsRoot String -> String -> String
</> String
"pages/") (String -> String -> String
forall a b. a -> b -> a
const String
forall a. Monoid a => a
mempty)
        Compiler (Item String) -> Rules ()
forall a.
(Binary a, Typeable a, Writable a) =>
Compiler (Item a) -> Rules ()
compile (Compiler (Item String) -> Rules ())
-> Compiler (Item String) -> Rules ()
forall a b. (a -> b) -> a -> b
$ do
            Context String
topCtx <- Context String -> Context String -> Context String
forall a. Monoid a => a -> a -> a
mappend Context String
forall {a}. Context a
baseCtx (Context String -> Context String)
-> Compiler (Context String) -> Compiler (Context String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (BlogConfig m -> Compiler (Context String))
-> [BlogConfig m] -> Compiler (Context String)
forall (m :: * -> *) b a.
(Monad m, Monoid b) =>
(a -> m b) -> [a] -> m b
mconcatMapM (ReaderT (BlogConfig m) Compiler (Context String)
-> BlogConfig m -> Compiler (Context String)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (BlogConfig m) Compiler (Context String)
forall (m :: * -> *). BlogConfReader m Compiler (Context String)
mkBlogCtx) [BlogConfig m]
bcs
            Compiler (Item String)
getResourceBody
                Compiler (Item String)
-> (Item String -> Compiler (Item String))
-> Compiler (Item String)
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Context String -> Item String -> Compiler (Item String)
applyAsTemplate Context String
topCtx
                Compiler (Item String)
-> (Item String -> Compiler (Item String))
-> Compiler (Item String)
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Identifier
-> Context String -> Item String -> Compiler (Item String)
forall a.
Identifier -> Context a -> Item a -> Compiler (Item String)
loadAndApplyTemplate Identifier
rootTemplate Context String
topCtx
                Compiler (Item String)
-> (Item String -> Compiler (Item String))
-> Compiler (Item String)
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Item String -> Compiler (Item String)
modifyExternalLinkAttr
                Compiler (Item String)
-> (Item String -> Compiler (Item String))
-> Compiler (Item String)
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Item String -> Compiler (Item String)
relativizeUrls
                Compiler (Item String)
-> (Item String -> Compiler (Item String))
-> Compiler (Item String)
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FontAwesomeIcons -> Item String -> Compiler (Item String)
FA.render FontAwesomeIcons
faIcons
    where
        indexPath :: Pattern
indexPath = String -> Pattern
fromGlob (String -> Pattern) -> String -> Pattern
forall a b. (a -> b) -> a -> b
$ [String] -> String
joinPath [String
contentsRoot, String
"pages", String
"index.html"]
        rootTemplate :: Identifier
rootTemplate = String -> Identifier
fromFilePath (String -> Identifier) -> String -> Identifier
forall a b. (a -> b) -> a -> b
$ [String] -> String
joinPath [String
contentsRoot, String
"templates", String
"site", String
"default.html"]