Move the schema.org/BreadcrumbList stuff out of Foundation
This commit is contained in:
parent
a880e66c31
commit
5a83121431
2 changed files with 24 additions and 18 deletions
|
@ -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
|
||||
|
|
21
src/SchemaOrg/BreadcrumbList.hs
Normal file
21
src/SchemaOrg/BreadcrumbList.hs
Normal file
|
@ -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
|
||||
]
|
||||
]
|
Loading…
Reference in a new issue