haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

yesod-core: detect loops in breadcrumbs

Browse Source
This commit is contained in:
Tom Sydney Kerckhove 2021-05-17 20:40:09 +02:00
parent 8a799d2768
commit d981c87c39
1 changed files with 7 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
yesod-core/src/Yesod/Core/Class/Breadcrumbs.hs
View File

@ -1,4 +1,5 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
module Yesod.Core.Class.Breadcrumbs where module Yesod.Core.Class.Breadcrumbs where
import Yesod.Core.Handler import Yesod.Core.Handler
@ -15,7 +16,7 @@ class YesodBreadcrumbs site where
-- | Gets the title of the current page and the hierarchy of parent pages, -- | Gets the title of the current page and the hierarchy of parent pages,
-- along with their respective titles. -- along with their respective titles.
breadcrumbs :: YesodBreadcrumbs site => HandlerFor site (Text, [(Route site, Text)]) breadcrumbs :: (YesodBreadcrumbs site, Eq (Route site)) => HandlerFor site (Text, [(Route site, Text)])
breadcrumbs = do breadcrumbs = do
x <- getCurrentRoute x <- getCurrentRoute
case x of case x of
@ -28,4 +29,8 @@ breadcrumbs = do
go back Nothing = return back go back Nothing = return back
go back (Just this) = do go back (Just this) = do
(title, next) <- breadcrumb this (title, next) <- breadcrumb this
go ((this, title) : back) next if next `elem` (map (Just . fst) back)
then
error $ "infinite recursion in breadcrumbs at" <> show title
else
go ((this, title) : back) next