{-# LANGUAGE OverloadedStrings #-}

module Archives (
    Archives (..)
  , YearlyArchives
  , MonthlyArchives
  , archivesRules
  , buildYearlyArchives
  , buildMonthlyArchives
) where

import           Control.Monad       (foldM, forM_)
import qualified Data.Map            as M
import qualified Data.Set            as S
import           Data.Time.Format    (FormatTime, TimeLocale, formatTime)
import           Data.Time.LocalTime (TimeZone, utcToLocalTime)
import           Data.Tuple.Extra    (dupe, first, second)
import           Hakyll

data Archives k = Archives {
    forall k. Archives k -> [(k, [Identifier])]
archivesMap        :: [(k, [Identifier])]
  , forall k. Archives k -> k -> Identifier
archivesMakeId     :: k -> Identifier
  , forall k. Archives k -> Dependency
archivesDependency :: Dependency
  }

type YearlyArchives = Archives String
type MonthlyArchives = Archives (String, String)

{-# INLINE fmtly #-}
fmtly :: FormatTime t => TimeLocale -> t -> String
fmtly :: forall t. FormatTime t => TimeLocale -> t -> String
fmtly TimeLocale
locale t
time = TimeLocale -> String -> t -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
locale String
"%Y" t
time

{-# INLINE fmtlm #-}
fmtlm :: FormatTime t => TimeLocale -> t -> String
fmtlm :: forall t. FormatTime t => TimeLocale -> t -> String
fmtlm TimeLocale
locale t
time = TimeLocale -> String -> t -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
locale String
"%m" t
time

buildArchivesWith :: (MonadMetadata m, Ord k)
    => (Identifier -> m [k])
    -> Pattern
    -> (k -> Identifier)
    -> m (Archives k)
buildArchivesWith :: forall (m :: * -> *) k.
(MonadMetadata m, Ord k) =>
(Identifier -> m [k])
-> Pattern -> (k -> Identifier) -> m (Archives k)
buildArchivesWith Identifier -> m [k]
f Pattern
pattern k -> Identifier
makeId = do
    [Identifier]
ids <- Pattern -> m [Identifier]
forall (m :: * -> *). MonadMetadata m => Pattern -> m [Identifier]
getMatches Pattern
pattern
    [(k, [Identifier])]
am  <- Map k [Identifier] -> [(k, [Identifier])]
forall k a. Map k a -> [(k, a)]
M.toList (Map k [Identifier] -> [(k, [Identifier])])
-> m (Map k [Identifier]) -> m [(k, [Identifier])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Map k [Identifier] -> Identifier -> m (Map k [Identifier]))
-> Map k [Identifier] -> [Identifier] -> m (Map k [Identifier])
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Map k [Identifier] -> Identifier -> m (Map k [Identifier])
addToMap Map k [Identifier]
forall k a. Map k a
M.empty [Identifier]
ids
    Archives k -> m (Archives k)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Archives k -> m (Archives k)) -> Archives k -> m (Archives k)
forall a b. (a -> b) -> a -> b
$ [(k, [Identifier])]
-> (k -> Identifier) -> Dependency -> Archives k
forall k.
[(k, [Identifier])]
-> (k -> Identifier) -> Dependency -> Archives k
Archives [(k, [Identifier])]
am k -> Identifier
makeId (Dependency -> Archives k) -> Dependency -> Archives k
forall a b. (a -> b) -> a -> b
$ Pattern -> Set Identifier -> Dependency
PatternDependency Pattern
pattern ([Identifier] -> Set Identifier
forall a. Ord a => [a] -> Set a
S.fromList [Identifier]
ids)
    where
        addToMap :: Map k [Identifier] -> Identifier -> m (Map k [Identifier])
addToMap Map k [Identifier]
m Identifier
i = do
            [k]
ks <- Identifier -> m [k]
f Identifier
i
            Map k [Identifier] -> m (Map k [Identifier])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map k [Identifier] -> m (Map k [Identifier]))
-> Map k [Identifier] -> m (Map k [Identifier])
forall a b. (a -> b) -> a -> b
$
                ([Identifier] -> [Identifier] -> [Identifier])
-> Map k [Identifier] -> Map k [Identifier] -> Map k [Identifier]
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith [Identifier] -> [Identifier] -> [Identifier]
forall a. [a] -> [a] -> [a]
(++) Map k [Identifier]
m (Map k [Identifier] -> Map k [Identifier])
-> Map k [Identifier] -> Map k [Identifier]
forall a b. (a -> b) -> a -> b
$ [(k, [Identifier])] -> Map k [Identifier]
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(k, [Identifier])] -> Map k [Identifier])
-> [(k, [Identifier])] -> Map k [Identifier]
forall a b. (a -> b) -> a -> b
$ [k] -> [[Identifier]] -> [(k, [Identifier])]
forall a b. [a] -> [b] -> [(a, b)]
zip [k]
ks ([[Identifier]] -> [(k, [Identifier])])
-> [[Identifier]] -> [(k, [Identifier])]
forall a b. (a -> b) -> a -> b
$ [Identifier] -> [[Identifier]]
forall a. a -> [a]
repeat [Identifier
i]

archivesRules :: Archives a -> (a -> Pattern -> Rules ()) -> Rules ()
archivesRules :: forall a. Archives a -> (a -> Pattern -> Rules ()) -> Rules ()
archivesRules Archives a
archives a -> Pattern -> Rules ()
rules = [(a, [Identifier])] -> ((a, [Identifier]) -> Rules ()) -> Rules ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Archives a -> [(a, [Identifier])]
forall k. Archives k -> [(k, [Identifier])]
archivesMap Archives a
archives) (((a, [Identifier]) -> Rules ()) -> Rules ())
-> ((a, [Identifier]) -> Rules ()) -> Rules ()
forall a b. (a -> b) -> a -> b
$ \(a
key, [Identifier]
identifiers) ->
    [Dependency] -> Rules () -> Rules ()
forall a. [Dependency] -> Rules a -> Rules a
rulesExtraDependencies [Archives a -> Dependency
forall k. Archives k -> Dependency
archivesDependency Archives a
archives] (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$ [Identifier] -> Rules () -> Rules ()
create [Archives a -> a -> Identifier
forall k. Archives k -> k -> Identifier
archivesMakeId Archives a
archives a
key] (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$
        a -> Pattern -> Rules ()
rules a
key (Pattern -> Rules ()) -> Pattern -> Rules ()
forall a b. (a -> b) -> a -> b
$ [Identifier] -> Pattern
fromList [Identifier]
identifiers

buildYearlyArchives :: (MonadMetadata m, MonadFail m)
    => TimeLocale
    -> TimeZone
    -> Pattern
    -> (String -> Identifier)
    -> m YearlyArchives
buildYearlyArchives :: forall (m :: * -> *).
(MonadMetadata m, MonadFail m) =>
TimeLocale
-> TimeZone
-> Pattern
-> (String -> Identifier)
-> m YearlyArchives
buildYearlyArchives TimeLocale
locale TimeZone
zone = (Identifier -> m [String])
-> Pattern -> (String -> Identifier) -> m YearlyArchives
forall (m :: * -> *) k.
(MonadMetadata m, Ord k) =>
(Identifier -> m [k])
-> Pattern -> (k -> Identifier) -> m (Archives k)
buildArchivesWith ((Identifier -> m [String])
 -> Pattern -> (String -> Identifier) -> m YearlyArchives)
-> (Identifier -> m [String])
-> Pattern
-> (String -> Identifier)
-> m YearlyArchives
forall a b. (a -> b) -> a -> b
$
    (UTCTime -> [String]) -> m UTCTime -> m [String]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> [String]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> [String]) -> (UTCTime -> String) -> UTCTime -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> LocalTime -> String
forall t. FormatTime t => TimeLocale -> t -> String
fmtly TimeLocale
locale (LocalTime -> String)
-> (UTCTime -> LocalTime) -> UTCTime -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeZone -> UTCTime -> LocalTime
utcToLocalTime TimeZone
zone) (m UTCTime -> m [String])
-> (Identifier -> m UTCTime) -> Identifier -> m [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> Identifier -> m UTCTime
forall (m :: * -> *).
(MonadMetadata m, MonadFail m) =>
TimeLocale -> Identifier -> m UTCTime
getItemUTC TimeLocale
locale

buildMonthlyArchives :: (MonadMetadata m, MonadFail m)
    => TimeLocale
    -> TimeZone
    -> Pattern
    -> ((String, String) -> Identifier)
    -> m MonthlyArchives
buildMonthlyArchives :: forall (m :: * -> *).
(MonadMetadata m, MonadFail m) =>
TimeLocale
-> TimeZone
-> Pattern
-> ((String, String) -> Identifier)
-> m MonthlyArchives
buildMonthlyArchives TimeLocale
locale TimeZone
zone = (Identifier -> m [(String, String)])
-> Pattern -> ((String, String) -> Identifier) -> m MonthlyArchives
forall (m :: * -> *) k.
(MonadMetadata m, Ord k) =>
(Identifier -> m [k])
-> Pattern -> (k -> Identifier) -> m (Archives k)
buildArchivesWith ((Identifier -> m [(String, String)])
 -> Pattern
 -> ((String, String) -> Identifier)
 -> m MonthlyArchives)
-> (Identifier -> m [(String, String)])
-> Pattern
-> ((String, String) -> Identifier)
-> m MonthlyArchives
forall a b. (a -> b) -> a -> b
$
    (UTCTime -> [(String, String)])
-> m UTCTime -> m [(String, String)]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
:[]) ((String, String) -> [(String, String)])
-> (UTCTime -> (String, String)) -> UTCTime -> [(String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LocalTime -> String) -> (LocalTime, String) -> (String, String)
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (TimeLocale -> LocalTime -> String
forall t. FormatTime t => TimeLocale -> t -> String
fmtly TimeLocale
locale) ((LocalTime, String) -> (String, String))
-> (UTCTime -> (LocalTime, String)) -> UTCTime -> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LocalTime -> String)
-> (LocalTime, LocalTime) -> (LocalTime, String)
forall b b' a. (b -> b') -> (a, b) -> (a, b')
second (TimeLocale -> LocalTime -> String
forall t. FormatTime t => TimeLocale -> t -> String
fmtlm TimeLocale
locale) ((LocalTime, LocalTime) -> (LocalTime, String))
-> (UTCTime -> (LocalTime, LocalTime))
-> UTCTime
-> (LocalTime, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalTime -> (LocalTime, LocalTime)
forall a. a -> (a, a)
dupe (LocalTime -> (LocalTime, LocalTime))
-> (UTCTime -> LocalTime) -> UTCTime -> (LocalTime, LocalTime)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeZone -> UTCTime -> LocalTime
utcToLocalTime TimeZone
zone) (m UTCTime -> m [(String, String)])
-> (Identifier -> m UTCTime) -> Identifier -> m [(String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        TimeLocale -> Identifier -> m UTCTime
forall (m :: * -> *).
(MonadMetadata m, MonadFail m) =>
TimeLocale -> Identifier -> m UTCTime
getItemUTC TimeLocale
locale