neuron/src/Neuron/Frontend/Widget/InvertedTree.hs at master · srid/neuron · GitHub

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
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Neuron.Frontend.Widget.InvertedTree
  ( renderInvertedHeadlessTree,
    style,
  )
where

import Clay hiding (id, ms, not, object, reverse, s, style, type_)
import qualified Clay as C
import Data.List (maximum)
import Data.Tree
import Reflex.Dom.Core hiding ((&))
import Relude hiding ((&))

style :: Css
style = pureCssTreeDiagram

renderInvertedHeadlessTree ::
  (DomBuilder t m, Ord a) =>
  -- Element ID
  Text ->
  -- Element Class
  Text ->
  [Tree a] ->
  (a -> m ()) ->
  m ()
renderInvertedHeadlessTree elemId elemCls tree w = do
  let attrs =
        "class" =: ("flipped tree " <> elemCls)
          <> "id" =: elemId
          <> "style" =: "transform-origin: 50%"
  elAttr "nav" attrs $ do
    elClass "ul" "root" $ do
      -- Headless tree will still need a head element (li).
      el "li" $ do
        el "ul" $ do
          renderInvertedForest w tree

renderInvertedForest ::
  (DomBuilder t m, Ord a) =>
  (a -> m ()) ->
  [Tree a] ->
  m ()
renderInvertedForest w trees = do
  forM_ (sortForest trees) $ \(Node x subtrees) ->
    el "li" $ do
      divClass "forest-link" $
        w x
      when (length subtrees > 0) $ do
        el "ul" $ renderInvertedForest w subtrees
  where
    -- Sort trees so that trees containing the most recent zettel (by ID) come first.
    sortForest = reverse . sortOn maximum

-- https://codepen.io/philippkuehn/pen/QbrOaN
pureCssTreeDiagram :: Css
pureCssTreeDiagram = do
  let cellBorderWidth = px 2
      flipTree = False
      rotateDeg = deg 180
  ".tree.flipped" ? do
    C.transform $ C.rotate rotateDeg
  ".tree" ? do
    C.overflow auto
    when flipTree $ do
      C.transform $ C.rotate rotateDeg
    -- Clay does not support this; doing it inline in div style.
    -- C.transformOrigin $ pct 50
    "ul.root" ? do
      -- Make the tree attach to zettel segment
      C.paddingTop $ px 0
      C.marginTop $ px 0
    "ul" ? do
      C.position relative
      C.padding (em 1) 0 0 0
      C.whiteSpace nowrap
      sym2 C.margin (px 0) auto
      C.textAlign center
      C.after & do
        C.content $ stringContent ""
        C.display C.displayTable
        C.clear both
      C.lastChild & do
        C.paddingBottom $ em 0.1
    "li" ? do
      C.display C.inlineBlock
      C.verticalAlign C.vAlignTop
      C.textAlign C.center
      C.listStyleType none
      C.position relative
      C.padding (em 1) (em 0.5) (em 0) (em 0.5)
      forM_ [C.before, C.after] $ \sel ->
        sel & do
          C.content $ stringContent ""
          C.position absolute
          C.top $ px 0
          C.right $ pct 50
          C.borderTop cellBorderWidth solid "#ccc"
          C.width $ pct 50
          C.height $ em 1.2
      C.after & do
        C.right auto
        C.left $ pct 50
        C.borderLeft cellBorderWidth solid "#ccc"
      C.onlyChild & do
        C.paddingTop $ em 0
        forM_ [C.after, C.before] $ \sel ->
          sel & do
            C.display none
      C.firstChild & do
        C.before & do
          C.borderStyle none
          C.borderWidth $ px 0
        C.after & do
          C.borderRadius (px 5) 0 0 0
      C.lastChild & do
        C.after & do
          C.borderStyle none
          C.borderWidth $ px 0
        C.before & do
          C.borderRight cellBorderWidth solid "#ccc"
          C.borderRadius 0 (px 5) 0 0
    "ul ul::before" ? do
      C.content $ stringContent ""
      C.position absolute
      C.top $ px 0
      C.left $ pct 50
      C.borderLeft cellBorderWidth solid "#ccc"
      C.width $ px 0
      C.height $ em 1.2
    "li" ? do
      "div.forest-link" ? do
        border cellBorderWidth solid "#ccc"
        sym2 C.padding (em 0.2) (em 0.3)
        C.textDecoration none
        C.display inlineBlock
        sym C.borderRadius (px 5)
        C.color "#333"
        C.position relative
        C.top cellBorderWidth
        when flipTree $ do
          C.transform $ C.rotate rotateDeg
  ".tree.flipped li div.forest-link" ? do
    C.transform $ C.rotate rotateDeg