50 lines
1.5 KiB
Haskell
50 lines
1.5 KiB
Haskell
|
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"] "←"
|