acatalepsie/src/Route.hs

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"] "←"