module Hakyll.FileStore.Context
( fsGetItemUTC
, fsGetItemUTC'
, fsDateField
, fsDateFieldWith
, fsGetItemModificationTime
, fsGetItemModificationTime'
, fsModificationTimeField
, fsModificationTimeFieldWith
, fsGetRevisions
, fsGetAuthors
, fsGetAuthorNames
, fsAuthorNamesField
, fsAuthorNamesFieldWith
, fsGetAuthorEmails
, fsAuthorEmailsField
, fsAuthorEmailsFieldWith
) where
import Control.Monad (liftM)
import Data.Time.Clock (UTCTime)
import Data.FileStore (Author,
FileStore,
Revision,
TimeRange (TimeRange),
authorEmail,
authorName,
history,
revAuthor,
revDateTime)
import Data.List (intercalate, nub)
import Data.Maybe (listToMaybe)
import Data.Time.Format (formatTime)
import Data.Time.Locale.Compat (TimeLocale, defaultTimeLocale)
import Hakyll.Core.Compiler (Compiler, unsafeCompiler)
import Hakyll.Core.Identifier (Identifier, toFilePath)
import Hakyll.Core.Item (itemIdentifier)
import Hakyll.Web.Template.Context (Context,
field,
getItemModificationTime,
getItemUTC)
fsGetWithFallback :: Monad m
=> (FileStore -> Identifier -> m (Maybe a))
-> (Identifier -> m a)
-> FileStore
-> Identifier
-> m a
fsGetWithFallback fsF f fs i = do
maybeIt <- fsF fs i
maybe (f i) return maybeIt
extractFromRevisions :: ([Revision] -> a)
-> FileStore
-> Identifier
-> Compiler a
extractFromRevisions f fs i = unsafeCompiler $ do
let path = toFilePath i
revisions <- history fs [path] (TimeRange Nothing Nothing) Nothing
return $ f revisions
generateFsField :: (FileStore -> Identifier -> Compiler String)
-> FileStore
-> String
-> Context a
generateFsField fsF fs key =
field key (fsF fs . itemIdentifier)
fsIntercalateToContext :: (FileStore -> Identifier -> Compiler [String])
-> FileStore
-> String
-> String
-> Context a
fsIntercalateToContext fsF fs delimeter =
generateFsField (\ fs' -> liftM (intercalate delimeter) . fsF fs') fs
generateFsTimeFieldWith :: (FileStore -> Identifier -> Compiler UTCTime)
-> FileStore
-> TimeLocale
-> String
-> String
-> Context a
generateFsTimeFieldWith fsF fs locale key fmt = field key $ \ i -> do
time <- fsF fs $ itemIdentifier i
return $ formatTime locale fmt time
fsGetItemUTC :: FileStore
-> TimeLocale
-> Identifier
-> Compiler UTCTime
fsGetItemUTC fs locale =
fsGetWithFallback fsGetItemUTC' (getItemUTC locale) fs
fsGetItemUTC' :: FileStore
-> Identifier
-> Compiler (Maybe UTCTime)
fsGetItemUTC' =
extractFromRevisions (listToMaybe . map revDateTime . reverse)
fsDateField :: FileStore
-> String
-> String
-> Context a
fsDateField fs = fsDateFieldWith fs defaultTimeLocale
fsDateFieldWith :: FileStore
-> TimeLocale
-> String
-> String
-> Context a
fsDateFieldWith fs locale =
generateFsTimeFieldWith (`fsGetItemUTC` locale) fs locale
fsGetItemModificationTime :: FileStore
-> Identifier
-> Compiler UTCTime
fsGetItemModificationTime =
fsGetWithFallback fsGetItemModificationTime' getItemModificationTime
fsGetItemModificationTime' :: FileStore
-> Identifier
-> Compiler (Maybe UTCTime)
fsGetItemModificationTime' =
extractFromRevisions (listToMaybe . map revDateTime)
fsModificationTimeField :: FileStore
-> String
-> String
-> Context a
fsModificationTimeField fs = fsModificationTimeFieldWith fs defaultTimeLocale
fsModificationTimeFieldWith :: FileStore
-> TimeLocale
-> String
-> String
-> Context a
fsModificationTimeFieldWith = generateFsTimeFieldWith fsGetItemModificationTime
fsGetRevisions :: FileStore
-> Identifier
-> Compiler [Revision]
fsGetRevisions = extractFromRevisions id
fsGetAuthors :: FileStore
-> Identifier
-> Compiler [Author]
fsGetAuthors fs i = (nub . map revAuthor . reverse) <$> fsGetRevisions fs i
fsGetAuthorNames :: FileStore
-> Identifier
-> Compiler [String]
fsGetAuthorNames fs i = map authorName <$> fsGetAuthors fs i
fsAuthorNamesField :: FileStore
-> String
-> Context a
fsAuthorNamesField = flip fsAuthorNamesFieldWith ", "
fsAuthorNamesFieldWith :: FileStore
-> String
-> String
-> Context a
fsAuthorNamesFieldWith = fsIntercalateToContext fsGetAuthorNames
fsGetAuthorEmails :: FileStore
-> Identifier
-> Compiler [String]
fsGetAuthorEmails fs i = map authorEmail <$> fsGetAuthors fs i
fsAuthorEmailsField :: FileStore
-> String
-> Context a
fsAuthorEmailsField = flip fsAuthorEmailsFieldWith ", "
fsAuthorEmailsFieldWith :: FileStore
-> String
-> String
-> Context a
fsAuthorEmailsFieldWith = fsIntercalateToContext fsGetAuthorEmails