Source file skyline_entrypoint.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
open! Core
open! Bonsai_web
open! Bonsai.Let_syntax

module Set_globals = struct
  open Js_of_ocaml
  module State = Unit

  module Input = struct
    type t =
      { theme : Skyline_theme_v1.Style.t
      ; accent : Skyline_theme_v1.Accent.t
      ; global_css : [ `Skyline_css_reset | `Skyline_base_styles | `None ]
      }
    [@@deriving sexp_of, equal]

    let combine fst _snd = fst
  end

  let update_css_and_theme { Input.theme; accent; global_css } =
    (match global_css with
     | `Skyline_base_styles -> Private_skyline_theme.Base_Styles.install ()
     | `Skyline_css_reset | `None -> Private_skyline_theme.Base_Styles.clear ());
    (match global_css with
     | `Skyline_css_reset -> Private_skyline_theme.Stylesheet.install ()
     | `Skyline_base_styles | `None -> Private_skyline_theme.Stylesheet.clear ());
    Private_skyline_theme.Colors.install theme ~accent
  ;;

  let init (input : Input.t) (_ : Dom_html.element Js.t) =
    Private_skyline_exn_handler.set_uncaught_exception_handler ();
    update_css_and_theme input
  ;;

  let on_mount = `Do_nothing

  let update ~old_input ~new_input () (_ : Dom_html.element Js.t) =
    if not (Input.equal old_input new_input) then update_css_and_theme new_input
  ;;

  let destroy (_ : Input.t) () (_ : Dom_html.element Js.t) =
    Private_skyline_theme.Base_Styles.clear ();
    Private_skyline_theme.Colors.clear ();
    Private_skyline_theme.Stylesheet.clear ();
    Private_skyline_exn_handler.remove_uncaught_exception_handler ()
  ;;

  include functor Vdom.Attr.Hooks.Make
end

let theme_scope =
  Bonsai.Dynamic_scope.create
    ~name:"skyline-theme"
    ~fallback:Skyline_theme_v1.Style.Light
    ()
;;

let accent_scope = Bonsai.Dynamic_scope.create ~name:"skyline-accent" ~fallback:`Blue ()

let set_scope scope ~value inside graph =
  Bonsai.Dynamic_scope.set scope value ~inside graph
;;

let install
  ?(global_css = return `Skyline_base_styles)
  ?(toast_position = return `Top_left)
  ?(theme = return Skyline_theme_v1.Style.Light)
  ?(accent = return `Blue)
  computation
  graph
  =
  let%arr global_css
  and theme
  and accent
  and vdom =
    (View.Theme.set_for_computation
       (let%arr theme in
        Private_skyline_view_compat.theme theme)
       computation
     |> set_scope theme_scope ~value:theme
     |> set_scope accent_scope ~value:accent
     |> set_scope Private_skyline_toast.position ~value:toast_position
     |> Private_skyline_keyboard_shortcut.install_listener ~mode:`Global)
      graph
  in
  let set_globals =
    Vdom.Attr.create_hook
      "skyline-globals"
      (Set_globals.create { theme; accent; global_css })
  in
  match (vdom : Vdom.Node.t) with
  | Element elem ->
    Vdom.Node.Element
      (Vdom.Node.Element.map_attrs elem ~f:(fun attr ->
         Vdom.Attr.combine attr set_globals))
  | vdom -> Vdom.Node.div ~attrs:[ set_globals ] [ vdom ]
;;

let infer_theme_from_system (local_ graph) =
  match%arr Skyline_media_query_v1.matches "(prefers-color-scheme: dark)" graph with
  | true -> Skyline_theme_v1.Style.Dark
  | false -> Light
;;

let theme graph = Bonsai.Dynamic_scope.lookup theme_scope graph
let accent graph = Bonsai.Dynamic_scope.lookup accent_scope graph