module Rules.Blog.ListPage (
listPage
, ListPageOpts (..)
) where
import Control.Monad.Extra (findM, ifM, mconcatMapM)
import Data.Maybe (isJust)
import Hakyll
import System.FilePath ((</>))
import Config (defaultTimeLocale', timeZoneJST,
tmBlogRoot)
import Contexts.Field (tagCloudField')
import Rules.Blog.Utils (appendFooter)
import Utils (modifyExternalLinkAttr)
import qualified Vendor.FontAwesome as FA
{-# INLINE pluginCtx #-}
pluginCtx :: MonadMetadata m => [Item a] -> String -> m (Context b)
pluginCtx :: forall (m :: * -> *) a b.
MonadMetadata m =>
[Item a] -> String -> m (Context b)
pluginCtx [Item a]
posts String
pluginName = m Bool -> m (Context b) -> m (Context b) -> m (Context b)
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM
(Maybe (Item a) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (Item a) -> Bool) -> m (Maybe (Item a)) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Item a -> m Bool) -> [Item a] -> m (Maybe (Item a))
forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> [a] -> m (Maybe a)
findM ((Maybe String -> Bool) -> m (Maybe String) -> m Bool
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (m (Maybe String) -> m Bool)
-> (Item a -> m (Maybe String)) -> Item a -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Identifier -> String -> m (Maybe String))
-> String -> Identifier -> m (Maybe String)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Identifier -> String -> m (Maybe String)
forall (m :: * -> *).
MonadMetadata m =>
Identifier -> String -> m (Maybe String)
getMetadataField String
pluginName (Identifier -> m (Maybe String))
-> (Item a -> Identifier) -> Item a -> m (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Item a -> Identifier
forall a. Item a -> Identifier
itemIdentifier) [Item a]
posts)
(Context b -> m (Context b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Context b -> m (Context b)) -> Context b -> m (Context b)
forall a b. (a -> b) -> a -> b
$ String -> (Item b -> Bool) -> Context b
forall a. String -> (Item a -> Bool) -> Context a
boolField String
pluginName (Bool -> Item b -> Bool
forall a b. a -> b -> a
const Bool
True))
(Context b -> m (Context b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Context b
forall a. Monoid a => a
mempty)
data ListPageOpts = ListPageOpts {
ListPageOpts -> Context String
lpName :: Context String
, ListPageOpts -> String
lpTitle :: String
, ListPageOpts -> Context String
lpFont :: Context String
, ListPageOpts -> Context String
lpDescription :: Context String
, ListPageOpts -> Context String
lpBeforeContentBodyAdditionalComponent :: Context String
, :: Context String
, ListPageOpts -> String
lpContentSnapshot :: Snapshot
, ListPageOpts -> Context String
lpGSuite :: Context String
, ListPageOpts -> Context String
lpList :: Context String
, ListPageOpts -> Context String
lpPost :: Context String
}
listPage :: Maybe String
-> FA.FontAwesomeIcons
-> Tags
-> ListPageOpts
-> Paginate
-> Rules ()
listPage :: Maybe String
-> FontAwesomeIcons -> Tags -> ListPageOpts -> Paginate -> Rules ()
listPage Maybe String
title FontAwesomeIcons
faIcons Tags
tags ListPageOpts
bc Paginate
pgs = Paginate -> (PageNumber -> Pattern -> Rules ()) -> Rules ()
paginateRules Paginate
pgs ((PageNumber -> Pattern -> Rules ()) -> Rules ())
-> (PageNumber -> Pattern -> Rules ()) -> Rules ()
forall a b. (a -> b) -> a -> b
$ \PageNumber
pn Pattern
pat -> do
Routes -> Rules ()
route Routes
idRoute
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
[Item String]
posts <- [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
pat (ListPageOpts -> String
lpContentSnapshot ListPageOpts
bc)
Context String
pCtx <- (String -> Compiler (Context String))
-> [String] -> Compiler (Context String)
forall (m :: * -> *) b a.
(Monad m, Monoid b) =>
(a -> m b) -> [a] -> m b
mconcatMapM ([Item String] -> String -> Compiler (Context String)
forall (m :: * -> *) a b.
MonadMetadata m =>
[Item a] -> String -> m (Context b)
pluginCtx [Item String]
posts) [String
"d3", String
"mathjs"]
let blogCtx :: Context String
blogCtx = [Context String] -> Context String
forall a. Monoid a => [a] -> a
mconcat [
String
-> Context String -> Compiler [Item String] -> Context String
forall a b. String -> Context a -> Compiler [Item a] -> Context b
listField String
"posts" Context String
postCtx' ([Item String] -> Compiler [Item String]
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return [Item String]
posts)
, Context String
pCtx
, Paginate -> PageNumber -> Context String
forall a. Paginate -> PageNumber -> Context a
paginateContext Paginate
pgs PageNumber
pn
, Context String
-> (String -> Context String) -> Maybe String -> Context String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Context String
forall a. Context a
missingField (String -> String -> Context String
forall a. String -> String -> Context a
constField String
"title") Maybe String
title
, ListPageOpts -> Context String
lpList ListPageOpts
bc
, String -> Tags -> Context String
forall a. String -> Tags -> Context a
tagCloudField' String
"tag-cloud" Tags
tags
, ListPageOpts -> Context String
lpName ListPageOpts
bc
, ListPageOpts -> Context String
lpFont ListPageOpts
bc
, ListPageOpts -> Context String
lpDescription ListPageOpts
bc
, ListPageOpts -> Context String
lpBeforeContentBodyAdditionalComponent ListPageOpts
bc
, ListPageOpts -> Context String
lpHeaderAdditionalComponent ListPageOpts
bc
, ListPageOpts -> Context String
lpGSuite ListPageOpts
bc
]
postCtx' :: Context String
postCtx' = [Context String] -> Context String
forall a. Monoid a => [a] -> a
mconcat [
String -> String -> Context String
teaserField String
"teaser" (ListPageOpts -> String
lpContentSnapshot ListPageOpts
bc)
, ListPageOpts -> Context String
lpPost ListPageOpts
bc
, ListPageOpts -> Context String
lpName ListPageOpts
bc
, Context String
pCtx
]
String -> Compiler (Item String)
forall a. a -> Compiler (Item a)
makeItem String
""
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 (String -> Identifier
fromFilePath (String -> Identifier) -> String -> Identifier
forall a b. (a -> b) -> a -> b
$ String
tmBlogRoot String -> String -> String
</> String
"post-list.html") Context String
blogCtx
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
>>= String
-> TimeLocale -> TimeZone -> Item String -> Compiler (Item String)
forall a.
(Binary a, Typeable a, Semigroup a) =>
String -> TimeLocale -> TimeZone -> Item a -> Compiler (Item a)
appendFooter (ListPageOpts -> String
lpTitle ListPageOpts
bc) TimeLocale
defaultTimeLocale' TimeZone
timeZoneJST
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 (String -> Identifier
fromFilePath (String -> Identifier) -> String -> Identifier
forall a b. (a -> b) -> a -> b
$ String
tmBlogRoot String -> String -> String
</> String
"default.html") Context String
blogCtx
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