{-# LANGUAGE OverloadedStrings #-}
module Contexts.Field (
    localDateField
  , tagsField'
  , tagCloudField'
  , descriptionField
  , imageField
  , yearMonthArchiveField
  , searchBoxResultField
) where

import           Control.Monad       (forM_, liftM2)
import           Control.Monad.Trans (lift)
import           Data.Function       (on)
import           Data.Functor        ((<&>))
import           Data.List           (isSuffixOf, sortBy)
import           Data.List.Extra     (mconcatMap)
import           Data.Maybe          (catMaybes, fromMaybe)
import qualified Data.Text           as T
import qualified Data.Text.Lazy      as TL
import           Data.Time.Format    (TimeLocale (..), formatTime)
import           Data.Time.LocalTime (TimeZone (..), utcToLocalTime)
import           Hakyll
import           Lucid.Base          (Html, ToHtml (..), renderText,
                                      renderTextT, toHtml)
import           Lucid.Html5
import qualified Text.HTML.TagSoup   as TS

import           Archives            (Archives (..), MonthlyArchives,
                                      YearlyArchives)

toLink :: String -> String -> Html ()
toLink :: String -> String -> HtmlT Identity ()
toLink String
text String
path = [Attribute] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
a_ [Text -> Attribute
href_ (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> String
toUrl String
path)] (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity () -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
span_ (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity () -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ String -> HtmlT Identity ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => String -> HtmlT m ()
toHtml String
text

localDateField :: TimeLocale -> TimeZone -> String -> String -> Context a
localDateField :: forall a. TimeLocale -> TimeZone -> String -> String -> Context a
localDateField TimeLocale
locale TimeZone
zone String
key String
format = String -> (Item a -> Compiler String) -> Context a
forall a. String -> (Item a -> Compiler String) -> Context a
field String
key ((Item a -> Compiler String) -> Context a)
-> (Item a -> Compiler String) -> Context a
forall a b. (a -> b) -> a -> b
$
    (UTCTime -> String) -> Compiler UTCTime -> Compiler String
forall a b. (a -> b) -> Compiler a -> Compiler b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TimeLocale -> String -> LocalTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
locale String
format (LocalTime -> String)
-> (UTCTime -> LocalTime) -> UTCTime -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeZone -> UTCTime -> LocalTime
utcToLocalTime TimeZone
zone) (Compiler UTCTime -> Compiler String)
-> (Item a -> Compiler UTCTime) -> Item a -> Compiler String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> Identifier -> Compiler UTCTime
forall (m :: * -> *).
(MonadMetadata m, MonadFail m) =>
TimeLocale -> Identifier -> m UTCTime
getItemUTC TimeLocale
locale (Identifier -> Compiler UTCTime)
-> (Item a -> Identifier) -> Item a -> Compiler UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Item a -> Identifier
forall a. Item a -> Identifier
itemIdentifier

imageField :: String -> Context String
imageField :: String -> Context String
imageField String
key = String -> (Item String -> Compiler String) -> Context String
forall a. String -> (Item a -> Compiler String) -> Context a
field String
key ((Item String -> Compiler String) -> Context String)
-> (Item String -> Compiler String) -> Context String
forall a b. (a -> b) -> a -> b
$ \Item String
item ->
    case [Tag String] -> [String]
extractImages ([Tag String] -> [String]) -> [Tag String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [Tag String]
forall str. StringLike str => str -> [Tag str]
TS.parseTags (String -> [Tag String]) -> String -> [Tag String]
forall a b. (a -> b) -> a -> b
$ Item String -> String
forall a. Item a -> a
itemBody Item String
item of
        [] -> String -> Compiler String
forall a. String -> Compiler a
noResult (String
"Field " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
key String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Identifier -> String
forall a. Show a => a -> String
show (Item String -> Identifier
forall a. Item a -> Identifier
itemIdentifier Item String
item) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"has no image")
        (String
src:[String]
_) -> String -> Compiler String
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return String
src
    where
        extractImages :: [Tag String] -> [String]
extractImages = (Tag String -> String) -> [Tag String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Tag String -> String
forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
TS.fromAttrib String
"src") ([Tag String] -> [String])
-> ([Tag String] -> [Tag String]) -> [Tag String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tag String -> Bool) -> [Tag String] -> [Tag String]
forall a. (a -> Bool) -> [a] -> [a]
filter Tag String -> Bool
f
        f :: Tag String -> Bool
f Tag String
tag =
            let src :: String
src = String -> Tag String -> String
forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
TS.fromAttrib String
"src" Tag String
tag
                cond :: Bool
cond = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
src Bool -> Bool -> Bool
|| String -> Bool
isExternal String
src Bool -> Bool -> Bool
|| String
".svg" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
src
            in String -> Tag String -> Bool
forall str. Eq str => str -> Tag str -> Bool
TS.isTagOpenName String
"img" Tag String
tag Bool -> Bool -> Bool
&& Bool
cond

descriptionField :: String -> Int -> Context String
descriptionField :: String -> Int -> Context String
descriptionField String
key Int
len = String -> (Item String -> Compiler String) -> Context String
forall a. String -> (Item a -> Compiler String) -> Context a
field String
key ((Item String -> Compiler String) -> Context String)
-> (Item String -> Compiler String) -> Context String
forall a b. (a -> b) -> a -> b
$ Compiler String -> Item String -> Compiler String
forall a b. a -> b -> a
const (Compiler String -> Item String -> Compiler String)
-> Compiler String -> Item String -> Compiler String
forall a b. (a -> b) -> a -> b
$
    Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
len (String -> String)
-> (Item String -> String) -> Item String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
escapeHtml (String -> String)
-> (Item String -> String) -> Item String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> (Item String -> [String]) -> Item String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines (String -> [String])
-> (Item String -> String) -> Item String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Item String -> String
forall a. Item a -> a
itemBody (Item String -> String)
-> Compiler (Item String) -> Compiler String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Compiler (Item String)
getResourceBody

tagsField' :: String -> Tags -> Context a
tagsField' :: forall a. String -> Tags -> Context a
tagsField' String
key Tags
tags = String -> (Item a -> Compiler String) -> Context a
forall a. String -> (Item a -> Compiler String) -> Context a
field String
key ((Item a -> Compiler String) -> Context a)
-> (Item a -> Compiler String) -> Context a
forall a b. (a -> b) -> a -> b
$ \Item a
item -> do
    [HtmlT Identity ()]
links <- Identifier -> Compiler [String]
forall (m :: * -> *). MonadMetadata m => Identifier -> m [String]
getTags (Item a -> Identifier
forall a. Item a -> Identifier
itemIdentifier Item a
item)
        Compiler [String]
-> ([String] -> Compiler [Maybe (HtmlT Identity ())])
-> Compiler [Maybe (HtmlT Identity ())]
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> Compiler (Maybe (HtmlT Identity ())))
-> [String] -> Compiler [Maybe (HtmlT Identity ())]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (((Maybe String -> Maybe (HtmlT Identity ()))
 -> Compiler (Maybe String) -> Compiler (Maybe (HtmlT Identity ())))
-> (String -> Maybe String -> Maybe (HtmlT Identity ()))
-> (String -> Compiler (Maybe String))
-> String
-> Compiler (Maybe (HtmlT Identity ()))
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (Maybe String -> Maybe (HtmlT Identity ()))
-> Compiler (Maybe String) -> Compiler (Maybe (HtmlT Identity ()))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
(<$>) String -> Maybe String -> Maybe (HtmlT Identity ())
forall {f :: * -> *}.
Functor f =>
String -> f String -> f (HtmlT Identity ())
toLink' (Identifier -> Compiler (Maybe String)
getRoute (Identifier -> Compiler (Maybe String))
-> (String -> Identifier) -> String -> Compiler (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tags -> String -> Identifier
tagsMakeId Tags
tags))
        Compiler [Maybe (HtmlT Identity ())]
-> ([Maybe (HtmlT Identity ())] -> [HtmlT Identity ()])
-> Compiler [HtmlT Identity ()]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [Maybe (HtmlT Identity ())] -> [HtmlT Identity ()]
forall a. [Maybe a] -> [a]
catMaybes
    if [HtmlT Identity ()] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HtmlT Identity ()]
links
        then String -> Compiler String
forall a. String -> Compiler a
noResult (String
"Field " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
key String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": tag not set (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Identifier -> String
forall a. Show a => a -> String
show (Item a -> Identifier
forall a. Item a -> Identifier
itemIdentifier Item a
item) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")")
        else String -> Compiler String
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Compiler String) -> String -> Compiler String
forall a b. (a -> b) -> a -> b
$ Text -> String
TL.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ HtmlT Identity () -> Text
forall a. Html a -> Text
renderText (HtmlT Identity () -> Text) -> HtmlT Identity () -> Text
forall a b. (a -> b) -> a -> b
$ (HtmlT Identity () -> HtmlT Identity ())
-> [HtmlT Identity ()] -> HtmlT Identity ()
forall b a. Monoid b => (a -> b) -> [a] -> b
mconcatMap ([Attribute] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
span_ [Text -> Attribute
class_ Text
"tag is-dark"]) [HtmlT Identity ()]
links
    where
        toLink' :: String -> f String -> f (HtmlT Identity ())
toLink' String
tag = (String -> HtmlT Identity ()) -> f String -> f (HtmlT Identity ())
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> String -> HtmlT Identity ()
toLink String
tag)

tagCloudField' :: String -> Tags -> Context a
tagCloudField' :: forall a. String -> Tags -> Context a
tagCloudField' String
key Tags
tags = String -> (Item a -> Compiler String) -> Context a
forall a. String -> (Item a -> Compiler String) -> Context a
field String
key ((Item a -> Compiler String) -> Context a)
-> (Item a -> Compiler String) -> Context a
forall a b. (a -> b) -> a -> b
$ Compiler String -> Item a -> Compiler String
forall a b. a -> b -> a
const (Compiler String -> Item a -> Compiler String)
-> Compiler String -> Item a -> Compiler String
forall a b. (a -> b) -> a -> b
$
    Text -> String
TL.unpack (Text -> String) -> (String -> Text) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HtmlT Identity () -> Text
forall a. Html a -> Text
renderText (HtmlT Identity () -> Text)
-> (String -> HtmlT Identity ()) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Attribute] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
div_ [Text -> Attribute
class_ Text
"tags"] (HtmlT Identity () -> HtmlT Identity ())
-> (String -> HtmlT Identity ()) -> String -> HtmlT Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> HtmlT Identity ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => String -> HtmlT m ()
toHtmlRaw (String -> String) -> Compiler String -> Compiler String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> String -> Int -> Int -> Int -> String)
-> ([String] -> String) -> Tags -> Compiler String
renderTags String -> String -> Int -> Int -> Int -> String
forall {b} {b} {b}. String -> String -> b -> b -> b -> String
toLink' [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat Tags
tags
    where
        toLink' :: String -> String -> b -> b -> b -> String
toLink' String
tag String
path = (b -> b -> String) -> b -> b -> b -> String
forall a b. a -> b -> a
const ((b -> b -> String) -> b -> b -> b -> String)
-> (b -> b -> String) -> b -> b -> b -> String
forall a b. (a -> b) -> a -> b
$ (b -> String) -> b -> b -> String
forall a b. a -> b -> a
const ((b -> String) -> b -> b -> String)
-> (b -> String) -> b -> b -> String
forall a b. (a -> b) -> a -> b
$ String -> b -> String
forall a b. a -> b -> a
const (String -> b -> String) -> String -> b -> String
forall a b. (a -> b) -> a -> b
$
            Text -> String
TL.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ HtmlT Identity () -> Text
forall a. Html a -> Text
renderText (HtmlT Identity () -> Text) -> HtmlT Identity () -> Text
forall a b. (a -> b) -> a -> b
$ [Attribute] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
span_ [Text -> Attribute
class_ Text
"tag is-dark"] (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity () -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ String -> String -> HtmlT Identity ()
toLink String
tag String
path


{-# INLINE buildYearMonthArchiveField #-}
buildYearMonthArchiveField :: YearlyArchives
    -> MonthlyArchives
    -> Maybe String
    -> Compiler String
buildYearMonthArchiveField :: YearlyArchives
-> MonthlyArchives -> Maybe String -> Compiler String
buildYearMonthArchiveField YearlyArchives
ya MonthlyArchives
ma Maybe String
pageYear = (Text -> String) -> Compiler Text -> Compiler String
forall a b. (a -> b) -> Compiler a -> Compiler b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> String
TL.unpack (Compiler Text -> Compiler String)
-> Compiler Text -> Compiler String
forall a b. (a -> b) -> a -> b
$ HtmlT Compiler () -> Compiler Text
forall (m :: * -> *) a. Monad m => HtmlT m a -> m Text
renderTextT (HtmlT Compiler () -> Compiler Text)
-> HtmlT Compiler () -> Compiler Text
forall a b. (a -> b) -> a -> b
$
    [Attribute] -> HtmlT Compiler () -> HtmlT Compiler ()
forall arg result. Term arg result => arg -> result
ul_ [Text -> Attribute
class_ Text
"archive-tree"] (HtmlT Compiler () -> HtmlT Compiler ())
-> HtmlT Compiler () -> HtmlT Compiler ()
forall a b. (a -> b) -> a -> b
$ do
        let yearMap :: [(String, [Identifier])]
yearMap = ((String, [Identifier]) -> (String, [Identifier]) -> Ordering)
-> [(String, [Identifier])] -> [(String, [Identifier])]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((Int -> Int -> Ordering) -> Int -> Int -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> Int -> Ordering)
-> ((String, [Identifier]) -> Int)
-> (String, [Identifier])
-> (String, [Identifier])
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (String -> Int
forall a. Read a => String -> a
read :: String -> Int) (String -> Int)
-> ((String, [Identifier]) -> String)
-> (String, [Identifier])
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, [Identifier]) -> String
forall a b. (a, b) -> a
fst) ([(String, [Identifier])] -> [(String, [Identifier])])
-> [(String, [Identifier])] -> [(String, [Identifier])]
forall a b. (a -> b) -> a -> b
$ YearlyArchives -> [(String, [Identifier])]
forall k. Archives k -> [(k, [Identifier])]
archivesMap YearlyArchives
ya
            getUrl :: Identifier -> HtmlT Compiler String
getUrl = Compiler String -> HtmlT Compiler String
forall (m :: * -> *) a. Monad m => m a -> HtmlT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Compiler String -> HtmlT Compiler String)
-> (Identifier -> Compiler String)
-> Identifier
-> HtmlT Compiler String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe String -> String)
-> Compiler (Maybe String) -> Compiler String
forall a b. (a -> b) -> Compiler a -> Compiler b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> String
toUrl (String -> String)
-> (Maybe String -> String) -> Maybe String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"#") (Compiler (Maybe String) -> Compiler String)
-> (Identifier -> Compiler (Maybe String))
-> Identifier
-> Compiler String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> Compiler (Maybe String)
getRoute

        [(String, [Identifier])]
-> ((String, [Identifier]) -> HtmlT Compiler ())
-> HtmlT Compiler ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(String, [Identifier])]
yearMap (((String, [Identifier]) -> HtmlT Compiler ())
 -> HtmlT Compiler ())
-> ((String, [Identifier]) -> HtmlT Compiler ())
-> HtmlT Compiler ()
forall a b. (a -> b) -> a -> b
$ \(String
year, [Identifier]
yids) ->
            HtmlT Compiler () -> HtmlT Compiler ()
forall arg result. Term arg result => arg -> result
li_ (HtmlT Compiler () -> HtmlT Compiler ())
-> HtmlT Compiler () -> HtmlT Compiler ()
forall a b. (a -> b) -> a -> b
$ do
                let monthMap :: [((String, String), [Identifier])]
monthMap = (((String, String), [Identifier])
 -> ((String, String), [Identifier]) -> Ordering)
-> [((String, String), [Identifier])]
-> [((String, String), [Identifier])]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((Int -> Int -> Ordering) -> Int -> Int -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> Int -> Ordering)
-> (((String, String), [Identifier]) -> Int)
-> ((String, String), [Identifier])
-> ((String, String), [Identifier])
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (String -> Int
forall a. Read a => String -> a
read :: String -> Int) (String -> Int)
-> (((String, String), [Identifier]) -> String)
-> ((String, String), [Identifier])
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> b
snd ((String, String) -> String)
-> (((String, String), [Identifier]) -> (String, String))
-> ((String, String), [Identifier])
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, String), [Identifier]) -> (String, String)
forall a b. (a, b) -> a
fst) ([((String, String), [Identifier])]
 -> [((String, String), [Identifier])])
-> [((String, String), [Identifier])]
-> [((String, String), [Identifier])]
forall a b. (a -> b) -> a -> b
$
                        (((String, String), [Identifier]) -> Bool)
-> [((String, String), [Identifier])]
-> [((String, String), [Identifier])]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
year) (String -> Bool)
-> (((String, String), [Identifier]) -> String)
-> ((String, String), [Identifier])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> a
fst ((String, String) -> String)
-> (((String, String), [Identifier]) -> (String, String))
-> ((String, String), [Identifier])
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, String), [Identifier]) -> (String, String)
forall a b. (a, b) -> a
fst) ([((String, String), [Identifier])]
 -> [((String, String), [Identifier])])
-> [((String, String), [Identifier])]
-> [((String, String), [Identifier])]
forall a b. (a -> b) -> a -> b
$ MonthlyArchives -> [((String, String), [Identifier])]
forall k. Archives k -> [(k, [Identifier])]
archivesMap MonthlyArchives
ma
                    treeLael :: Text
treeLael = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"tree-label-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
year

                [Attribute] -> HtmlT Compiler ()
forall (m :: * -> *). Applicative m => [Attribute] -> HtmlT m ()
input_ ([Attribute] -> HtmlT Compiler ())
-> [Attribute] -> HtmlT Compiler ()
forall a b. (a -> b) -> a -> b
$ [Text -> Attribute
class_ Text
"tree-toggle", Text -> Attribute
type_ Text
"checkbox", Text -> Attribute
id_ Text
treeLael] [Attribute] -> [Attribute] -> [Attribute]
forall a. [a] -> [a] -> [a]
++
                    [Attribute
checked_ | String -> Maybe String
forall a. a -> Maybe a
Just String
year Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe String
pageYear]
                [Attribute] -> HtmlT Compiler () -> HtmlT Compiler ()
forall arg result. Term arg result => arg -> result
label_ [Text -> Attribute
class_ Text
"tree-toggle-button", Text -> Attribute
for_ Text
treeLael] (HtmlT Compiler () -> HtmlT Compiler ())
-> HtmlT Compiler () -> HtmlT Compiler ()
forall a b. (a -> b) -> a -> b
$ do
                    [Attribute] -> HtmlT Compiler () -> HtmlT Compiler ()
forall arg result. Term arg result => arg -> result
i_ [[Text] -> Attribute
classes_ [Text
"fas", Text
"fa-angle-right", Text
"fa-fw"]] HtmlT Compiler ()
""
                    [Attribute] -> HtmlT Compiler () -> HtmlT Compiler ()
forall arg result. Term arg result => arg -> result
i_ [[Text] -> Attribute
classes_ [Text
"fas", Text
"fa-angle-down", Text
"fa-fw"]] HtmlT Compiler ()
""

                String
yurl <- Identifier -> HtmlT Compiler String
getUrl (Identifier -> HtmlT Compiler String)
-> Identifier -> HtmlT Compiler String
forall a b. (a -> b) -> a -> b
$ YearlyArchives -> String -> Identifier
forall k. Archives k -> k -> Identifier
archivesMakeId YearlyArchives
ya String
year
                [Attribute] -> HtmlT Compiler () -> HtmlT Compiler ()
forall arg result. Term arg result => arg -> result
a_ [Text -> Attribute
href_ (String -> Text
T.pack String
yurl)] (HtmlT Compiler () -> HtmlT Compiler ())
-> HtmlT Compiler () -> HtmlT Compiler ()
forall a b. (a -> b) -> a -> b
$
                    String -> HtmlT Compiler ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => String -> HtmlT m ()
toHtml (String -> HtmlT Compiler ()) -> String -> HtmlT Compiler ()
forall a b. (a -> b) -> a -> b
$ String
year String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([Identifier] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Identifier]
yids) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"

                [Attribute] -> HtmlT Compiler () -> HtmlT Compiler ()
forall arg result. Term arg result => arg -> result
ul_ [Text -> Attribute
class_ Text
"tree-child"] (HtmlT Compiler () -> HtmlT Compiler ())
-> HtmlT Compiler () -> HtmlT Compiler ()
forall a b. (a -> b) -> a -> b
$
                    [((String, String), [Identifier])]
-> (((String, String), [Identifier]) -> HtmlT Compiler ())
-> HtmlT Compiler ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [((String, String), [Identifier])]
monthMap ((((String, String), [Identifier]) -> HtmlT Compiler ())
 -> HtmlT Compiler ())
-> (((String, String), [Identifier]) -> HtmlT Compiler ())
-> HtmlT Compiler ()
forall a b. (a -> b) -> a -> b
$ \(mk :: (String, String)
mk@(String
_, String
month), [Identifier]
mids) ->
                        HtmlT Compiler () -> HtmlT Compiler ()
forall arg result. Term arg result => arg -> result
li_ (HtmlT Compiler () -> HtmlT Compiler ())
-> HtmlT Compiler () -> HtmlT Compiler ()
forall a b. (a -> b) -> a -> b
$ do
                            String
murl <- Identifier -> HtmlT Compiler String
getUrl (Identifier -> HtmlT Compiler String)
-> Identifier -> HtmlT Compiler String
forall a b. (a -> b) -> a -> b
$ MonthlyArchives -> (String, String) -> Identifier
forall k. Archives k -> k -> Identifier
archivesMakeId MonthlyArchives
ma (String, String)
mk
                            [Attribute] -> HtmlT Compiler () -> HtmlT Compiler ()
forall arg result. Term arg result => arg -> result
a_ [Text -> Attribute
href_ (String -> Text
T.pack String
murl)] (HtmlT Compiler () -> HtmlT Compiler ())
-> HtmlT Compiler () -> HtmlT Compiler ()
forall a b. (a -> b) -> a -> b
$
                                String -> HtmlT Compiler ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => String -> HtmlT m ()
toHtml (String -> HtmlT Compiler ()) -> String -> HtmlT Compiler ()
forall a b. (a -> b) -> a -> b
$ String
year String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
month String -> String -> String
forall a. [a] -> [a] -> [a]
++  String
" (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([Identifier] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Identifier]
mids) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"

yearMonthArchiveField :: String
    -> YearlyArchives
    -> MonthlyArchives
    -> Maybe String
    -> Context a
yearMonthArchiveField :: forall a.
String
-> YearlyArchives -> MonthlyArchives -> Maybe String -> Context a
yearMonthArchiveField String
key YearlyArchives
ya MonthlyArchives
ma Maybe String
s = String -> (Item a -> Compiler String) -> Context a
forall a. String -> (Item a -> Compiler String) -> Context a
field String
key
    ((Item a -> Compiler String) -> Context a)
-> (Item a -> Compiler String) -> Context a
forall a b. (a -> b) -> a -> b
$ Compiler String -> Item a -> Compiler String
forall a b. a -> b -> a
const
    (Compiler String -> Item a -> Compiler String)
-> Compiler String -> Item a -> Compiler String
forall a b. (a -> b) -> a -> b
$ YearlyArchives
-> MonthlyArchives -> Maybe String -> Compiler String
buildYearMonthArchiveField YearlyArchives
ya MonthlyArchives
ma Maybe String
s

searchBoxResultField :: Context String
searchBoxResultField :: Context String
searchBoxResultField = String -> String -> Context String
forall a. String -> String -> Context a
constField String
"body" (String -> Context String) -> String -> Context String
forall a b. (a -> b) -> a -> b
$
    Text -> String
TL.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ HtmlT Identity () -> Text
forall a. Html a -> Text
renderText (HtmlT Identity () -> Text) -> HtmlT Identity () -> Text
forall a b. (a -> b) -> a -> b
$ [Attribute] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
div_ [Text -> Attribute
class_ Text
"gcse-searchresults-only"] HtmlT Identity ()
forall a. Monoid a => a
mempty