From 5a8312143131a1e7786a8955f54c568dda1cbeb3 Mon Sep 17 00:00:00 2001
From: Danielle McLean <dani@00dani.me>
Date: Mon, 16 Oct 2017 20:57:36 +1100
Subject: [PATCH] Move the schema.org/BreadcrumbList stuff out of Foundation

---
 src/Foundation.hs               | 21 +++------------------
 src/SchemaOrg/BreadcrumbList.hs | 21 +++++++++++++++++++++
 2 files changed, 24 insertions(+), 18 deletions(-)
 create mode 100644 src/SchemaOrg/BreadcrumbList.hs

diff --git a/src/Foundation.hs b/src/Foundation.hs
index 3538c59..fc70ddf 100644
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@@ -25,8 +25,9 @@ import Model.Cache ( getCached )
 import Model.Category ( Category )
 import Model.Entry ( entryTitle )
 import Model.Entry.Kind ( EntryKind, allEntryKinds, pluralise )
+import SchemaOrg.BreadcrumbList ( breadcrumbList )
 
-import Data.Aeson ( encode, object )
+import Data.Aeson ( encode )
 import qualified Text.Blaze.Internal as B
 import qualified Data.Text as T
 import qualified Data.Text.Lazy.Encoding as E
@@ -108,7 +109,7 @@ instance Yesod App where
         -- Get the breadcrumbs, as defined in the YesodBreadcrumbs instance.
         (title, crumbs) <- breadcrumbs
         let allCrumbs = maybe crumbs (\route -> crumbs ++ [(route, title)]) mcurrentRoute
-        jsonCrumbs <- fmap (E.decodeUtf8 . encode) . withUrlRenderer $ jsonLdBreadcrumbList allCrumbs
+        jsonCrumbs <- fmap (E.decodeUtf8 . encode) . withUrlRenderer $ breadcrumbList allCrumbs
 
         let navbars = [leftMenuItems, rightMenuItems] <*> [muser]
 
@@ -187,22 +188,6 @@ instance YesodBreadcrumbs App where
   breadcrumb (EntryWithSlugR kind entryId _) = breadcrumb $ EntryR kind entryId
   breadcrumb _ = return ("home", Nothing)
 
-jsonLdBreadcrumbList :: [(Route App, Text)] -> (Route App -> [(Text, Text)] -> Text) -> Value
-jsonLdBreadcrumbList crumbs url = object
-  [ ("@context", "http://schema.org")
-  , ("@type", "BreadcrumbList")
-  , "itemListElement" .= zipWith (jsonLdListItem url) [1 :: Int ..] crumbs
-  ]
-jsonLdListItem :: (Route App -> [(Text, Text)] -> Text) -> Int -> (Route App, Text) -> Value
-jsonLdListItem url i (r, t) = object
-  [ ("@type", "ListItem")
-  , "position" .= i
-  , "item" .= object
-    [ "@id" .= url r []
-    , "name" .= t
-    ]
-  ]
-
 -- How to run database actions.
 instance YesodPersist App where
     type YesodPersistBackend App = SqlBackend
diff --git a/src/SchemaOrg/BreadcrumbList.hs b/src/SchemaOrg/BreadcrumbList.hs
new file mode 100644
index 0000000..9c278e9
--- /dev/null
+++ b/src/SchemaOrg/BreadcrumbList.hs
@@ -0,0 +1,21 @@
+{-# LANGUAGE OverloadedStrings #-}
+module SchemaOrg.BreadcrumbList ( breadcrumbList ) where
+
+import Data.Aeson
+import qualified Data.Text as T
+
+breadcrumbList :: [(a, T.Text)] -> (a -> [(T.Text, T.Text)] -> T.Text) -> Value
+breadcrumbList crumbs url = object
+  [ ("@context", "http://schema.org")
+  , ("@type", "BreadcrumbList")
+  , "itemListElement" .= zipWith (listItem url) [1 :: Int ..] crumbs
+  ]
+listItem :: (a -> [(T.Text, T.Text)] -> T.Text) -> Int -> (a, T.Text) -> Value
+listItem url i (r, t) = object
+  [ ("@type", "ListItem")
+  , "position" .= i
+  , "item" .= object
+    [ "@id" .= url r []
+    , "name" .= t
+    ]
+  ]