{-# LANGUAGE LambdaCase #-}
module Hakyll.Web.Series
( seriesField
, getSeries
, buildSeries
) where
import Control.Applicative
import Control.Arrow
import Control.Monad
import Data.List (elemIndex)
import qualified Data.Map.Strict as Map
import Data.Monoid
import qualified Data.Set as Set
import Hakyll
getSeries :: MonadMetadata m => Identifier -> m (Maybe String)
getSeries = flip getMetadataField "series"
toAlt :: (Foldable f, Alternative m) => f a -> m a
toAlt = getAlt . foldMap pure
infixr 1 >->
(>->) :: Functor f => (a -> f b) -> (b -> c) -> a -> f c
f >-> g = f >>> fmap g
seriesField :: Tags -> Context a
seriesField tags = Context $ const . \case
"series" -> seriesName
>-> StringField
"seriesCurPos" -> itemIdentifier &&& otherPostsInSeries
>>> sequence
>>> fmap (uncurry elemIndex)
>=> toAlt
>-> succ
>>> show
>>> StringField
"seriesLength" -> otherPostsInSeries
>-> length
>>> show
>>> StringField
"seriesUrl" -> seriesName
>=> tagsMakeId tags
>>> getRoute
>=> toAlt
>-> toUrl
>>> StringField
_ -> const empty
where
seriesName = itemIdentifier
>>> getSeries
>=> toAlt
otherPostsInSeries = seriesName
>=> flip lookup (tagsMap tags)
>>> toAlt
buildSeries :: MonadMetadata m
=> Pattern
-> (String -> Identifier)
-> m Tags
buildSeries pattrn makeId = do
ids <- getMatches pattrn
tagMap <- foldM addTags Map.empty ids
let set' = Set.fromList ids
inOrder <- (traverse.traverse) sortChronological (Map.assocs tagMap)
pure $ Tags inOrder makeId (PatternDependency pattrn set')
where
addTags tagMap id' =
maybe tagMap (\k -> Map.insertWith (++) k [id'] tagMap) <$> getSeries id'