diff --git a/src/Foundation.hs b/src/Foundation.hs index 24f64bc..2e7e680 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -23,6 +23,9 @@ import qualified Yesod.Core.Unsafe as Unsafe import Package import Entry.Kind ( EntryKind, pluralise ) +import Data.Aeson ( encode, object ) +import qualified Data.Text.Lazy.Encoding as E + -- | The foundation datatype for your application. This can be a good place to -- keep settings and values requiring initialization before your application -- starts running, such as database connections. Every handler will have @@ -97,7 +100,9 @@ instance Yesod App where mcurrentRoute <- getCurrentRoute -- Get the breadcrumbs, as defined in the YesodBreadcrumbs instance. - (title, parents) <- breadcrumbs + (title, crumbs) <- breadcrumbs + let allCrumbs = maybe crumbs (\route -> crumbs ++ [(route, title)]) mcurrentRoute + jsonCrumbs <- fmap (E.decodeUtf8 . encode) . withUrlRenderer $ jsonLdBreadcrumbList allCrumbs let navbars = [leftMenuItems, rightMenuItems] <*> [muser] @@ -164,6 +169,22 @@ instance YesodBreadcrumbs App where return (entryName entry, Just $ EntriesR kind) 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/templates/default-layout.hamlet b/templates/default-layout.hamlet index 1a34e7c..15dfd73 100644 --- a/templates/default-layout.hamlet +++ b/templates/default-layout.hamlet @@ -12,12 +12,13 @@
  • #{label} - $if not $ null parents -