{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
module Yesod.Core.Class.Breadcrumbs where
import Yesod.Core.Handler
import Yesod.Routes.Class
import Data.Text (Text)
class YesodBreadcrumbs site where
breadcrumb :: Route site -> HandlerFor site (Text , Maybe (Route site))
breadcrumbs :: (YesodBreadcrumbs site, Show (Route site), Eq (Route site)) => HandlerFor site (Text, [(Route site, Text)])
breadcrumbs :: forall site.
(YesodBreadcrumbs site, Show (Route site), Eq (Route site)) =>
HandlerFor site (Text, [(Route site, Text)])
breadcrumbs = do
x <- HandlerFor site (Maybe (Route site))
HandlerFor site (Maybe (Route (HandlerSite (HandlerFor site))))
forall (m :: * -> *).
MonadHandler m =>
m (Maybe (Route (HandlerSite m)))
getCurrentRoute
case x of
Maybe (Route site)
Nothing -> (Text, [(Route site, Text)])
-> HandlerFor site (Text, [(Route site, Text)])
forall a. a -> HandlerFor site a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
"Not found", [])
Just Route site
y -> do
(title, next) <- Route site -> HandlerFor site (Text, Maybe (Route site))
forall site.
YesodBreadcrumbs site =>
Route site -> HandlerFor site (Text, Maybe (Route site))
breadcrumb Route site
y
z <- go [] next
return (title, z)
where
go :: [(Route site, Text)]
-> Maybe (Route site) -> HandlerFor site [(Route site, Text)]
go [(Route site, Text)]
back Maybe (Route site)
Nothing = [(Route site, Text)] -> HandlerFor site [(Route site, Text)]
forall a. a -> HandlerFor site a
forall (m :: * -> *) a. Monad m => a -> m a
return [(Route site, Text)]
back
go [(Route site, Text)]
back (Just Route site
this)
| Route site
this Route site -> [Route site] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ((Route site, Text) -> Route site)
-> [(Route site, Text)] -> [Route site]
forall a b. (a -> b) -> [a] -> [b]
map (Route site, Text) -> Route site
forall a b. (a, b) -> a
fst [(Route site, Text)]
back = String -> HandlerFor site [(Route site, Text)]
forall a. HasCallStack => String -> a
error (String -> HandlerFor site [(Route site, Text)])
-> String -> HandlerFor site [(Route site, Text)]
forall a b. (a -> b) -> a -> b
$ String
"yesod-core: infinite recursion in breadcrumbs at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Route site -> String
forall a. Show a => a -> String
show Route site
this
| Bool
otherwise = do
(title, next) <- Route site -> HandlerFor site (Text, Maybe (Route site))
forall site.
YesodBreadcrumbs site =>
Route site -> HandlerFor site (Text, Maybe (Route site))
breadcrumb Route site
this
go ((this, title) : back) next