added missing Route file
This commit is contained in:
parent
61238885d4
commit
ae24be9497
|
@ -0,0 +1,49 @@
|
||||||
|
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"] "←"
|
Loading…
Reference in New Issue