{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
module Yesod.Core.Class.Breadcrumbs where

import Yesod.Core.Handler
import Yesod.Routes.Class
import Data.Text (Text)

-- | A type-safe, concise method of creating breadcrumbs for pages. For each
-- resource, you declare the title of the page and the parent resource (if
-- present).
class YesodBreadcrumbs site where
    -- | Returns the title and the parent resource, if available. If you return
    -- a 'Nothing', then this is considered a top-level page.
    breadcrumb :: Route site -> HandlerFor site (Text , Maybe (Route site))

-- | Gets the title of the current page and the hierarchy of parent pages,
-- along with their respective titles.
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
    Maybe (Route site)
x <- forall (m :: * -> *).
MonadHandler m =>
m (Maybe (Route (HandlerSite m)))
getCurrentRoute
    case Maybe (Route site)
x of
        Maybe (Route site)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (Text
"Not found", [])
        Just Route site
y -> do
            (Text
title, Maybe (Route site)
next) <- forall site.
YesodBreadcrumbs site =>
Route site -> HandlerFor site (Text, Maybe (Route site))
breadcrumb Route site
y
            [(Route site, Text)]
z <- forall {site}.
(Eq (Route site), Show (Route site), YesodBreadcrumbs site) =>
[(Route site, Text)]
-> Maybe (Route site) -> HandlerFor site [(Route site, Text)]
go [] Maybe (Route site)
next
            forall (m :: * -> *) a. Monad m => a -> m a
return (Text
title, [(Route site, Text)]
z)
  where
    go :: [(Route site, Text)]
-> Maybe (Route site) -> HandlerFor site [(Route site, Text)]
go [(Route site, Text)]
back Maybe (Route site)
Nothing = 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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Route site, Text)]
back = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"yesod-core: infinite recursion in breadcrumbs at " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Route site
this
      | Bool
otherwise = do
          (Text
title, Maybe (Route site)
next) <- forall site.
YesodBreadcrumbs site =>
Route site -> HandlerFor site (Text, Maybe (Route site))
breadcrumb Route site
this
          [(Route site, Text)]
-> Maybe (Route site) -> HandlerFor site [(Route site, Text)]
go ((Route site
this, Text
title) forall a. a -> [a] -> [a]
: [(Route site, Text)]
back) Maybe (Route site)
next