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")