Started trying to convert YAML parser to Reason

src/App/Utilities/YAML.re

@@ -80,3 +80,176 @@ module Parser = {
   let parse = data => jsParse(data, defaultOptions);
   let parseWithOpts = jsParse;
 };
+
+module Schema = {
+  open IO.Functor;
+
+  let heroSchemes = [
+    ["Schema", "Advantages", "Advantages.l10n.schema.json"],
+    ["Schema", "Advantages", "Advantages.univ.schema.json"],
+    ["Schema", "AnimistForces", "AnimistForces.l10n.schema.json"],
+    ["Schema", "AnimistForces", "AnimistForces.univ.schema.json"],
+    [
+      "Schema",
+      "ArcaneBardTraditions",
+      "ArcaneBardTraditions.l10n.schema.json",
+    ],
+    [
+      "Schema",
+      "ArcaneDancerTraditions",
+      "ArcaneDancerTraditions.l10n.schema.json",
+    ],
+    ["Schema", "ArmorTypes", "ArmorTypes.l10n.schema.json"],
+    ["Schema", "Aspects", "Aspects.l10n.schema.json"],
+    ["Schema", "Attributes", "Attributes.l10n.schema.json"],
+    ["Schema", "BlessedTraditions", "BlessedTraditions.l10n.schema.json"],
+    ["Schema", "BlessedTraditions", "BlessedTraditions.univ.schema.json"],
+    ["Schema", "Blessings", "Blessings.l10n.schema.json"],
+    ["Schema", "Blessings", "Blessings.univ.schema.json"],
+    ["Schema", "Books", "Books.l10n.schema.json"],
+    ["Schema", "Brews", "Brews.l10n.schema.json"],
+    ["Schema", "Cantrips", "Cantrips.l10n.schema.json"],
+    ["Schema", "Cantrips", "Cantrips.univ.schema.json"],
+    [
+      "Schema",
+      "CombatSpecialAbilityGroups",
+      "CombatSpecialAbilityGroups.l10n.schema.json",
+    ],
+    [
+      "Schema",
+      "CombatTechniqueGroups",
+      "CombatTechniqueGroups.l10n.schema.json",
+    ],
+    ["Schema", "CombatTechniques", "CombatTechniques.l10n.schema.json"],
+    ["Schema", "CombatTechniques", "CombatTechniques.univ.schema.json"],
+    ["Schema", "Conditions", "Conditions.l10n.schema.json"],
+    ["Schema", "Cultures", "Cultures.l10n.schema.json"],
+    ["Schema", "Cultures", "Cultures.univ.schema.json"],
+    ["Schema", "Curses", "Curses.l10n.schema.json"],
+    ["Schema", "Curses", "Curses.univ.schema.json"],
+    [
+      "Schema",
+      "DerivedCharacteristics",
+      "DerivedCharacteristics.l10n.schema.json",
+    ],
+    ["Schema", "Disadvantages", "Disadvantages.l10n.schema.json"],
+    ["Schema", "Disadvantages", "Disadvantages.univ.schema.json"],
+    ["Schema", "DominationRituals", "DominationRituals.l10n.schema.json"],
+    ["Schema", "DominationRituals", "DominationRituals.univ.schema.json"],
+    ["Schema", "ElvenMagicalSongs", "ElvenMagicalSongs.l10n.schema.json"],
+    ["Schema", "ElvenMagicalSongs", "ElvenMagicalSongs.univ.schema.json"],
+    ["Schema", "Equipment", "Equipment.l10n.schema.json"],
+    ["Schema", "Equipment", "Equipment.univ.schema.json"],
+    ["Schema", "EquipmentGroups", "EquipmentGroups.l10n.schema.json"],
+    ["Schema", "EquipmentPackages", "EquipmentPackages.l10n.schema.json"],
+    ["Schema", "EquipmentPackages", "EquipmentPackages.univ.schema.json"],
+    ["Schema", "ExperienceLevels", "ExperienceLevels.l10n.schema.json"],
+    ["Schema", "ExperienceLevels", "ExperienceLevels.univ.schema.json"],
+    ["Schema", "EyeColors", "EyeColors.l10n.schema.json"],
+    ["Schema", "FocusRules", "FocusRules.l10n.schema.json"],
+    ["Schema", "FocusRules", "FocusRules.univ.schema.json"],
+    ["Schema", "GeodeRituals", "GeodeRituals.l10n.schema.json"],
+    ["Schema", "GeodeRituals", "GeodeRituals.univ.schema.json"],
+    ["Schema", "HairColors", "HairColors.l10n.schema.json"],
+    [
+      "Schema",
+      "LiturgicalChantEnhancements",
+      "LiturgicalChantEnhancements.l10n.schema.json",
+    ],
+    [
+      "Schema",
+      "LiturgicalChantEnhancements",
+      "LiturgicalChantEnhancements.univ.schema.json",
+    ],
+    [
+      "Schema",
+      "LiturgicalChantGroups",
+      "LiturgicalChantGroups.l10n.schema.json",
+    ],
+    ["Schema", "LiturgicalChants", "LiturgicalChants.l10n.schema.json"],
+    ["Schema", "LiturgicalChants", "LiturgicalChants.univ.schema.json"],
+    ["Schema", "MagicalDances", "MagicalDances.l10n.schema.json"],
+    ["Schema", "MagicalDances", "MagicalDances.univ.schema.json"],
+    ["Schema", "MagicalMelodies", "MagicalMelodies.l10n.schema.json"],
+    ["Schema", "MagicalMelodies", "MagicalMelodies.univ.schema.json"],
+    ["Schema", "MagicalTraditions", "MagicalTraditions.l10n.schema.json"],
+    ["Schema", "MagicalTraditions", "MagicalTraditions.univ.schema.json"],
+    ["Schema", "OptionalRules", "OptionalRules.l10n.schema.json"],
+    ["Schema", "Pacts", "Pacts.l10n.schema.json"],
+    ["Schema", "Professions", "Professions.l10n.schema.json"],
+    ["Schema", "Professions", "Professions.univ.schema.json"],
+    ["Schema", "ProfessionVariants", "ProfessionVariants.l10n.schema.json"],
+    ["Schema", "ProfessionVariants", "ProfessionVariants.univ.schema.json"],
+    ["Schema", "Properties", "Properties.l10n.schema.json"],
+    ["Schema", "Races", "Races.l10n.schema.json"],
+    ["Schema", "Races", "Races.univ.schema.json"],
+    ["Schema", "RaceVariants", "RaceVariants.l10n.schema.json"],
+    ["Schema", "RaceVariants", "RaceVariants.univ.schema.json"],
+    ["Schema", "Reaches", "Reaches.l10n.schema.json"],
+    ["Schema", "RogueSpells", "RogueSpells.l10n.schema.json"],
+    ["Schema", "RogueSpells", "RogueSpells.univ.schema.json"],
+    ["Schema", "SkillGroups", "SkillGroups.l10n.schema.json"],
+    ["Schema", "Skills", "Skills.l10n.schema.json"],
+    ["Schema", "Skills", "Skills.univ.schema.json"],
+    ["Schema", "SocialStatuses", "SocialStatuses.l10n.schema.json"],
+    ["Schema", "SpecialAbilities", "SpecialAbilities.l10n.schema.json"],
+    ["Schema", "SpecialAbilities", "SpecialAbilities.univ.schema.json"],
+    [
+      "Schema",
+      "SpecialAbilityGroups",
+      "SpecialAbilityGroups.l10n.schema.json",
+    ],
+    ["Schema", "SpellEnhancements", "SpellEnhancements.l10n.schema.json"],
+    ["Schema", "SpellEnhancements", "SpellEnhancements.univ.schema.json"],
+    ["Schema", "SpellGroups", "SpellGroups.l10n.schema.json"],
+    ["Schema", "Spells", "Spells.l10n.schema.json"],
+    ["Schema", "Spells", "Spells.univ.schema.json"],
+    ["Schema", "States", "States.l10n.schema.json"],
+    ["Schema", "Subjects", "Subjects.l10n.schema.json"],
+    ["Schema", "Tribes", "Tribes.l10n.schema.json"],
+    ["Schema", "UI", "UI.l10n.schema.json"],
+    ["Schema", "ZibiljaRituals", "ZibiljaRituals.l10n.schema.json"],
+    ["Schema", "ZibiljaRituals", "ZibiljaRituals.univ.schema.json"],
+    ["Schema", "SupportedLanguages.schema.json"],
+  ];
+
+  let schemeIdToPath = xs =>
+    ["app", "Database"] @ xs |> ListH.Foldable.foldl1(Node.Path.join2);
+
+  let getAllSchemes = () =>
+    ListH.map(Json.parseOrRaise)
+    <$> IO.Monad.mapM(x => x |> schemeIdToPath |> IO.readFile, heroSchemes);
+};
+
+let parseStaticData = locale => {
+  Js.Console.timeStart(
+    "parseStaticData",
+    // let eschemes = handleE (getAllSchemes ())
+    // if (isLeft (eschemes)) {
+    //   console.log (fromLeft_ (eschemes))
+    //   return Left ([ fromLeft_ (eschemes) ])
+    // }
+    // console.log ("Schemes loaded")
+    // let schemes = fromRight_ (eschemes)
+    // let validator = new Ajv ({ allErrors: true }) .addSchema (schemes)
+    // let univ_parser = readYamlUniv (validator)
+    // let l10n_parser = readYamlL10n (locale) (validator)
+    // let estatic_data_by_file = await parseByFile (univ_parser)
+    //                                               (l10n_parser)
+    // if (isLeft (estatic_data_by_file)) {
+    //   let errs = fromLeft_ (estatic_data_by_file)
+    //   console.log (errs)
+    //   return Left (
+    //     Object.values (errs)
+    //       .filter<Error[]> (Array.isArray)
+    //       .flat (1)
+    //   )
+    // }
+    // console.log ("Files parsed")
+    // let static_data_by_file = fromRight_ (estatic_data_by_file)
+    // let wiki = toWiki (locale) (static_data_by_file)
+    // console.log ("Parsing static data done!")
+    // console.timeEnd ("parseStaticData")
+    // return wiki
+  );
+};

src/Control/Exception.bs.js

@@ -0,0 +1,23 @@
+// Generated by BUCKLESCRIPT, PLEASE EDIT WITH CARE
+'use strict';
+
+var Block = require("bs-platform/lib/js/block.js");
+var Curry = require("bs-platform/lib/js/curry.js");
+var IO$OptolithClient = require("../System/IO.bs.js");
+
+function $$catch(prim, prim$1) {
+  return prim$1.catch(Curry.__1(prim));
+}
+
+function try_(x) {
+  var prim = IO$OptolithClient.Monad.$great$great$eq(x, (function (x) {
+          return IO$OptolithClient.Monad.pure(/* Right */Block.__(1, [x]));
+        }));
+  return prim.catch((function (x) {
+                return IO$OptolithClient.Monad.pure(/* Left */Block.__(0, [x]));
+              }));
+}
+
+exports.$$catch = $$catch;
+exports.try_ = try_;
+/* IO-OptolithClient Not a pure module */

src/Control/Exception.re

@@ -0,0 +1,6 @@
+open Either;
+open IO.Monad;
+
+let catch = Js.Promise.catch;
+
+let try_ = x => x >>= (x => pure(Right(x))) |> catch(x => pure(Left(x)));

src/Control/Exception.rei

@@ -0,0 +1,14 @@
+/**
+ * This is the simplest of the exception-catching functions. It takes a single
+ * argument, runs it, and if an exception is raised the "handler" is executed,
+ * with the value of the exception passed as an argument. Otherwise, the result
+ * is returned as normal.
+ */
+let catch: (Js.Promise.error => IO.t('a), IO.t('a)) => IO.t('a);
+
+/**
+ * Similar to `catch`, but returns an `Either` result which is `(Right a)` if no
+ * exception was raised, or `(Left ex)` if an exception was raised and its value
+ * is `ex`.
+ */
+let try_: IO.t('a) => IO.t(Either.t(Js.Promise.error, 'a));

src/Data/Either.bs.js

@@ -0,0 +1,2 @@
+// Generated by BUCKLESCRIPT, PLEASE EDIT WITH CARE
+/* This output is empty. Its source's type definitions, externals and/or unused code got optimized away. */

src/Data/Either.re

@@ -0,0 +1,3 @@
+type t('l, 'r) =
+  | Left('l)
+  | Right('r);

src/Data/ListH.bs.js

@@ -0,0 +1,72 @@
+// Generated by BUCKLESCRIPT, PLEASE EDIT WITH CARE
+'use strict';
+
+var Curry = require("bs-platform/lib/js/curry.js");
+var Pervasives = require("bs-platform/lib/js/pervasives.js");
+
+function $less$$great(f, xs) {
+  if (xs) {
+    return /* :: */[
+            Curry._1(f, xs[0]),
+            $less$$great(f, xs[1])
+          ];
+  } else {
+    return /* [] */0;
+  }
+}
+
+var Functor = {
+  $less$$great: $less$$great
+};
+
+function foldr(f, initial, xs) {
+  if (xs) {
+    return Curry._2(f, xs[0], foldr(f, initial, xs[1]));
+  } else {
+    return initial;
+  }
+}
+
+function foldr1(f, xs) {
+  if (xs) {
+    return foldr(f, xs[0], xs[1]);
+  } else {
+    return Pervasives.invalid_arg("Cannot apply foldr1 to an empty list.");
+  }
+}
+
+function foldl(f, _initial, _xs) {
+  while(true) {
+    var xs = _xs;
+    var initial = _initial;
+    if (xs) {
+      _xs = xs[1];
+      _initial = Curry._2(f, initial, xs[0]);
+      continue ;
+    } else {
+      return initial;
+    }
+  };
+}
+
+function foldl1(f, xs) {
+  if (xs) {
+    return foldl(f, xs[0], xs[1]);
+  } else {
+    return Pervasives.invalid_arg("Cannot apply foldl1 to an empty list.");
+  }
+}
+
+var Foldable = {
+  foldr: foldr,
+  foldr1: foldr1,
+  foldl: foldl,
+  foldl1: foldl1
+};
+
+var map = $less$$great;
+
+exports.Functor = Functor;
+exports.Foldable = Foldable;
+exports.map = map;
+/* No side effect */

src/Data/ListH.re

@@ -0,0 +1,67 @@
+module Functor = {
+  let rec (<$>) = (f, xs) =>
+    switch (xs) {
+    | [] => []
+    | [y, ...ys] => [f(y), ...f <$> ys]
+    };
+};
+
+module Foldable = {
+  /**
+   * Right-associative fold of a structure.
+   *
+   * In the case of lists, `foldr`, when applied to a binary operator, a
+   * starting value (typically the right-identity of the operator), and a list,
+   * reduces the list using the binary operator, from right to left:
+   *
+   * ```foldr f z [x1, x2, ..., xn] == x1 `f` (x2 `f` ... (xn `f` z)...)```
+   */
+  let rec foldr = (f, initial, xs) =>
+    switch (xs) {
+    | [] => initial
+    | [y, ...ys] => f(y, foldr(f, initial, ys))
+    };
+
+  /**
+   * A variant of `foldr` that has no base case, and thus may only be applied to
+   * non-empty structures.
+   *
+   * `foldr1 f = foldr1 f . toList`
+   */
+  let foldr1 = (f, xs) =>
+    switch (xs) {
+    | [] => invalid_arg("Cannot apply foldr1 to an empty list.")
+    | [y, ...ys] => foldr(f, y, ys)
+    };
+
+  /**
+   * Left-associative fold of a structure.
+   *
+   * In the case of lists, foldl, when applied to a binary operator, a starting
+   * value (typically the left-identity of the operator), and a list, reduces
+   * the list using the binary operator, from left to right:
+   *
+   * ```foldl f z [x1, x2, ..., xn] == (...((z `f` x1) `f` x2) `f`...) `f` xn```
+   */
+  let rec foldl = (f, initial, xs) =>
+    switch (xs) {
+    | [] => initial
+    | [y, ...ys] => foldl(f, f(initial, y), ys)
+    };
+
+  /**
+   * `foldl1 :: (a -> a -> a) -> [a] -> a`
+   *
+   * A variant of `foldl` that has no base case, and thus may only be applied to
+   * non-empty structures.
+   *
+   * `foldl1 f = foldl1 f . toList`
+   */
+  let foldl1 = (f, xs) =>
+    switch (xs) {
+    | [] => invalid_arg("Cannot apply foldl1 to an empty list.")
+    | [y, ...ys] => foldl(f, y, ys)
+    };
+};
+
+let map = Functor.(<$>);

src/Data/Maybe.bs.js

@@ -69,6 +69,25 @@ function $great$great(x, y) {
               }));
 }
 
+function mapM(f, xs) {
+  if (xs) {
+    var match = Curry._1(f, xs[0]);
+    if (match) {
+      var z = match[0];
+      return $less$$great((function (zs) {
+                    return /* :: */[
+                            z,
+                            zs
+                          ];
+                  }), mapM(f, xs[1]));
+    } else {
+      return /* Nothing */0;
+    }
+  } else {
+    return /* Just */[/* [] */0];
+  }
+}
+
 function $great$eq$great(f, g, x) {
   return $great$great$eq(Curry._1(f, x), g);
 }
@@ -105,6 +124,7 @@ var Monad = {
   $great$great$eq: $great$great$eq,
   $eq$less$less: $eq$less$less,
   $great$great: $great$great,
+  mapM: mapM,
   $great$eq$great: $great$eq$great,
   join: join,
   liftM2: liftM2,

src/Data/Maybe.re

@@ -47,6 +47,16 @@ module Monad = {
 
   let (>>) = (x, y) => x >>= const(y);
 
+  let rec mapM = (f, xs) =>
+    switch (xs) {
+    | [] => Just([])
+    | [x, ...ys] =>
+      switch (f(x)) {
+      | Just(z) => (zs => [z, ...zs]) <$> mapM(f, ys)
+      | Nothing => Nothing
+      }
+    };
+
   let (>=>) = (f, g, x) => x->f >>= g;
 
   let join = x => x >>= id;

src/Data/Maybe.rei

@@ -46,6 +46,13 @@ module Monad: {
    */
   let (>>): (t('a), t('b)) => t('b);
 
+  /**
+   * Maps a function over all values of the list. Returns a `Just` of the
+   * results, if the function returned `Just`s for all elements. Otherwise
+   * returns `Nothing`.
+   */
+  let mapM: ('b => t('a), list('b)) => t(list('a));
+
   /**
    * Takes a value and applies two functions that may fail (return `Nothing`).
    * Returns a `Just` of the result value or a `Nothing` if one of the functions

src/System/IO.bs.js

@@ -26,10 +26,28 @@ function $eq$less$less(f, mx) {
   return mx.then(Curry.__1(f));
 }
 
+function mapM(f, xs) {
+  if (xs) {
+    var ys = xs[1];
+    var mx = Curry._1(f, xs[0]);
+    return mx.then((function (z) {
+                  return $less$$great((function (zs) {
+                                return /* :: */[
+                                        z,
+                                        zs
+                                      ];
+                              }), mapM(f, ys));
+                }));
+  } else {
+    return Promise.resolve(/* [] */0);
+  }
+}
+
 var Monad = {
   pure: pure,
   $great$great$eq: $great$great$eq,
-  $eq$less$less: $eq$less$less
+  $eq$less$less: $eq$less$less,
+  mapM: mapM
 };
 
 function readFile(path) {

src/System/IO.re

@@ -51,11 +51,21 @@ module Functor = {
 };
 
 module Monad = {
+  open Functor;
+
   let pure = Js.Promise.resolve;
 
   let (>>=) = (mx, f) => Js.Promise.then_(f, mx);
 
   let (=<<) = (f, mx) => mx >>= f;
+
+  let rec mapM = (f, xs) =>
+    switch (xs) {
+    | [] => pure ([])
+    | [x, ...ys] =>
+      x
+      |> f >>= (z => (zs => [z, ...zs]) <$> mapM(f, ys))
+    };
 };
 
 type filePath = string;

src/System/IO.rei

@@ -26,6 +26,13 @@ module Monad: {
    * action.
    */
   let (=<<): ('a => t('b), t('a)) => t('b);
+
+  /**
+   * Maps a function over all values of the list. Returns an `IO` of the
+   * results. If one of the `IO`s contains an exception, the first exception
+   * will be returned.
+   */
+  let mapM: ('b => Js.Promise.t('a), list('b)) => Js.Promise.t(list('a));
 };
 
 type filePath = string;