~jack/jackkelly-name

ref: a1fc89847ddcca2bc6707f02d4fa7f858d36e3bb jackkelly-name/src/Navigation.hs -rw-r--r-- 1.9 KiB
a1fc8984Jack Kelly Hlints 10 months ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
{-# LANGUAGE ViewPatterns #-}

module Navigation
  (Navigation, navigation, navigationContext, select, deselect) where

import Data.Maybe (isNothing, maybeToList)
import Hakyll
import Site (Url(..))

data Navigation = Navigation
  { before :: [NavItem]
  , selected :: Maybe NavItem
  , after :: [NavItem]
  } deriving Show

type NavItem = (String, Url)

navigation :: Navigation
navigation = Navigation [] Nothing
  [ ("Blog", Url "/blog")
  , ("Talks", Url "/talks")
  ]

navigationContext :: Navigation -> Context a
navigationContext navs = field "navigation" renderedNav where
  renderedNav = fmap itemBody
    . loadAndApplyTemplate "templates/navigation.html"
        (navigationItemContext navs)

navigationItemContext :: Navigation -> Context a
navigationItemContext navs
  = boolField "frontpage" (const . isNothing $ selected navs)
  <> listField "navItem" context items

  where
    items = do
      befores <- traverse makeItem $ before navs
      chosen <- fmap maybeToList . traverse makeItem $ selected navs
      afters <- traverse makeItem $ after navs

      pure $ befores <> chosen <> afters

    context :: Context NavItem
    context = mconcat
      [ boolField "selected" isSelected
      , field "label" $ pure . fst . itemBody
      , field "url" $ pure . unUrl . snd . itemBody
      ]

    isSelected :: Item NavItem -> Bool
    isSelected (itemBody -> (label, _)) = case selected navs of
      Nothing -> False
      Just (label', _) -> label == label'

select :: String -> Navigation -> Navigation
select key nav = Navigation befores chosen afters where
  befores = takeWhile ((key /=) . fst) navItems
  (chosen, afters) = case dropWhile ((key /=) . fst) navItems of
    [] -> (Nothing, [])
    (n:ns) -> (Just n, ns)

  navItems = after $ deselect nav

deselect :: Navigation -> Navigation
deselect nav = Navigation [] Nothing $
  before nav <> maybeToList (selected nav) <> after nav