hakyll-filestore-0.1.4: src/Hakyll/FileStore/Context.hs
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.
--------------------------------------------------------------------------------