module IHP.SEO.Sitemap.ControllerFunctions where

import IHP.Prelude
import IHP.ControllerPrelude
import IHP.SEO.Sitemap.Types
import qualified Text.Blaze as Markup
import qualified Text.Blaze.Internal as Markup
import qualified Text.Blaze.Renderer.Utf8 as Markup

renderXmlSitemap :: (?context::ControllerContext) => Sitemap -> IO ()
renderXmlSitemap :: (?context::ControllerContext) => Sitemap -> IO ()
renderXmlSitemap Sitemap { [SitemapLink]
links :: [SitemapLink]
links :: Sitemap -> [SitemapLink]
links } = do
    let sitemap :: Markup
sitemap = [Markup] -> Markup
forall a. ToMarkup a => a -> Markup
Markup.toMarkup [Markup
xmlDocument, Markup
sitemapLinks]
    (?context::ControllerContext) => LByteString -> IO ()
LByteString -> IO ()
renderXml (LByteString -> IO ()) -> LByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Markup -> LByteString
Markup.renderMarkup Markup
sitemap
    where
        xmlDocument :: Markup
xmlDocument = Text -> Markup
Markup.preEscapedText Text
"<?xml version=\"1.0\" encoding=\"UTF-8\"?>"
        urlSet :: Markup -> Markup
urlSet = Tag -> Markup -> Markup
Markup.customParent Tag
"urlset" (Markup -> Markup) -> Attribute -> Markup -> Markup
forall h. Attributable h => h -> Attribute -> h
Markup.! Tag -> AttributeValue -> Attribute
Markup.customAttribute Tag
"xmlns" AttributeValue
"http://www.sitemaps.org/schemas/sitemap/0.9"
        sitemapLinks :: Markup
sitemapLinks = Markup -> Markup
urlSet ([Markup] -> Markup
forall a. ToMarkup a => a -> Markup
Markup.toMarkup ((SitemapLink -> Markup) -> [SitemapLink] -> [Markup]
forall a b. (a -> b) -> [a] -> [b]
map SitemapLink -> Markup
sitemapLink [SitemapLink]
links))
        sitemapLink :: SitemapLink -> Markup
sitemapLink SitemapLink { Text
url :: Text
url :: SitemapLink -> Text
url, Maybe UTCTime
lastModified :: Maybe UTCTime
lastModified :: SitemapLink -> Maybe UTCTime
lastModified, Maybe SitemapChangeFrequency
changeFrequency :: Maybe SitemapChangeFrequency
changeFrequency :: SitemapLink -> Maybe SitemapChangeFrequency
changeFrequency } =
            let
                loc :: Markup
loc = Tag -> Markup -> Markup
Markup.customParent Tag
"loc" (Text -> Markup
Markup.text Text
url)
                lastMod :: Markup
lastMod =  Tag -> Markup -> Markup
Markup.customParent Tag
"lastmod" (Text -> Markup
Markup.text (Text -> (UTCTime -> Text) -> Maybe UTCTime -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
forall a. Monoid a => a
mempty UTCTime -> Text
formatUTCTime Maybe UTCTime
lastModified))
                changeFreq :: Markup
changeFreq = Tag -> Markup -> Markup
Markup.customParent Tag
"changefreq" (Text -> Markup
Markup.text (Text
-> (SitemapChangeFrequency -> Text)
-> Maybe SitemapChangeFrequency
-> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
forall a. Monoid a => a
mempty SitemapChangeFrequency -> Text
forall a. Show a => a -> Text
show Maybe SitemapChangeFrequency
changeFrequency))
            in
                Tag -> Markup -> Markup
Markup.customParent Tag
"url" ([Markup] -> Markup
forall a. ToMarkup a => a -> Markup
Markup.toMarkup [Markup
loc, Markup
lastMod, Markup
changeFreq])

formatUTCTime :: UTCTime -> Text
formatUTCTime :: UTCTime -> Text
formatUTCTime UTCTime
utcTime = String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%Y-%m-%d" UTCTime
utcTime)