Source file skyline_popover_v1.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
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
147
148
149
150
151
152
153
154
155
156
157
open! Core
open! Bonsai_web
open! Bonsai.Let_syntax

module Style = struct
  let popover ~padding:popover_padding =
    let style =
      Css_gen.(
        max_height (`Percent Percent.one_hundred_percent)
        @> uniform_padding (Option.value popover_padding ~default:(`Px 4))
        @> border_radius (`Px 4)
        @> border
             ~width:(`Px 1)
             ~style:`Solid
             ~color:Private_skyline_theme.Colors.Constants.border
             ()
        @> background_color Private_skyline_theme.Colors.Constants.surface
        @> overflow_x `Hidden
        @> overflow_y `Auto)
    in
    Vdom.Attr.many
      [ Vdom.Attr.style style
      ; Private_skyline_theme.Stylesheet.step_nested_surface_ramp
      ; Vdom.Attr.style Private_skyline_theme.Shadows.raised_card
      ]
  ;;

  (* We set a 4px offset for the popover, so we reduce the width by 8px to allow for the
     same amount of margin to either side of the viewport. *)

  let content_width =
    Vdom.Attr.style
      Css_gen.(
        create ~field:"width" ~value:"max-content"
        @> create ~field:"max-width" ~value:"max(300px, calc(100vw - 8px))")
  ;;
end

module Position = struct
  type t = Bonsai_web_themed_toplayer.Position.t =
    | Auto
    | Top
    | Bottom
    | Left
    | Right
  [@@deriving sexp_of, equal]
end

module Alignment = struct
  type t = Bonsai_web_themed_toplayer.Alignment.t =
    | Center
    | Start
    | End
  [@@deriving sexp_of, equal]
end

module Width = struct
  type t =
    | Content
    | Fixed of Css_gen.Length.t
    | Max of Css_gen.Length.t
  [@@deriving sexp_of]
end

type t =
  { anchor : Vdom.Attr.t
  ; is_open : bool
  ; set_is_open : bool -> unit Effect.t
  }

let anchor { anchor; _ } = anchor
let visible { is_open; _ } = is_open

(* [show], [hide], and [toggle] intentionally use state at time of effect construction,
   not at time of effect execution. This is so that user actions are consistent with the
   UI state at the time of the action happening. The main motivating example is:

   - There is a button _outside_ of the popover, which does [~on_click:(open popover)]
   - but the popover should close on click outside

   Now we want the UX to be that clicking on the button closes the popover because:
   - opening does nothing since it's already open
   - at the same time the click outside triggers a close, which does take effect. *)

let show { is_open; set_is_open; _ } =
  if not is_open then set_is_open true else Effect.Ignore
;;

let hide { is_open; set_is_open; _ } =
  if is_open then set_is_open false else Effect.Ignore
;;

let toggle { is_open; set_is_open; _ } = set_is_open (not is_open)

let component
  ?(attrs = return [])
  ?state
  ?(position = return Position.Auto)
  ?(alignment = return Alignment.Center)
  ?(focus_on_show = return true)
  ?(close_on_click_outside = return true)
  ?(width = return Width.Content)
  ?padding
  contents
  (local_ graph)
  =
  let is_open, set_is_open =
    match state with
    | Some (visible, set_visible) -> visible, set_visible
    | None -> Bonsai.state false graph
  in
  let extra_attrs =
    let%arr width
    and attrs
    and padding = Bonsai.transpose_opt padding in
    let width =
      match (width : Width.t) with
      | Content -> Style.content_width
      | Fixed width -> Vdom.Attr.style (Css_gen.width width)
      | Max width -> Vdom.Attr.style (Css_gen.max_width width)
    in
    [ Style.popover ~padding; width; Vdom.Attr.many attrs ]
  in
  let anchor =
    let close =
      let%arr set_is_open in
      set_is_open false
    in
    let close_on_click_outside =
      if%arr close_on_click_outside
      then Bonsai_web_themed_toplayer.Close_on_click_outside.Yes
      else No
    in
    let autoclose =
      Bonsai_web_themed_toplayer.Autoclose.create
        ~close
        ~close_on_click_outside
        ~close_on_right_click_outside:close_on_click_outside
        ~close_on_esc:(return true)
        graph
    in
    match%sub is_open with
    | true ->
      Bonsai_web_themed_toplayer.Popover.always_open
        ~extra_attrs
        ~autoclose
        ~position
        ~alignment
        ~focus_on_open:focus_on_show
        ~overflow_auto_wrapper:(return false)
        ~content:(fun graph -> contents ~hide:close graph)
        graph
    | false -> return Vdom.Attr.empty
  in
  let%arr anchor and is_open and set_is_open in
  { anchor; is_open; set_is_open }
;;