package memtrace_viewer

  1. Overview
  2. Docs
Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source

Source file size_input.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
open! Core
open Bonsai_web

type t = Byte_units.t option And_view.t

module Unit = struct
  type t =
    | Bytes
    | Kilobytes
    | Megabytes
    | Gigabytes
    | Terabytes
  [@@deriving equal, enumerate, sexp]

  let to_string = function
    | Bytes -> "B"
    | Kilobytes -> "K"
    | Megabytes -> "M"
    | Gigabytes -> "G"
    | Terabytes -> "T"
  ;;

  let float_to_byte_units t f =
    match t with
    | Bytes -> Byte_units.of_bytes_float_exn f
    | Kilobytes -> Byte_units.of_kilobytes f
    | Megabytes -> Byte_units.of_megabytes f
    | Gigabytes -> Byte_units.of_gigabytes f
    | Terabytes -> Byte_units.of_terabytes f
  ;;
end

module Float_option = struct
  type t = float option [@@deriving sexp, equal]
end

let component =
  let open Bonsai.Let_syntax in
  let%sub state = Bonsai.state None ~equal:[%equal: Float_option.t] in
  let%sub unit_state = Bonsai.state Kilobytes ~equal:[%equal: Unit.t] in
  return
    (let%map value, set_value = state
     and unit, set_unit = unit_state in
     let open Vdom in
     let view =
       Node.span
         [ Vdom_input_widgets.Entry.number
             ~allow_updates_when_focused:`Never
             ~merge_behavior:Legacy_dont_merge
             (module Util.Float_html_syntax)
             ~value
             ~on_input:set_value
             ~step:0.1
             ~call_on_input_when:Text_changed
             ~extra_attrs:[ Attr.min 0.0 ]
         ; Node.text " "
         ; Vdom_input_widgets.Dropdown.of_enum
             ~merge_behavior:Legacy_dont_merge
             (module Unit)
             ~selected:unit
             ~on_change:set_unit
         ]
     in
     let value = value |> Option.map ~f:(Unit.float_to_byte_units unit) in
     { And_view.value; view })
;;