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 { DateConfig -> TimeLocale dateConfigLocale :: TimeLocale, DateConfig -> ZonedTime dateConfigCurrentTime :: ZonedTime, DateConfig -> String dateConfigDateLongFormat :: String, DateConfig -> String dateConfigDateShortFormat :: String, DateConfig -> String dateConfigTimeFormat :: String, DateConfig -> String dateConfigRobotDateFormat :: String, DateConfig -> String dateConfigRobotTimeFormat :: String } defaultDateConfigWith :: TimeLocale -> ZonedTime -> DateConfig defaultDateConfigWith :: TimeLocale -> ZonedTime -> DateConfig defaultDateConfigWith TimeLocale locale ZonedTime currentTime = DateConfig { dateConfigLocale :: TimeLocale dateConfigLocale = TimeLocale locale, dateConfigCurrentTime :: ZonedTime dateConfigCurrentTime = ZonedTime currentTime, dateConfigDateLongFormat :: String dateConfigDateLongFormat = String "%B %e, %Y %l:%M %P %EZ", dateConfigDateShortFormat :: String dateConfigDateShortFormat = String "%B %e, %Y", dateConfigTimeFormat :: String dateConfigTimeFormat = String "%l:%M %p %EZ", dateConfigRobotDateFormat :: String dateConfigRobotDateFormat = String "%Y-%m-%d", dateConfigRobotTimeFormat :: String dateConfigRobotTimeFormat = String "%Y-%m-%dT%H:%M:%S%Ez" } dateFields :: DateConfig -> Context a dateFields :: forall a. DateConfig -> Context a dateFields DateConfig config = forall a. Monoid a => [a] -> a mconcat [ forall a. String -> TimeLocale -> ZonedTime -> Context a dateField String "date" (DateConfig -> TimeLocale dateConfigLocale DateConfig config) (DateConfig -> ZonedTime dateConfigCurrentTime DateConfig config), forall a. String -> TimeLocale -> Context a publishedField String "published" (DateConfig -> TimeLocale dateConfigLocale DateConfig config), forall a. String -> TimeLocale -> Context a updatedField String "updated" (DateConfig -> TimeLocale dateConfigLocale DateConfig config), forall a. String -> Context a isPublishedField String "isPublished", forall a. String -> Context a isUpdatedField String "isUpdated", forall v a. IntoValue v a => String -> v -> Context a constField String "longDate" (DateConfig -> String dateConfigDateLongFormat DateConfig config), forall v a. IntoValue v a => String -> v -> Context a constField String "shortDate" (DateConfig -> String dateConfigDateShortFormat DateConfig config), forall v a. IntoValue v a => String -> v -> Context a constField String "timeOnly" (DateConfig -> String dateConfigTimeFormat DateConfig config), forall v a. IntoValue v a => String -> v -> Context a constField String "robotDate" (DateConfig -> String dateConfigRobotDateFormat DateConfig config), forall v a. IntoValue v a => String -> v -> Context a constField String "robotTime" (DateConfig -> String dateConfigRobotTimeFormat DateConfig config), forall v a. IntoValue v a => String -> v -> Context a constField String "rfc822" String rfc822DateFormat, forall a. String -> TimeLocale -> Context a dateFormatField String "dateAs" (DateConfig -> TimeLocale dateConfigLocale DateConfig config) ] dateFormatField :: String -> TimeLocale -> Context a dateFormatField :: forall a. String -> TimeLocale -> Context a dateFormatField String key TimeLocale timeLocale = forall v a x w. (FromValue v a, FromValue x a, IntoValue w a) => String -> (v -> x -> TemplateRunner a w) -> Context a functionField2 String key String -> String -> StateT (TemplateState a) Compiler String f where f :: String -> String -> StateT (TemplateState a) Compiler String f (String dateFormat :: String) (String dateString :: String) = do ZonedTime date <- String -> StateT (TemplateState a) Compiler ZonedTime deserializeTime String dateString forall (m :: * -> *) a. Monad m => a -> m a return forall a b. (a -> b) -> a -> b $ forall t. FormatTime t => TimeLocale -> String -> t -> String formatTime TimeLocale timeLocale String dateFormat ZonedTime date deserializeTime :: String -> StateT (TemplateState a) Compiler ZonedTime deserializeTime = forall (m :: * -> *). MonadFail m => TimeLocale -> String -> String -> m ZonedTime parseTimeM' TimeLocale timeLocale String normalizedDateTimeFormat dateField :: String -> TimeLocale -> ZonedTime -> Context a dateField :: forall a. String -> TimeLocale -> ZonedTime -> Context a dateField String key TimeLocale timeLocale ZonedTime currentTime = forall v a. IntoValue v a => String -> (Item a -> TemplateRunner a v) -> Context a field String key Item a -> StateT (TemplateState a) Compiler String f where f :: Item a -> StateT (TemplateState a) Compiler String f Item a item = do Metadata metadata <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (m :: * -> *). MonadMetadata m => Identifier -> m Metadata getMetadata forall a b. (a -> b) -> a -> b $ forall a. Item a -> Identifier itemIdentifier Item a item forall a b. String -> TemplateRunner a b -> TemplateRunner a b tplWithCall String key forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift forall a b. (a -> b) -> a -> b $ do let maybeDateString :: Maybe String maybeDateString = TimeLocale -> [String] -> Metadata -> Maybe String dateFromMetadata TimeLocale timeLocale [String "date", String "published"] Metadata metadata forall b a. b -> (a -> b) -> Maybe a -> b maybe (forall a. TimeLocale -> Item a -> Compiler String dateFromFilePath TimeLocale timeLocale Item a item) forall (m :: * -> *) a. Monad m => a -> m a return Maybe String maybeDateString forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> forall (m :: * -> *) a. Monad m => a -> m a return (forall t. FormatTime t => TimeLocale -> String -> t -> String formatTime TimeLocale timeLocale String "%Y-%m-%dT%H:%M:%S%Ez" ZonedTime currentTime) publishedField :: String -> TimeLocale -> Context a publishedField :: forall a. String -> TimeLocale -> Context a publishedField String key TimeLocale timeLocale = forall v a. IntoValue v a => String -> (Item a -> TemplateRunner a v) -> Context a field String key Item a -> StateT (TemplateState a) Compiler String f where f :: Item a -> StateT (TemplateState a) Compiler String f = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (m :: * -> *). MonadMetadata m => Identifier -> m Metadata getMetadata forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. Item a -> Identifier itemIdentifier forall (m :: * -> *) a b c. Monad m => (a -> m b) -> (b -> m c) -> a -> m c >=> forall a b. String -> TemplateRunner a b -> TemplateRunner a b tplWithCall String key forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift forall b c a. (b -> c) -> (a -> b) -> a -> c . forall b a. b -> (a -> b) -> Maybe a -> b maybe (forall a. String -> Compiler a noResult forall a b. (a -> b) -> a -> b $ String "Tried published field " forall a. [a] -> [a] -> [a] ++ forall a. Show a => a -> String show String key) forall (m :: * -> *) a. Monad m => a -> m a return forall b c a. (b -> c) -> (a -> b) -> a -> c . TimeLocale -> [String] -> Metadata -> Maybe String dateFromMetadata TimeLocale timeLocale [String "published", String "date"] updatedField :: String -> TimeLocale -> Context a updatedField :: forall a. String -> TimeLocale -> Context a updatedField String key TimeLocale timeLocale = forall v a. IntoValue v a => String -> (Item a -> TemplateRunner a v) -> Context a field String key Item a -> StateT (TemplateState a) Compiler String f where f :: Item a -> StateT (TemplateState a) Compiler String f = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (m :: * -> *). MonadMetadata m => Identifier -> m Metadata getMetadata forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. Item a -> Identifier itemIdentifier forall (m :: * -> *) a b c. Monad m => (a -> m b) -> (b -> m c) -> a -> m c >=> forall a b. String -> TemplateRunner a b -> TemplateRunner a b tplWithCall String key forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift forall b c a. (b -> c) -> (a -> b) -> a -> c . forall b a. b -> (a -> b) -> Maybe a -> b maybe (forall a. String -> Compiler a noResult forall a b. (a -> b) -> a -> b $ String "Tried updated field " forall a. [a] -> [a] -> [a] ++ forall a. Show a => a -> String show String key) forall (m :: * -> *) a. Monad m => a -> m a return forall b c a. (b -> c) -> (a -> b) -> a -> c . TimeLocale -> [String] -> Metadata -> Maybe String dateFromMetadata TimeLocale timeLocale [String "updated", String "published", String "date"] getLastModifiedDate :: TimeLocale -> Item a -> Compiler ZonedTime getLastModifiedDate :: forall a. TimeLocale -> Item a -> Compiler ZonedTime getLastModifiedDate TimeLocale timeLocale Item a item = do Metadata metadata <- forall (m :: * -> *). MonadMetadata m => Identifier -> m Metadata getMetadata forall a b. (a -> b) -> a -> b $ forall a. Item a -> Identifier itemIdentifier Item a item let maybeDateString :: Maybe String maybeDateString = TimeLocale -> [String] -> Metadata -> Maybe String dateFromMetadata TimeLocale timeLocale [String "updated", String "published", String "date"] Metadata metadata String dateString <- forall b a. b -> (a -> b) -> Maybe a -> b maybe (forall a. TimeLocale -> Item a -> Compiler String dateFromFilePath TimeLocale timeLocale Item a item) forall (m :: * -> *) a. Monad m => a -> m a return Maybe String maybeDateString forall (m :: * -> *). MonadFail m => TimeLocale -> String -> String -> m ZonedTime parseTimeM' TimeLocale timeLocale String "%Y-%m-%dT%H:%M:%S%Ez" String dateString dateFromMetadata :: TimeLocale -> [String] -> Metadata -> Maybe String dateFromMetadata :: TimeLocale -> [String] -> Metadata -> Maybe String dateFromMetadata TimeLocale timeLocale [String] sourceKeys Metadata metadata = forall (m :: * -> *) (n :: * -> *) a. (Foldable m, Alternative n) => m (n a) -> n a firstAlt forall a b. (a -> b) -> a -> b $ String -> Maybe String findDate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [String] sourceKeys where findDate :: String -> Maybe String findDate String sourceKey = String -> Maybe String serializeTime forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< String -> Metadata -> Maybe String lookupString String sourceKey Metadata metadata serializeTime :: String -> Maybe String serializeTime String dateString = do ZonedTime date <- forall (m :: * -> *) (n :: * -> *) a. (Foldable m, Alternative n) => m (n a) -> n a firstAlt (String -> String -> Maybe ZonedTime parse String dateString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [String] metadataDateFormats) forall (m :: * -> *) a. Monad m => a -> m a return forall a b. (a -> b) -> a -> b $ TimeLocale -> ZonedTime -> String normalizedTime TimeLocale timeLocale ZonedTime date parse :: String -> String -> Maybe ZonedTime parse = forall a b c. (a -> b -> c) -> b -> a -> c flip forall a b. (a -> b) -> a -> b $ forall (m :: * -> *) t. (MonadFail m, ParseTime t) => Bool -> TimeLocale -> String -> String -> m t parseTimeM Bool True TimeLocale timeLocale dateFromFilePath :: TimeLocale -> Item a -> Compiler String dateFromFilePath :: forall a. TimeLocale -> Item a -> Compiler String dateFromFilePath TimeLocale timeLocale Item a item = Compiler String dateFromPath forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> forall a. String -> Compiler a noResult (String "Could not find file path date from " forall a. [a] -> [a] -> [a] ++ forall a. Show a => a -> String show (Identifier -> String toFilePath forall a b. (a -> b) -> a -> b $ forall a. Item a -> Identifier itemIdentifier Item a item)) where dateFromPath :: Compiler String dateFromPath = forall (m :: * -> *) (n :: * -> *) a. (Foldable m, Alternative n) => m (n a) -> n a firstAlt forall a b. (a -> b) -> a -> b $ String -> Compiler String dateFromPath' forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. [a] -> [[a]] -> [a] intercalate String "-" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> ( [forall a. Int -> [a] -> [a] take Int 3 forall a b. (a -> b) -> a -> b $ forall a. Eq a => [a] -> [a] -> [[a]] split String "-" String fnCand | String fnCand <- forall a. [a] -> [a] reverse [String] paths] forall a. [a] -> [a] -> [a] ++ (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (forall a. Int -> [a] -> [a] take Int 3) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall a. [a] -> [a] reverse (forall a. [a] -> [[a]] tails [String] paths)) ) paths :: [String] paths = String -> [String] splitDirectories forall a b. (a -> b) -> a -> b $ String -> String dropExtension forall a b. (a -> b) -> a -> b $ Identifier -> String toFilePath forall a b. (a -> b) -> a -> b $ forall a. Item a -> Identifier itemIdentifier Item a item dateFromPath' :: String -> Compiler String dateFromPath' String path = do String -> Compiler () debugCompiler forall a b. (a -> b) -> a -> b $ String "Trying to parse date from path " forall a. [a] -> [a] -> [a] ++ forall a. Show a => a -> String show String path ZonedTime date <- forall (m :: * -> *). MonadFail m => TimeLocale -> String -> String -> m ZonedTime parseTimeM' TimeLocale timeLocale String "%Y-%m-%d" String path forall (m :: * -> *) a. Monad m => a -> m a return forall a b. (a -> b) -> a -> b $ TimeLocale -> ZonedTime -> String normalizedTime TimeLocale timeLocale ZonedTime date parseTimeM' :: (MonadFail m) => TimeLocale -> String -> String -> m ZonedTime parseTimeM' :: forall (m :: * -> *). MonadFail m => TimeLocale -> String -> String -> m ZonedTime parseTimeM' = forall (m :: * -> *) t. (MonadFail m, ParseTime t) => Bool -> TimeLocale -> String -> String -> m t parseTimeM Bool True normalizedTime :: TimeLocale -> ZonedTime -> String normalizedTime :: TimeLocale -> ZonedTime -> String normalizedTime = forall a b c. (a -> b -> c) -> b -> a -> c flip forall t. FormatTime t => TimeLocale -> String -> t -> String formatTime String normalizedDateTimeFormat normalizedDateTimeFormat :: String normalizedDateTimeFormat :: String normalizedDateTimeFormat = String "%Y-%m-%dT%H:%M:%S%Ez" rfc822DateFormat :: String rfc822DateFormat :: String rfc822DateFormat = String "%a, %d %b %Y %H:%M:%S %Z" metadataDateFormats :: [String] metadataDateFormats :: [String] metadataDateFormats = [ String "%Y-%m-%d", String normalizedDateTimeFormat, String "%Y-%m-%dT%H:%M:%S", String "%Y-%m-%d %H:%M:%S %EZ", String "%Y-%m-%d %H:%M:%S%Ez", String "%Y-%m-%d %H:%M:%S", String rfc822DateFormat, String "%a, %d %b %Y %H:%M:%S", String "%B %e, %Y %l:%M %p %EZ", String "%B %e, %Y %l:%M %p", String "%b %e, %Y %l:%M %p %EZ", String "%b %e, %Y %l:%M %p", String "%B %e, %Y", String "%B %d, %Y", String "%b %e, %Y", String "%b %d, %Y" ] isPublishedField :: String -> Context a isPublishedField :: forall a. String -> Context a isPublishedField String key = forall v a. IntoValue v a => String -> (Item a -> TemplateRunner a v) -> Context a field String key forall {t :: (* -> *) -> * -> *} {m :: * -> *} {a}. (MonadTrans t, MonadMetadata m) => Item a -> t m Bool f where f :: Item a -> t m Bool f Item a item = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift do forall (m :: * -> *). MonadMetadata m => Identifier -> m Metadata getMetadata (forall a. Item a -> Identifier itemIdentifier Item a item) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b <&> forall a. Maybe a -> Bool isJust forall b c a. (b -> c) -> (a -> b) -> a -> c . forall v. Key -> KeyMap v -> Maybe v KeyMap.lookup (String -> Key Key.fromString String "published") isUpdatedField :: String -> Context a isUpdatedField :: forall a. String -> Context a isUpdatedField String key = forall v a. IntoValue v a => String -> (Item a -> TemplateRunner a v) -> Context a field String key forall {t :: (* -> *) -> * -> *} {m :: * -> *} {a}. (MonadTrans t, MonadMetadata m) => Item a -> t m Bool f where f :: Item a -> t m Bool f Item a item = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift do forall (m :: * -> *). MonadMetadata m => Identifier -> m Metadata getMetadata (forall a. Item a -> Identifier itemIdentifier Item a item) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b <&> forall a. Maybe a -> Bool isJust forall b c a. (b -> c) -> (a -> b) -> a -> c . forall v. Key -> KeyMap v -> Maybe v KeyMap.lookup (String -> Key Key.fromString String "updated")