Initial Sitemap Generator

digitallyinduced · Apr 4, 2022 · a793c06 · a793c06
1 parent e2d4b6c
commit a793c06
Show file tree

Hide file tree

Showing 2 changed files with 72 additions and 0 deletions.
diff --git a/IHP/SeoSupport/Sitemap/Controller.hs b/IHP/SeoSupport/Sitemap/Controller.hs
@@ -0,0 +1,36 @@
+module IHP.SeoSupport.Sitemap.Controller where
+
+import IHP.Prelude
+import IHP.RouterPrelude (string, endOfInput, CanRoute(..), HasPath(..))
+import IHP.ControllerPrelude
+import IHP.SeoSupport.Sitemap.Types
+
+data SitemapController
+    = SitemapAction
+    deriving (Eq, Show, Data)
+
+instance HasPath SitemapController where
+    pathTo SitemapAction = "/sitemap.xml"
+
+instance CanRoute SitemapController where
+    parseRoute' = do
+        string "/sitemap.xml"
+        endOfInput
+        pure SitemapAction
+
+renderXmlSitemap :: (?context::ControllerContext) => Sitemap -> IO ()
+renderXmlSitemap Sitemap { links } = do
+    let sitemapStart
+            = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>"
+            <> "\n"
+            <> "<urlset xmlns=\"http://www.sitemaps.org/schemas/sitemap/0.9\">"
+    let sitemapEnd = "</urlset>"
+    let sitemap = unlines $ [sitemapStart] ++ map renderSitemapLink links ++ [sitemapEnd]
+    renderXml (cs sitemap)
+    where
+        renderSitemapLink SitemapLink { url, lastModified, changeFrequency } =
+            let
+                loc = "<loc>" <> url <> "</loc>"
+                lastMod = lastModified |> maybe mempty (\lM -> "<lastmod>" <> lM <> "</lastmod>")
+                changeFreq = changeFrequency |> maybe mempty (\cF -> "<changefreq>" <> show cF <> "</changefreq>")
+            in unlines ["<url>", loc, lastMod, changeFreq, "</url>"]
diff --git a/IHP/SeoSupport/Sitemap/Types.hs b/IHP/SeoSupport/Sitemap/Types.hs
@@ -0,0 +1,36 @@
+module IHP.SeoSupport.Sitemap.Types
+( Sitemap(..)
+, SitemapLink(..)
+, SitemapChangeFrequency(..)
+)
+where
+
+import IHP.Prelude
+import Prelude (Show(..))
+
+data Sitemap
+    = Sitemap { links :: [SitemapLink] }
+    deriving (Eq, Show, Data)
+
+data SitemapLink
+    = SitemapLink { url :: Text, lastModified :: Maybe Text, changeFrequency :: Maybe SitemapChangeFrequency }
+    deriving (Eq, Show, Data)
+
+data SitemapChangeFrequency
+    = Always
+    | Hourly
+    | Daily
+    | Weekly
+    | Monthly
+    | Yearly
+    | Never
+    deriving (Eq, Data)
+
+instance Show SitemapChangeFrequency where
+    show Always = "always"
+    show Hourly = "hourly"
+    show Daily = "daily"
+    show Weekly = "weekly"
+    show Monthly = "monthly"
+    show Yearly = "yearly"
+    show Never = "never"