module Route (Route(..), link, breadcrumb) where import Common import Lucid import Data.List (foldl') data Route = IndexRoute | VisualRoute | PostRoute | ProjectsRoute | ProjectRoute Text | ProjectPageRoute Text Route | VEntryRoute link :: Route -> Html () link route = a_ [href_ (path route)] (toHtml $ name route) where path IndexRoute = "/" path ProjectsRoute = "/projects.html" path VisualRoute = "/visual.html" path PostRoute = "/" path (ProjectRoute _) = "/projects/" path (ProjectPageRoute _ _) = "/" path VEntryRoute = "/" name IndexRoute = "index" name ProjectsRoute = "projects" name VisualRoute = "visual" name PostRoute = "post" name (ProjectRoute n) = n name (ProjectPageRoute n r) = n walk :: Route -> [Route] walk IndexRoute = [] walk VisualRoute = [] walk PostRoute = [IndexRoute] walk ProjectsRoute = [] walk (ProjectRoute _) = [ProjectsRoute] walk (ProjectPageRoute _ r) = walk r ++ [r] walk (VEntryRoute) = [VisualRoute] breadcrumb :: Route -> Html () breadcrumb route = case walk route of [] -> mempty xs -> p_ [class_ "breadcrumb"] $ foldl' (\b r -> b <> sep <> link r) "⊙" xs where sep = span_ [class_ "sep"] "←"