Minor refactoring of ValueMap and similar

2020-02-09 16:10:14 +00:00 · 2020-02-09 16:10:14 +00:00 · 573f502a06
commit 573f502a06
parent 1d6a28cd43
6 changed files with 347 additions and 105 deletions
--- a/bsconfig.json
+++ b/bsconfig.json
@ -18,6 +18,8 @@
    "bs-ant-design-alt",
    "reason-react",
    "bs-reform",
+    "rationale",
+    "bs-moment",
    "reschema"
  ],
  "refmt": 3,
--- a/package.json
+++ b/package.json
@ -28,6 +28,7 @@
    "parcel-bundler": "^1.12.4",
    "parcel-plugin-less-js-enabled": "^1.0.2",
    "postcss-cli": "^7.1.0",
+    "rationale": "^0.2.0",
    "react": "^16.8.1",
    "react-dom": "^16.8.1",
    "reason-react": ">=0.7.0",
@ -39,4 +40,4 @@
    "moduleserve": "^0.9.0",
    "tailwindcss": "^1.2.0"
  }
-}
+}
--- a/src/E.re
+++ b/src/E.re
@ -0,0 +1,300 @@
+open Rationale.Function.Infix;
+
+/* Utils */
+module U = {
+  let isEqual = (a, b) => a == b;
+  let toA = a => [|a|];
+  let id = e => e;
+};
+
+module O = {
+  let dimap = (sFn, rFn, e) =>
+    switch (e) {
+    | Some(r) => sFn(r)
+    | None => rFn()
+    };
+  ();
+  let fmap = Rationale.Option.fmap;
+  let bind = Rationale.Option.bind;
+  let default = Rationale.Option.default;
+  let isSome = Rationale.Option.isSome;
+  let toExn = Rationale.Option.toExn;
+  let some = Rationale.Option.some;
+  let firstSome = Rationale.Option.firstSome;
+  let toExt = Rationale.Option.toExn;
+  let flatApply = (fn, b) =>
+    Rationale.Option.apply(fn, Some(b)) |> Rationale.Option.flatten;
+
+  let toBool = opt =>
+    switch (opt) {
+    | Some(_) => true
+    | _ => false
+    };
+
+  let ffmap = (fn, r) =>
+    switch (r) {
+    | Some(sm) => fn(sm)
+    | _ => None
+    };
+
+  let toString = opt =>
+    switch (opt) {
+    | Some(s) => s
+    | _ => ""
+    };
+
+  let toResult = (error, e) =>
+    switch (e) {
+    | Some(r) => Belt.Result.Ok(r)
+    | None => Error(error)
+    };
+
+  module React = {
+    let defaultNull = default(ReasonReact.null);
+    let fmapOrNull = fn => fmap(fn) ||> default(ReasonReact.null);
+    let flatten = default(ReasonReact.null);
+  };
+};
+
+/* Functions */
+module F = {
+  let apply = (a, e) => a |> e;
+
+  let flatten2Callbacks = (fn1, fn2, fnlast) =>
+    fn1(response1 => fn2(response2 => fnlast(response1, response2)));
+
+  let flatten3Callbacks = (fn1, fn2, fn3, fnlast) =>
+    fn1(response1 =>
+      fn2(response2 =>
+        fn3(response3 => fnlast(response1, response2, response3))
+      )
+    );
+
+  let flatten4Callbacks = (fn1, fn2, fn3, fn4, fnlast) =>
+    fn1(response1 =>
+      fn2(response2 =>
+        fn3(response3 =>
+          fn4(response4 => fnlast(response1, response2, response3, response4))
+        )
+      )
+    );
+};
+
+module Bool = {
+  type t = bool;
+  let toString = (t: t) => t ? "TRUE" : "FALSE";
+  let fromString = str => str == "TRUE" ? true : false;
+
+  module O = {
+    let toBool = opt =>
+      switch (opt) {
+      | Some(true) => true
+      | _ => false
+      };
+  };
+};
+
+module Float = {
+  let with2DigitsPrecision = Js.Float.toPrecisionWithPrecision(_, ~digits=2);
+  let with3DigitsPrecision = Js.Float.toPrecisionWithPrecision(_, ~digits=3);
+  let toFixed = Js.Float.toFixed;
+  let toString = Js.Float.toString;
+};
+
+module I = {
+  let increment = n => n + 1;
+  let decrement = n => n - 1;
+  let toString = Js.Int.toString;
+};
+
+/* R for Result */
+module R = {
+  let result = Rationale.Result.result;
+  let id = e => e |> result(U.id, U.id);
+  let fmap = Rationale.Result.fmap;
+  let bind = Rationale.Result.bind;
+};
+
+let safe_fn_of_string = (fn, s: string): option('a) =>
+  try (Some(fn(s))) {
+  | _ => None
+  };
+
+module S = {
+  let safe_float = float_of_string->safe_fn_of_string;
+  let safe_int = int_of_string->safe_fn_of_string;
+  let default = (defaultStr, str) => str == "" ? defaultStr : str;
+};
+
+module J = {
+  let toString = Js.Json.decodeString ||> O.default("");
+  let toMoment = toString ||> MomentRe.moment;
+  let fromString = Js.Json.string;
+  let fromNumber = Js.Json.number;
+
+  module O = {
+    let toMoment = O.fmap(toMoment);
+
+    let fromString = (str: string) =>
+      switch (str) {
+      | "" => None
+      | _ => Some(Js.Json.string(str))
+      };
+
+    let toString = (str: option('a)) =>
+      switch (str) {
+      | Some(str) => Some(str |> (Js.Json.decodeString ||> O.default("")))
+      | _ => None
+      };
+  };
+};
+
+module M = {
+  let format = MomentRe.Moment.format;
+  let format_standard = "MMM DD, YYYY HH:mm";
+  let format_simple = "L";
+  /* TODO: Figure out better name */
+  let goFormat_simple = MomentRe.Moment.format(format_simple);
+  let goFormat_standard = MomentRe.Moment.format(format_standard);
+  let toUtc = MomentRe.momentUtc;
+  let toJSON = MomentRe.Moment.toJSON;
+  let momentDefaultFormat = MomentRe.momentDefaultFormat;
+};
+
+module JsDate = {
+  let fromString = Js.Date.fromString;
+  let now = Js.Date.now;
+  let make = Js.Date.make;
+  let valueOf = Js.Date.valueOf;
+};
+
+/* List */
+module L = {
+  let fmap = List.map;
+  let toArray = Array.of_list;
+  let fmapi = List.mapi;
+  let concat = List.concat;
+  let append = List.append;
+  let find = List.find;
+  let filter = List.filter;
+  let for_all = List.for_all;
+  let exists = List.exists;
+  let sort = List.sort;
+  let length = List.length;
+  let filter_opt = Rationale.RList.filter_opt;
+  let uniqBy = Rationale.RList.uniqBy;
+  let join = Rationale.RList.join;
+  let head = Rationale.RList.head;
+  let uniq = Rationale.RList.uniq;
+  let flatten = List.flatten;
+  let last = Rationale.RList.last;
+  let append = List.append;
+  let getBy = Belt.List.getBy;
+  let dropLast = Rationale.RList.dropLast;
+  let contains = Rationale.RList.contains;
+  let without = Rationale.RList.without;
+  let update = Rationale.RList.update;
+  let iter = List.iter;
+  let findIndex = Rationale.RList.findIndex;
+};
+
+/* A for Array */
+module A = {
+  let fmap = Array.map;
+  let fmapi = Array.mapi;
+  let to_list = Array.to_list;
+  let of_list = Array.of_list;
+  let length = Array.length;
+  let append = Array.append;
+  let empty = [||];
+  let unsafe_get = Array.unsafe_get;
+  let get = Belt.Array.get;
+  let getBy = Belt.Array.getBy;
+  let fold_left = Array.fold_left;
+  let fold_right = Array.fold_right;
+  let concatMany = Belt.Array.concatMany;
+  let keepMap = Belt.Array.keepMap;
+  let stableSortBy = Belt.SortArray.stableSortBy;
+
+  let asList = (f: list('a) => list('a), r: array('a)) =>
+    r |> to_list |> f |> of_list;
+  /* TODO: Is there a better way of doing this? */
+  let uniq = r => asList(L.uniq, r);
+
+  // @todo: Is -1 still the indicator that this is false (as is true with
+  // @todo: js findIndex)? Wasn't sure.
+  let findIndex = (e, i) =>
+    Js.Array.findIndex(e, i)
+    |> (
+      r =>
+        switch (r) {
+        | (-1) => None
+        | r => Some(r)
+        }
+    );
+  let filter = (o, e) => Js.Array.filter(o, e);
+
+  module O = {
+    let concatSomes = (optionals: array(option('a))): array('a) =>
+      optionals
+      |> Js.Array.filter(Rationale.Option.isSome)
+      |> Js.Array.map(
+           Rationale.Option.toExn("Warning: This should not have happened"),
+         );
+    let defaultEmpty = (o: option(array('a))): array('a) =>
+      switch (o) {
+      | Some(o) => o
+      | None => [||]
+      };
+  };
+
+  module R = {
+    let firstErrorOrOpen =
+        (results: array(Belt.Result.t('a, 'b)))
+        : Belt.Result.t(array('a), 'b) => {
+      let bringErrorUp =
+        switch (results |> Belt.Array.getBy(_, Belt.Result.isError)) {
+        | Some(Belt.Result.Error(err)) => Belt.Result.Error(err)
+        | Some(Belt.Result.Ok(_)) => Belt.Result.Ok(results)
+        | None => Belt.Result.Ok(results)
+        };
+      let forceOpen = (r: array(Belt.Result.t('a, 'b))): array('a) =>
+        r |> Belt.Array.map(_, r => Belt.Result.getExn(r));
+      bringErrorUp |> Belt.Result.map(_, forceOpen);
+    };
+  };
+};
+
+module JsArray = {
+  let concatSomes = (optionals: Js.Array.t(option('a))): Js.Array.t('a) =>
+    optionals
+    |> Js.Array.filter(Rationale.Option.isSome)
+    |> Js.Array.map(
+         Rationale.Option.toExn("Warning: This should not have happened"),
+       );
+  let filter = Js.Array.filter;
+};
+
+module NonZeroInt = {
+  type t = int;
+  let make = (i: int) => i < 0 ? None : Some(i);
+  let fmap = (fn, a: t) => make(fn(a));
+  let increment = fmap(I.increment);
+  let decrement = fmap(I.decrement);
+};
+
+module BoundedInt = {
+  type t = int;
+  let make = (i: int, limit: int) => {
+    let lessThan0 = r => r < 0;
+    let greaterThanLimit = r => r > limit;
+    if (lessThan0(i) || greaterThanLimit(i)) {
+      None;
+    } else {
+      Some(i);
+    };
+  };
+  let fmap = (fn, a: t, l) => make(fn(a), l);
+  let increment = fmap(I.increment);
+  let decrement = fmap(I.decrement);
+};
--- a/src/Model2.re
+++ b/src/Model2.re
@ -1,64 +0,0 @@
-type model = {
-  name: string,
-  author: string,
-  assumptions: list(Input.parameter),
-  inputs: list(Input.parameter),
-  outputs: list(Output.parameter),
-  outputConfig: Output.outputConfig,
-};
-
-let gatherInputs = (m: model, a: list(InputTypes.withName)) => {
-  let getItem = (p: Input.parameter) => InputTypes.getName(a, p.id);
-  [
-    m.assumptions |> List.map(getItem),
-    m.inputs |> List.map(getItem),
-    [InputTypes.getName(a, "output")],
-  ]
-  |> List.flatten;
-};
-
-module MS = Belt.Map.String;
-
-type modelMaps = {
-  assumptions: MS.t((Input.parameter, option(InputTypes.t))),
-  inputs: MS.t((Input.parameter, option(InputTypes.t))),
-  output: (Output.parameter, option(InputTypes.t)),
-};
-
-let toMaps = (m: model): modelMaps => {
-  assumptions:
-    MS.fromArray(
-      m.assumptions
-      |> List.map((r: Input.parameter) =>
-           (r.id, (r, Input.toInput(r.parameterType)))
-         )
-      |> Array.of_list,
-    ),
-  inputs:
-    MS.fromArray(
-      m.inputs
-      |> List.map((r: Input.parameter) =>
-           (r.id, (r, Input.toInput(r.parameterType)))
-         )
-      |> Array.of_list,
-    ),
-  output: (Output.make(~name="Payouts", ~parameterType=FloatCdf, ()), None),
-};
-
-type modelParams = {
-  assumptions: list(option(InputTypes.t)),
-  inputs: list(option(InputTypes.t)),
-  output: option(InputTypes.t),
-};
-
-let response = (m: model, a: list(InputTypes.withName)) => {
-  let getItem = (p: Input.parameter) =>
-    InputTypes.getName(a, p.id)->Belt.Option.map(InputTypes.withoutName);
-  {
-    assumptions: m.assumptions |> List.map(getItem),
-    inputs: m.inputs |> List.map(getItem),
-    output:
-      InputTypes.getName(a, "output")
-      ->Belt.Option.map(InputTypes.withoutName),
-  };
-};
--- a/src/Prop.re
+++ b/src/Prop.re
@ -48,6 +48,21 @@ module Type = {
    };
 };

+module ValueMap = {
+  module MS = Belt.Map.String;
+  type t = MS.t(Value.t);
+  let get = MS.get;
+  let keys = MS.keysToArray;
+  let map = MS.map;
+  let fromArray = MS.fromArray;
+  let values = t => t |> MS.valuesToArray;
+  let update = MS.update;
+  let toArray = MS.toArray;
+  let fromOptionalMap = (t: MS.t(option(Value.t))): t =>
+    MS.keep(t, (_, d) => E.O.isSome(d))
+    ->MS.map(d => E.O.toExn("This should not have happened", d));
+};
+
 module TypeWithMetadata = {
  // TODO: Figure out a better name for assumptionType
  type assumptionType =
@ -62,6 +77,8 @@ module TypeWithMetadata = {
    assumptionType,
  };

+  type ts = list(t);
+
  // TODO: Change default here
  let currentYear = {
    id: "currentyear",
@ -79,44 +96,14 @@ module TypeWithMetadata = {
    description,
    assumptionType,
  };
-};

-module ValueMap = {
-  module MS = Belt.Map.String;
-  module Combination = {
-    type t = {
-      typeWithMetadata: TypeWithMetadata.t,
-      value: option(Value.t),
-    };
-    let make = (typeWithMetadata, value) => {typeWithMetadata, value};
-    let makeWithDefaults = typeWithMetadata => {
-      typeWithMetadata,
-      value: Type.default(typeWithMetadata.type_),
-    };
+  let toValueMap = (ts: ts) => {
+    ts
+    ->Array.of_list
+    ->Belt.Array.map((b: t) => (b.name, Type.default(b.type_)))
+    ->ValueMap.fromArray
+    ->ValueMap.fromOptionalMap;
  };
-  type t = MS.t(Combination.t);
-  let get = MS.get;
-  let keys = MS.keysToArray;
-  let map = MS.map;
-  let fromArray = MS.fromArray;
-  let values = t =>
-    t |> MS.valuesToArray |> Array.map((r: Combination.t) => r.value);
-  let types = t =>
-    t
-    |> MS.valuesToArray
-    |> Array.map((r: Combination.t) => r.typeWithMetadata);
-
-  let fromTypesWithMetadata = (c: array(TypeWithMetadata.t)) =>
-    c->Belt.Array.map((b: TypeWithMetadata.t) =>
-      (b.name, Combination.makeWithDefaults(b))
-    )
-    |> fromArray;
-
-  let getValue = (t: t, key: MS.key) =>
-    t->MS.get(key)->Belt.Option.flatMap(r => r.value);
-
-  let getType = (t: t, key: MS.key) =>
-    t->MS.get(key)->Belt.Option.map(r => r.typeWithMetadata);
 };

 module Model = {
@ -132,9 +119,21 @@ module Model = {
  };
  type outputValues = ValueMap.t;

-  let toInputDefaults = (t: t): inputValues => {
-    inputs: t.inputTypes |> Array.of_list |> ValueMap.fromTypesWithMetadata,
-    outputSelection: "",
+  module InputValues = {
+    let defaults = (t: t): inputValues => {
+      inputs: t.inputTypes |> TypeWithMetadata.toValueMap,
+      outputSelection: "",
+    };
+    // TODO: This should probably come with a validation or something.
+    let updateInputs =
+        (
+          t: t,
+          inputValues: inputValues,
+          key: string,
+          onUpdate: option(Value.t) => option(Value.t),
+        ) => {
+      ValueMap.update(inputValues.inputs, key, onUpdate);
+    };
  };

  let run = (inputs: inputValues, f) => f(inputs);
@ -142,7 +141,6 @@ module Model = {

 module InputValues = {
  type t = Model.inputValues;
-  let update = (t, str, newValue) => t |> 
 };

 module OutputValues = {
--- a/yarn.lock
+++ b/yarn.lock
@ -5084,6 +5084,11 @@ range-parser@~1.2.1:
  resolved "https://registry.yarnpkg.com/range-parser/-/range-parser-1.2.1.tgz#3cf37023d199e1c24d1a55b84800c2f3e6468031"
  integrity sha512-Hrgsx+orqoygnmhFbKaHE6c296J+HTAQXoxEF6gNupROmmGJRoyzfG3ccAveqCBrwr/2yxQ5BVd/GTl5agOwSg==

+rationale@^0.2.0:
+  version "0.2.0"
+  resolved "https://registry.yarnpkg.com/rationale/-/rationale-0.2.0.tgz#555ed4f3cc7cd0245faeac041d3769f1857e4f3d"
+  integrity sha512-Pd8w5Inv1JhTfRyx03zs486CEAn6UKXvvOtxVRLsewngsBSffo3MQwUKYS75L/8vPt98wmf7iaZROx362/f7Bw==
+
 rc-align@^2.4.0, rc-align@^2.4.1:
  version "2.4.5"
  resolved "https://registry.yarnpkg.com/rc-align/-/rc-align-2.4.5.tgz#c941a586f59d1017f23a428f0b468663fb7102ab"