Source file sidebar.ml

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
open! Core
open! Bonsai_web

module Button_position = struct
  type t =
    | Left
    | Right
end

module State = struct
  type t =
    | Collapsed
    | Expanded
  [@@deriving sexp, compare, equal]

  let flip = function
    | Collapsed -> Expanded
    | Expanded -> Collapsed
  ;;
end

let left_arrow = Vdom.Node.text "❰"
let right_arrow = Vdom.Node.text "❱"

let view ~attr ~nodes ~(button_position : Button_position.t) ~state ~set_state =
  let open Vdom in
  let on_click _ = set_state (State.flip state) in
  let arrow =
    match state, button_position with
    | Expanded, Right | Collapsed, Left -> left_arrow
    | Collapsed, Right | Expanded, Left -> right_arrow
  in
  let button =
    Node.button
      ~attrs:[ Attr.classes [ "sidebar-button"; "flat-button" ]; Attr.on_click on_click ]
      [ arrow ]
  in
  let button_strip = Node.div ~attrs:[ Attr.class_ "sidebar-button-strip" ] [ button ] in
  let state_class =
    match state with
    | Expanded -> "sidebar-expanded"
    | Collapsed -> "sidebar-collapsed"
  in
  let content = Node.div ~attrs:[ Attr.class_ "sidebar-content" ] nodes in
  let parts =
    match button_position with
    | Left -> [ button_strip; content ]
    | Right -> [ content; button_strip ]
  in
  Node.div parts ~attrs:[ attr; Attr.classes [ "sidebar"; state_class ] ]
;;

let component ?(attr = Value.return Vdom.Attr.empty) nodes ~button_position =
  let open Bonsai.Let_syntax in
  let%sub state, set_state = Bonsai.state Expanded ~equal:[%equal: State.t] in
  return
    (let%map attr = attr
     and nodes = nodes
     and state = state
     and set_state = set_state in
     view ~attr ~nodes ~button_position ~state ~set_state)
;;