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
  { -- | The locale to use for date formatting.
    DateConfig -> TimeLocale
dateConfigLocale :: TimeLocale,
    -- | The current time (or time at which the site generator is running).
    DateConfig -> ZonedTime
dateConfigCurrentTime :: ZonedTime,
    -- | The format to use for long dates (i.e. date with time).
    DateConfig -> String
dateConfigDateLongFormat :: String,
    -- | The format to use for short dates (i.e. date without time).
    DateConfig -> String
dateConfigDateShortFormat :: String,
    -- | The format to use for time only.
    DateConfig -> String
dateConfigTimeFormat :: String,
    -- | The format to use for machine-readable dates.
    DateConfig -> String
dateConfigRobotDateFormat :: String,
    -- | The format to use for machine-readable times.
    DateConfig -> String
dateConfigRobotTimeFormat :: String
  }

-- | Creates a default date configuration with the given locale and current time.
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"
    }

-- | Creates a default date fields configuration with the given date config.
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)
    ]

-- | Gets a date formatted with the given format.
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

-- | Gets the date relative to the configured time locale and current time from the "date" or "published" fields.
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)

-- | Gets the published date of an item from the metadata fields "published" or "date".
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"]

-- | Gets the updated date of an item from the metadata fields "updated", "published", or "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"]

-- | Gets the last modified date of an item from the metadata fields "updated", "published", or "date", or the file path
-- if it contains a 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

-- | Gets a date from the given metadata fields.
dateFromMetadata ::
  -- | The time locale to use.
  TimeLocale ->
  -- | The list of metadata keys to search for.
  [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

-- | Gets a date from the item's file path.
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"

-- | Supported date formats to read from metadata.
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"
  ]

-- | Gets whether the item is published.
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")

-- | Gets whether the item has been updated.
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")