module Hakyllbars.Field.Date ( DateConfig (..), defaultDateConfigWith, dateFields, dateFormatField, dateField, publishedField, updatedField, getLastModifiedDate, isPublishedField, isUpdatedField, dateFromMetadata, normalizedDateTimeFormat, parseTimeM', ) where import Data.Aeson.Key qualified as Key import Data.Aeson.KeyMap qualified as KeyMap import Data.List (tails) import Data.String.Utils import Hakyllbars.Common import Hakyllbars.Context import Hakyllbars.Util data DateConfig = DateConfig { dateConfigLocale :: TimeLocale, dateConfigCurrentTime :: ZonedTime, dateConfigDateLongFormat :: String, dateConfigDateShortFormat :: String, dateConfigTimeFormat :: String, dateConfigRobotDateFormat :: String, dateConfigRobotTimeFormat :: String } defaultDateConfigWith :: TimeLocale -> ZonedTime -> DateConfig defaultDateConfigWith locale currentTime = DateConfig { dateConfigLocale = locale, dateConfigCurrentTime = currentTime, dateConfigDateLongFormat = "%B %e, %Y %l:%M %P %EZ", dateConfigDateShortFormat = "%B %e, %Y", dateConfigTimeFormat = "%l:%M %p %EZ", dateConfigRobotDateFormat = "%Y-%m-%d", dateConfigRobotTimeFormat = "%Y-%m-%dT%H:%M:%S%Ez" } dateFields :: DateConfig -> Context a dateFields config = mconcat [ dateField "date" (dateConfigLocale config) (dateConfigCurrentTime config), publishedField "published" (dateConfigLocale config), updatedField "updated" (dateConfigLocale config), isPublishedField "isPublished", isUpdatedField "isUpdated", constField "longDate" (dateConfigDateLongFormat config), constField "shortDate" (dateConfigDateShortFormat config), constField "timeOnly" (dateConfigTimeFormat config), constField "robotDate" (dateConfigRobotDateFormat config), constField "robotTime" (dateConfigRobotTimeFormat config), constField "rfc822" rfc822DateFormat, dateFormatField "dateAs" (dateConfigLocale config) ] dateFormatField :: String -> TimeLocale -> Context a dateFormatField key timeLocale = functionField2 key f where f (dateFormat :: String) (dateString :: String) = do date <- deserializeTime dateString return $ formatTime timeLocale dateFormat date deserializeTime = parseTimeM' timeLocale normalizedDateTimeFormat dateField :: String -> TimeLocale -> ZonedTime -> Context a dateField key timeLocale currentTime = field key f where f item = do metadata <- lift . getMetadata $ itemIdentifier item tplWithCall key . lift $ do let maybeDateString = dateFromMetadata timeLocale ["date", "published"] metadata maybe (dateFromFilePath timeLocale item) return maybeDateString <|> return (formatTime timeLocale "%Y-%m-%dT%H:%M:%S%Ez" currentTime) publishedField :: String -> TimeLocale -> Context a publishedField key timeLocale = field key f where f = lift . getMetadata . itemIdentifier >=> tplWithCall key . lift . maybe (noResult $ "Tried published field " ++ show key) return . dateFromMetadata timeLocale ["published", "date"] updatedField :: String -> TimeLocale -> Context a updatedField key timeLocale = field key f where f = lift . getMetadata . itemIdentifier >=> tplWithCall key . lift . maybe (noResult $ "Tried updated field " ++ show key) return . dateFromMetadata timeLocale ["updated", "published", "date"] getLastModifiedDate :: TimeLocale -> Item a -> Compiler ZonedTime getLastModifiedDate timeLocale item = do metadata <- getMetadata $ itemIdentifier item let maybeDateString = dateFromMetadata timeLocale ["updated", "published", "date"] metadata dateString <- maybe (dateFromFilePath timeLocale item) return maybeDateString parseTimeM' timeLocale "%Y-%m-%dT%H:%M:%S%Ez" dateString dateFromMetadata :: TimeLocale -> [String] -> Metadata -> Maybe String dateFromMetadata timeLocale sourceKeys metadata = firstAlt $ findDate <$> sourceKeys where findDate sourceKey = serializeTime =<< lookupString sourceKey metadata serializeTime dateString = do date <- firstAlt (parse dateString <$> metadataDateFormats) return $ normalizedTime timeLocale date parse = flip $ parseTimeM True timeLocale dateFromFilePath :: TimeLocale -> Item a -> Compiler String dateFromFilePath timeLocale item = dateFromPath <|> noResult ("Could not find file path date from " ++ show (toFilePath $ itemIdentifier item)) where dateFromPath = firstAlt $ dateFromPath' . intercalate "-" <$> ( [take 3 $ split "-" fnCand | fnCand <- reverse paths] ++ (fmap (take 3) <$> reverse (tails paths)) ) paths = splitDirectories $ dropExtension $ toFilePath $ itemIdentifier item dateFromPath' path = do debugCompiler $ "Trying to parse date from path " ++ show path date <- parseTimeM' timeLocale "%Y-%m-%d" path return $ normalizedTime timeLocale date parseTimeM' :: (MonadFail m) => TimeLocale -> String -> String -> m ZonedTime parseTimeM' = parseTimeM True normalizedTime :: TimeLocale -> ZonedTime -> String normalizedTime = flip formatTime normalizedDateTimeFormat normalizedDateTimeFormat :: String normalizedDateTimeFormat = "%Y-%m-%dT%H:%M:%S%Ez" rfc822DateFormat :: String rfc822DateFormat = "%a, %d %b %Y %H:%M:%S %Z" metadataDateFormats :: [String] metadataDateFormats = [ "%Y-%m-%d", normalizedDateTimeFormat, "%Y-%m-%dT%H:%M:%S", "%Y-%m-%d %H:%M:%S %EZ", "%Y-%m-%d %H:%M:%S%Ez", "%Y-%m-%d %H:%M:%S", rfc822DateFormat, "%a, %d %b %Y %H:%M:%S", "%B %e, %Y %l:%M %p %EZ", "%B %e, %Y %l:%M %p", "%b %e, %Y %l:%M %p %EZ", "%b %e, %Y %l:%M %p", "%B %e, %Y", "%B %d, %Y", "%b %e, %Y", "%b %d, %Y" ] isPublishedField :: String -> Context a isPublishedField key = field key f where f item = lift do getMetadata (itemIdentifier item) <&> isJust . KeyMap.lookup (Key.fromString "published") isUpdatedField :: String -> Context a isUpdatedField key = field key f where f item = lift do getMetadata (itemIdentifier item) <&> isJust . KeyMap.lookup (Key.fromString "updated")