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 -- ^ 'FileStore' to work in -> TimeLocale -- ^ Output time locale -> Identifier -- ^ Input page -> Compiler UTCTime -- ^ Returns the time of the first revision if -- revisions are available, date of the -- identifier otherwise fsGetItemUTC fs locale = fsGetWithFallback fsGetItemUTC' (getItemUTC locale) fs fsGetItemUTC' :: FileStore -- ^ 'FileStore' to work in -> Identifier -- ^ Input page -> Compiler (Maybe UTCTime) -- ^ Returns 'Just' the time of the -- first revision if the file has -- some revisions, 'Nothing' -- otherwise fsGetItemUTC' = extractFromRevisions (listToMaybe . map revDateTime . reverse) fsDateField :: FileStore -- ^ 'FileStore' to work in -> String -- ^ Destination key -> String -- ^ Format to use on the date -> Context a -- ^ Resulting context fsDateField fs = fsDateFieldWith fs defaultTimeLocale fsDateFieldWith :: FileStore -- ^ 'FileStore' to work in -> TimeLocale -- ^ Output time locale -> String -- ^ Destination key -> String -- ^ Format to use on the date -> Context a -- ^ Resulting context fsDateFieldWith fs locale = generateFsTimeFieldWith (`fsGetItemUTC` locale) fs locale fsGetItemModificationTime :: FileStore -- ^ 'FileStore' to work in -> Identifier -- ^ Input page -> Compiler UTCTime -- ^ Returns the time of the last -- revision if revisions are -- available, modification time -- of the file otherwise. fsGetItemModificationTime = fsGetWithFallback fsGetItemModificationTime' getItemModificationTime fsGetItemModificationTime' :: FileStore -- ^ 'FileStore' to -- work in -> Identifier -- ^ Identifier in -- question -> Compiler (Maybe UTCTime) -- ^ Returns 'Just' the -- time of last revision -- if the file has some -- revisions, 'Nothing' -- otherwise. fsGetItemModificationTime' = extractFromRevisions (listToMaybe . map revDateTime) fsModificationTimeField :: FileStore -- ^ 'FileStore' to work in -> String -- ^ Destination key -> String -- ^ Format to use on the date -> Context a -- ^ Resulting context fsModificationTimeField fs = fsModificationTimeFieldWith fs defaultTimeLocale fsModificationTimeFieldWith :: FileStore -- ^ 'FileStore' to work in -> TimeLocale -- ^ Output time locale -> String -- ^ Destination key -> String -- ^ Format to use on the date -> Context a -- ^ Resulting context fsModificationTimeFieldWith = generateFsTimeFieldWith fsGetItemModificationTime -------------------------------------------------------------------------------- -- TODO: Add "getters" for other fields of "Revision"? fsGetRevisions :: FileStore -- ^ 'FileStore' to work in -> Identifier -- ^ Input Page -> Compiler [Revision] -- ^ Returns the revisions of the page -- in reverse chronological order fsGetRevisions = extractFromRevisions id fsGetAuthors :: FileStore -- ^ 'FileStore' to work in -> Identifier -- ^ Input Page -> Compiler [Author] -- ^ Returns the authors of the page in -- chronological order of occurence in the -- revisions fsGetAuthors fs i = (nub . map revAuthor . reverse) <$> fsGetRevisions fs i fsGetAuthorNames :: FileStore -- ^ 'FileStore' to work in -> Identifier -- ^ Input Page -> Compiler [String] -- ^ Returns the names of the authors of -- the page in chronological order of -- occurence in the revisions fsGetAuthorNames fs i = map authorName <$> fsGetAuthors fs i fsAuthorNamesField :: FileStore -- ^ 'FileStore' to work in -> String -- ^ Destination key -> Context a -- ^ Resulting context fsAuthorNamesField = flip fsAuthorNamesFieldWith ", " -- ^ @fsAuthorNamesField = flip fsAuthorNamesFieldWith ", "@ fsAuthorNamesFieldWith :: FileStore -- ^ 'FileStore' to work in -> String -- ^ Intercalation delimeter -> String -- ^ Destination key -> Context a -- ^ Resulting context fsAuthorNamesFieldWith = fsIntercalateToContext fsGetAuthorNames -- ^ Field consisting of the names of the authors separated by the -- given delimeter. fsGetAuthorEmails :: FileStore -- ^ 'FileStore' to work in -> Identifier -- ^ Input Page -> Compiler [String] -- ^ Returns the email addresses of the -- authors of the page in chronological -- chronological order of occurence -- in the revisions fsGetAuthorEmails fs i = map authorEmail <$> fsGetAuthors fs i fsAuthorEmailsField :: FileStore -- ^ 'FileStore' to work in -> String -- ^ Destination key -> Context a -- ^ Resulting context fsAuthorEmailsField = flip fsAuthorEmailsFieldWith ", " -- ^ @fsAuthorEmailsField = flip fsAuthorEmailsFieldWith ", "@ fsAuthorEmailsFieldWith :: FileStore -- ^ 'FileStore' to work in -> String -- ^ Intercalation delimeter -> String -- ^ Destination key -> Context a -- ^ Resulting context fsAuthorEmailsFieldWith = fsIntercalateToContext fsGetAuthorEmails -- ^ Field consisting of the email addresses of the authors separated -- by the given delimeter. --------------------------------------------------------------------------------