Initialize views from JavaScript

13 files changed, 386 insertions, 245 deletions

diff --git a/src/Dom/CreateElement.ml b/src/Dom/CreateElement.ml
new file mode 100644
index 0000000..8183a02
--- /dev/null
+++ b/src/Dom/CreateElement.ml
@@ -0,0 +1,72 @@
+(* Element creation *)
+
+let h tag ?(attributes = [||]) ?(eventListeners = [||]) ?(children = [||]) () :
+    Dom.element =
+  let element =
+    if tag == "svg" || tag == "path" then
+      Document.createElementNS "http://www.w3.org/2000/svg" tag
+    else Document.createElement tag
+  in
+  let () =
+    Js.Array.forEach
+      (fun (name, value) -> Element.setAttribute element name value)
+      attributes
+  in
+  let () =
+    Js.Array.forEach
+      (fun (name, eventListener) ->
+        Element.addEventListener element name eventListener)
+      eventListeners
+  in
+  let () =
+    Js.Array.forEach (fun child -> Element.appendChild element child) children
+  in
+  element
+
+(* Node creation *)
+
+let text = Document.createTextNode
+
+let div = h "div"
+
+let span = h "span"
+
+let header = h "header"
+
+let button = h "button"
+
+let section = h "section"
+
+let svg = h "svg"
+
+let path = h "path"
+
+let form = h "form"
+
+let label = h "label"
+
+let input_ = h "input"
+
+(* Attribute creation *)
+
+let id v = ("id", v)
+
+let className v = ("class", v)
+
+let viewBox v = ("viewBox", v)
+
+let d v = ("d", v)
+
+let type_ v = ("type", v)
+
+let min_ v = ("min", v)
+
+let value v = ("value", v)
+
+(* Event listeners *)
+
+let onClick f = ("click", f)
+
+let onInput f = ("input", f)
+
+let onSubmit f = ("submit", f)
diff --git a/src/Dom/Document.ml b/src/Dom/Document.ml
index afd1a84..867e28c 100644
--- a/src/Dom/Document.ml
+++ b/src/Dom/Document.ml
@@ -1,4 +1,14 @@
-external querySelector : string -> Dom.element option = "querySelector"
+external createElement : string -> Dom.element = "createElement"
   [@@bs.val] [@@bs.scope "document"]
 
-let querySelectorUnsafe id = querySelector id |> Js.Option.getExn
+external createElementNS : string -> string -> Dom.element = "createElementNS"
+  [@@bs.val] [@@bs.scope "document"]
+
+external querySelector : string -> Dom.element Js.Nullable.t = "querySelector"
+  [@@bs.val] [@@bs.scope "document"]
+
+let querySelectorUnsafe id =
+  querySelector id |> Js.Nullable.toOption |> Js.Option.getExn
+
+external createTextNode : string -> Dom.element = "createTextNode"
+  [@@bs.val] [@@bs.scope "document"]
diff --git a/src/Dom/Element.ml b/src/Dom/Element.ml
index 4b38fa9..0b6c0bd 100644
--- a/src/Dom/Element.ml
+++ b/src/Dom/Element.ml
@@ -1,14 +1,44 @@
 external setValue : Dom.element -> string -> unit = "value" [@@bs.set]
 
-external setInnerText : Dom.element -> string -> unit = "innerText" [@@bs.set]
+external setTextContent : Dom.element -> string -> unit = "textContent"
+  [@@bs.set]
 
 external setStyle : Dom.element -> string -> unit = "style" [@@bs.set]
 
 external setClassName : Dom.element -> string -> unit = "className" [@@bs.set]
 
+external setScrollTop : Dom.element -> int -> unit = "scrollTop" [@@bs.set]
+
 external setAttribute : Dom.element -> string -> string -> unit = "setAttribute"
   [@@bs.send]
 
+external setAttributeNS : Dom.element -> string -> string -> string -> unit
+  = "setAttributeNS"
+  [@@bs.send]
+
 external addEventListener : Dom.element -> string -> (Dom.event -> unit) -> unit
   = "addEventListener"
   [@@bs.send]
+
+external appendChild : Dom.element -> Dom.element -> unit = "appendChild"
+  [@@bs.send]
+
+external firstChild : Dom.element -> Dom.element Js.Nullable.t = "firstChild"
+  [@@bs.get]
+
+external removeChild : Dom.element -> Dom.element -> unit = "removeChild"
+  [@@bs.send]
+
+let removeFirstChild element =
+  match Js.toOption (firstChild element) with
+  | Some child ->
+      let () = removeChild element child in
+      true
+  | _ -> false
+
+let rec removeChildren element =
+  if removeFirstChild element then removeChildren element else ()
+
+let mountOn base element =
+  let () = removeChildren base in
+  appendChild base element
diff --git a/src/Dom/EventTarget.ml b/src/Dom/EventTarget.ml
index 946a518..d1b0c02 100644
--- a/src/Dom/EventTarget.ml
+++ b/src/Dom/EventTarget.ml
@@ -1 +1,4 @@
-external value : Dom.eventTarget -> string option = "value" [@@bs.get]
+external nullableValue : Dom.eventTarget -> string Js.Nullable.t = "value"
+  [@@bs.get]
+
+let value eventTarget = nullableValue eventTarget |> Js.Nullable.toOption
diff --git a/src/Model/config.ml b/src/Model/config.ml
new file mode 100644
index 0000000..99e42d1
--- /dev/null
+++ b/src/Model/config.ml
@@ -0,0 +1,12 @@
+type config = {
+  prepare : int;
+  tabatas : int;
+  cycles : int;
+  work : int;
+  rest : int;
+}
+
+let init = { prepare = 10; tabatas = 4; cycles = 8; work = 20; rest = 10 }
+
+let getDuration { prepare; tabatas; cycles; work; rest } =
+  tabatas * (prepare + (cycles * (work + rest)))
diff --git a/src/step.ml b/src/Model/step.ml
index 02a110e..02a110e 100644
--- a/src/step.ml
+++ b/src/Model/step.ml
diff --git a/src/View/configView.ml b/src/View/configView.ml
new file mode 100644
index 0000000..5db6ea5
--- /dev/null
+++ b/src/View/configView.ml
@@ -0,0 +1,83 @@
+open CreateElement
+open Config
+
+let labelledInput labelValue minValue inputValue update writeDuration =
+  label
+    ~attributes:[| className "g-Form__Label" |]
+    ~eventListeners:
+      [|
+        onInput (fun e ->
+            match
+              EventTarget.value (Event.target e)
+              |> Option.flatMap Belt.Int.fromString
+            with
+            | Some n ->
+                let () = update n in
+                writeDuration ()
+            | None -> ());
+      |]
+    ~children:
+      [|
+        text labelValue;
+        input_
+          ~attributes:
+            [|
+              className "g-Form__Input";
+              type_ "number";
+              min_ (Js.Int.toString minValue);
+              value (Js.Int.toString inputValue);
+            |]
+          ();
+      |]
+    ()
+
+let render initialConfig onStart =
+  let config = ref initialConfig in
+  let duration = text (Duration.prettyPrint (getDuration !config)) in
+  let wd () =
+    Element.setTextContent duration (Duration.prettyPrint (getDuration !config))
+  in
+  div
+    ~children:
+      [|
+        header
+          ~attributes:[| className "g-Layout__Header" |]
+          ~children:[| text "Tabata timer" |]
+          ();
+        form
+          ~attributes:[| className "g-Form" |]
+          ~eventListeners:
+            [|
+              onSubmit (fun e ->
+                  let () = Event.preventDefault e in
+                  onStart !config);
+            |]
+          ~children:
+            [|
+              labelledInput "prepare" 0 !config.prepare
+                (fun n -> config := { !config with prepare = n })
+                wd;
+              labelledInput "tabatas" 1 !config.tabatas
+                (fun n -> config := { !config with tabatas = n })
+                wd;
+              labelledInput "cycles" 1 !config.cycles
+                (fun n -> config := { !config with cycles = n })
+                wd;
+              labelledInput "work" 5 !config.work
+                (fun n -> config := { !config with work = n })
+                wd;
+              labelledInput "rest" 5 !config.rest
+                (fun n -> config := { !config with rest = n })
+                wd;
+              div
+                ~attributes:[| className "g-Form__Duration" |]
+                ~children:[| text "duration"; div ~children:[| duration |] () |]
+                ();
+              button
+                ~attributes:[| className "g-Form__Start" |]
+                ~children:[| text "start" |]
+                ();
+            |]
+          ();
+      |]
+    ()
diff --git a/src/View/timerView.ml b/src/View/timerView.ml
new file mode 100644
index 0000000..2384f85
--- /dev/null
+++ b/src/View/timerView.ml
@@ -0,0 +1,123 @@
+open CreateElement
+
+let render (config : Config.config) onStop =
+  let duration = Config.getDuration config in
+  (* State *)
+  let interval = ref None in
+  let elapsed = ref 0 in
+  let step = ref (Step.getAt config !elapsed) in
+  let isPlaying = ref true in
+  (* Elements *)
+  let stepElt = text (Step.prettyPrint !step.step) in
+  let durationElt = text (Duration.prettyPrint !step.remaining) in
+  let arcPathElt = path ~attributes:[| className "g-Timer__ArcProgress" |] () in
+  let tabataCurrentElt = text (Js.Int.toString !step.tabata) in
+  let cycleCurrentElt = text (Js.Int.toString !step.cycle) in
+  (* Update *)
+  let stop () =
+    let () = Belt.Option.forEach !interval Js.Global.clearInterval in
+    onStop config
+  in
+  let updateDom () =
+    let angle = Js.Int.toFloat !elapsed /. Js.Int.toFloat duration *. 360.0 in
+    let () =
+      Element.setAttribute arcPathElt "d" (Arc.describe 0.0 0.0 95.0 0.0 angle)
+    in
+    let step = Step.getAt config !elapsed in
+    let () = Element.setTextContent stepElt (Step.prettyPrint step.step) in
+    let () =
+      Element.setTextContent durationElt (Duration.prettyPrint step.remaining)
+    in
+    let () =
+      Element.setTextContent tabataCurrentElt (Js.Int.toString step.tabata)
+    in
+    let () =
+      Element.setTextContent cycleCurrentElt (Js.Int.toString step.cycle)
+    in
+    Audio.playFromStep config step
+  in
+  let update () =
+    if !isPlaying then
+      let () = elapsed := !elapsed + 1 in
+      let () = step := Step.getAt config !elapsed in
+      if !elapsed > duration then stop () else updateDom ()
+    else ()
+  in
+  (* Start timer *)
+  let () = interval := Some (Js.Global.setInterval update 1000) in
+  (* View *)
+  section
+    ~attributes:[| className "g-Timer" |]
+    ~children:
+      [|
+        button
+          ~attributes:[| className "g-Timer__Dial" |]
+          ~eventListeners:[| onClick (fun _ -> isPlaying := not !isPlaying) |]
+          ~children:
+            [|
+              svg
+                ~attributes:
+                  [| className "g-Timer__Arc"; viewBox "-100 -100 200 200" |]
+                ~children:
+                  [|
+                    path
+                      ~attributes:
+                        [|
+                          className "g-Timer__ArcTotal";
+                          d (Arc.describe 0.0 0.0 95.0 0.0 359.999);
+                        |]
+                      ();
+                    arcPathElt;
+                  |]
+                ();
+              div
+                ~attributes:[| className "g-Timer__Step" |]
+                ~children:[| stepElt |] ();
+              div
+                ~attributes:[| className "g-Timer__Duration" |]
+                ~children:[| durationElt |] ();
+            |]
+          ();
+        div
+          ~attributes:[| className "g-Timer__TabataAndCycle" |]
+          ~children:
+            [|
+              div
+                ~attributes:[| className "g-Timer__Tabata" |]
+                ~children:
+                  [|
+                    div ~children:[| text "Tabata" |] ();
+                    span
+                      ~attributes:[| className "g-Timer__TabataCurrent" |]
+                      ~children:[| tabataCurrentElt |] ();
+                    text "/";
+                    span
+                      ~attributes:[| className "g-Timer__TabataTotal" |]
+                      ~children:[| text (Js.Int.toString config.tabatas) |]
+                      ();
+                  |]
+                ();
+              div
+                ~attributes:[| className "g-Timer__Cycle" |]
+                ~children:
+                  [|
+                    div ~children:[| text "Cycle" |] ();
+                    span
+                      ~attributes:[| className "g-Timer__CycleCurrent" |]
+                      ~children:[| cycleCurrentElt |] ();
+                    text "/";
+                    span
+                      ~attributes:[| className "g-Timer__CycleTotal" |]
+                      ~children:[| text (Js.Int.toString config.cycles) |]
+                      ();
+                  |]
+                ();
+            |]
+          ();
+        div
+          ~attributes:[| className "g-Timer__Stop" |]
+          ~children:[| text "stop" |]
+          ~eventListeners:[| onClick (fun _ -> stop ()) |]
+          ();
+      |]
+    ()
diff --git a/src/animation.ml b/src/animation.ml
index 7a598e5..35294dc 100644
--- a/src/animation.ml
+++ b/src/animation.ml
@@ -1,26 +1,27 @@
-let mainElt = Document.querySelectorUnsafe "#g-Layout__Main"
-
 let isRunning = ref false
 
-let start ~onHidden ~onEnded =
+let start base ~onStart ~onEnd =
   if not !isRunning then
     let () = isRunning := true in
-    let () = Element.setClassName mainElt "g-Layout__HideMain" in
-    let delay = 200 in
+    let () = onStart () in
+    let () = Element.setClassName base "g-Animation" in
+    let delay = 400 in
     let _ =
       Js.Global.setTimeout
         (fun () ->
-          let () = onHidden () in
-          let () = Element.setClassName mainElt "" in
-          let _ =
-            Js.Global.setTimeout
-              (fun () ->
-                let () = onEnded () in
-                isRunning := false)
-              delay
-          in
-          ())
+          let () = Element.setClassName base "" in
+          let () = onEnd () in
+          isRunning := false)
         delay
     in
     ()
   else ()
+
+let replaceChild scrollBase base mkChild =
+  start base
+    ~onStart:(fun _ ->
+      let () = Element.setScrollTop scrollBase 0 in
+      Element.appendChild base (mkChild ()))
+    ~onEnd:(fun _ ->
+      let _ = Element.removeFirstChild base in
+      ())
diff --git a/src/audio.ml b/src/audio.ml
index f7358a7..1446440 100644
--- a/src/audio.ml
+++ b/src/audio.ml
@@ -11,3 +11,24 @@ external setCurrentTime : audio -> int -> unit = "currentTime" [@@bs.set]
 let playOrReplay audio =
   let () = if currentTime audio > 0 then setCurrentTime audio 0 else () in
   play audio
+
+(* Sounds *)
+
+let c3 = create "sounds/c3.mp3"
+
+let c4 = create "sounds/c4.mp3"
+
+let c5 = create "sounds/c5.mp3"
+
+(* Play from step *)
+
+let playFromStep (config: Config.config) (step : Step.state) =
+  match step.step with
+  | Step.Prepare when step.remaining == config.prepare ->
+      playOrReplay c3
+  | Step.Work when step.remaining == config.work ->
+      playOrReplay c5
+  | Step.Rest when step.remaining == config.rest ->
+      playOrReplay c3
+  | Step.End -> playOrReplay c3
+  | _ -> if step.remaining <= 3 then playOrReplay c4 else ()
diff --git a/src/config.ml b/src/config.ml
deleted file mode 100644
index f8e20f9..0000000
--- a/src/config.ml
+++ /dev/null
@@ -1,94 +0,0 @@
-(* Model *)
-
-type config = {
-  prepare : int;
-  tabatas : int;
-  cycles : int;
-  work : int;
-  rest : int;
-}
-
-(* State *)
-
-let config = ref { prepare = 10; tabatas = 4; cycles = 8; work = 20; rest = 10 }
-
-let onStart : (unit -> unit) ref = ref (fun () -> ())
-
-(* Elements *)
-
-let formElt = Document.querySelectorUnsafe "#g-Form"
-
-let prepareElt = Document.querySelectorUnsafe "#g-Form__Prepare"
-
-let tabatasElt = Document.querySelectorUnsafe "#g-Form__Tabatas"
-
-let cyclesElt = Document.querySelectorUnsafe "#g-Form__Cycles"
-
-let workElt = Document.querySelectorUnsafe "#g-Form__Work"
-
-let restElt = Document.querySelectorUnsafe "#g-Form__Rest"
-
-let durationElt = Document.querySelectorUnsafe "#g-Form__DurationValue"
-
-(* Duration *)
-
-let getDuration () =
-  let { prepare; tabatas; cycles; work; rest } = !config in
-  tabatas * (prepare + (cycles * (work + rest)))
-
-let writeDuration () =
-  let duration = getDuration () in
-  Element.setInnerText durationElt (Duration.prettyPrint duration)
-
-(* Write to DOM *)
-
-let writeToDom () =
-  let () = Element.setValue prepareElt (Js.Int.toString !config.prepare) in
-  let () = Element.setValue tabatasElt (Js.Int.toString !config.tabatas) in
-  let () = Element.setValue cyclesElt (Js.Int.toString !config.cycles) in
-  let () = Element.setValue workElt (Js.Int.toString !config.work) in
-  let () = Element.setValue restElt (Js.Int.toString !config.rest) in
-  writeDuration ()
-
-(* Update from DOM *)
-
-let listenTo inputElt update =
-  Element.addEventListener inputElt "input" (fun e ->
-      match
-        EventTarget.value (Event.target e) |> Option.flatMap Belt.Int.fromString
-      with
-      | Some n ->
-          let () = config := update !config n in
-          writeDuration ()
-      | None -> ())
-
-let listenToChanges () =
-  let () = listenTo prepareElt (fun config n -> { config with prepare = n }) in
-  let () = listenTo tabatasElt (fun config n -> { config with tabatas = n }) in
-  let () = listenTo cyclesElt (fun config n -> { config with cycles = n }) in
-  let () = listenTo workElt (fun config n -> { config with work = n }) in
-  listenTo restElt (fun config n -> { config with rest = n })
-
-(* Setup *)
-
-let setup onTimerStart =
-  let () = onStart := onTimerStart in
-  let () = writeToDom () in
-  listenToChanges ()
-
-(* Start *)
-
-let startTimer () =
-  let () = Element.setStyle formElt "display: none" in
-  !onStart ()
-
-(* Hide / show *)
-
-let show () = Element.setStyle formElt "display: flex"
-
-let hide () = Element.setStyle formElt "display: none"
-
-let () =
-  Element.addEventListener formElt "submit" (fun e ->
-      let () = Event.preventDefault e in
-      !onStart ())
diff --git a/src/main.ml b/src/main.ml
index e399e3b..003880b 100644
--- a/src/main.ml
+++ b/src/main.ml
@@ -1,18 +1,14 @@
-let onTimerStart () =
-  Animation.start
-    ~onHidden:(fun () ->
-      let () = Config.hide () in
-      let () = Timer.init () in
-      Timer.show ())
-    ~onEnded:Timer.start
-
-let onTimerStop () =
-  Animation.start
-    ~onHidden:(fun () ->
-      let () = Timer.hide () in
-      Config.show ())
-    ~onEnded:(fun () -> ())
+type view = Config of Config.config | Timer of Config.config
 
 let () =
-  let () = Config.setup onTimerStart in
-  Timer.setup onTimerStop
+  let html = Document.querySelectorUnsafe "html" in
+  let main = Document.querySelectorUnsafe "main" in
+  let rec showView v =
+    Animation.replaceChild html main (fun _ ->
+        match v with
+        | Config config ->
+            ConfigView.render config (fun config -> showView (Timer config))
+        | Timer config ->
+            TimerView.render config (fun config -> showView (Config config)))
+  in
+  showView (Config Config.init)
diff --git a/src/timer.ml b/src/timer.ml
deleted file mode 100644
index 5ff0b8b..0000000
--- a/src/timer.ml
+++ /dev/null
@@ -1,116 +0,0 @@
-(* Audio *)
-
-let c3 = Audio.create "sounds/c3.mp3"
-
-let c4 = Audio.create "sounds/c4.mp3"
-
-let c5 = Audio.create "sounds/c5.mp3"
-
-let playAudio (step : Step.state) =
-  match step.step with
-  | Step.Prepare when step.remaining == !Config.config.prepare ->
-      Audio.playOrReplay c3
-  | Step.Work when step.remaining == !Config.config.work ->
-      Audio.playOrReplay c5
-  | Step.Rest when step.remaining == !Config.config.rest ->
-      Audio.playOrReplay c3
-  | Step.End -> Audio.playOrReplay c3
-  | _ -> if step.remaining <= 3 then Audio.playOrReplay c4 else ()
-
-(* Elements *)
-
-let timerElt = Document.querySelectorUnsafe "#g-Timer"
-
-let dialElt = Document.querySelectorUnsafe "#g-Timer__Dial"
-
-let arcPathElt = Document.querySelectorUnsafe "#g-Timer__ArcProgress"
-
-let stepElt = Document.querySelectorUnsafe "#g-Timer__Step"
-
-let durationElt = Document.querySelectorUnsafe "#g-Timer__Duration"
-
-let tabataCurrentElt = Document.querySelectorUnsafe "#g-Timer__TabataCurrent"
-
-let tabataTotalElt = Document.querySelectorUnsafe "#g-Timer__TabataTotal"
-
-let cycleCurrentElt = Document.querySelectorUnsafe "#g-Timer__CycleCurrent"
-
-let cycleTotalElt = Document.querySelectorUnsafe "#g-Timer__CycleTotal"
-
-let stopElt = Document.querySelectorUnsafe "#g-Timer__Stop"
-
-(* State *)
-
-let interval = ref None
-
-let duration = ref 0
-
-let elapsedTime = ref 0
-
-let onStop : (unit -> unit) ref = ref (fun () -> ())
-
-let isPlaying = ref false
-
-(* Actions *)
-
-let playPause _ = isPlaying := not !isPlaying
-
-let stop _ =
-  let () = Belt.Option.forEach !interval Js.Global.clearInterval in
-  !onStop ()
-
-(* View *)
-
-let updateDom () =
-  let angle =
-    Js.Int.toFloat !elapsedTime /. Js.Int.toFloat !duration *. 360.0
-  in
-  let () =
-    Element.setAttribute arcPathElt "d" (Arc.describe 0.0 0.0 95.0 0.0 angle)
-  in
-  let step = Step.getAt !Config.config !elapsedTime in
-  let () = Element.setInnerText stepElt (Step.prettyPrint step.step) in
-  let () =
-    Element.setInnerText durationElt (Duration.prettyPrint step.remaining)
-  in
-  let () =
-    Element.setInnerText tabataCurrentElt (Js.Int.toString step.tabata)
-  in
-  let () = playAudio step in
-  Element.setInnerText cycleCurrentElt (Js.Int.toString step.cycle)
-
-(* Update *)
-
-let update () =
-  if !isPlaying then
-    let () = elapsedTime := !elapsedTime + 1 in
-    if !elapsedTime > !duration then stop () else updateDom ()
-  else ()
-
-(* Init *)
-
-let init () =
-  let () = duration := Config.getDuration () in
-  let () = elapsedTime := 0 in
-  let () =
-    Element.setInnerText tabataTotalElt (Js.Int.toString !Config.config.tabatas)
-  in
-  Element.setInnerText cycleTotalElt (Js.Int.toString !Config.config.cycles)
-
-(* Setup and start *)
-
-let setup onTimerStop = onStop := onTimerStop
-
-let show () =
-  let () = updateDom () in
-  Element.setStyle timerElt "display: flex"
-
-let hide () = Element.setStyle timerElt "display: none"
-
-let start () =
-  let () = interval := Some (Js.Global.setInterval update 1000) in
-  isPlaying := true
-
-let () =
-  let () = Element.addEventListener stopElt "click" stop in
-  Element.addEventListener dialElt "click" playPause