Migrate to Applicative Functors

packages/squiggle-lang/__tests__/SquiggleLibrary/SquiggleLibrary_Plot_test.res

@@ -2,7 +2,8 @@ open Jest
 open Reducer_TestHelpers
 
 describe("Plot Library", () => {
-  testEvalToBe(`Plot.dist({
+  testEvalToBe(
+    `Plot.dist({
     show: [{
       name: "normal",
       value: normal(0, 1)
@@ -13,5 +14,7 @@ describe("Plot Library", () => {
       name: "constant", 
       value: 3
     }]
-})`, "Ok(Plot showing normal,lognormal,constant)")
+})`,
+    "Ok(Plot showing normal,lognormal,constant)",
+  )
 })

packages/squiggle-lang/src/rescript/FR/FR_Plot.res

@@ -3,77 +3,130 @@ open FunctionRegistry_Helpers
 
 let nameSpace = "Plot"
 
+module FnApp = {
+  type fnApp<'a> = {
+    result: Reducer_T.value => result<'a, SqError.Message.t>,
+    typeRequired: frType,
+  }
+
+  let fmap = (f: 'a => 'b, m: fnApp<'a>): fnApp<'b> => {
+    {
+      result: (a: Reducer_T.value) => E.R.fmap(f, m.result(a)),
+      typeRequired: m.typeRequired,
+    }
+  }
+
+  module Record = {
+    type t<'a> = {
+      result: Reducer_T.map => result<'a, SqError.Message.t>,
+      typesRequired: array<(string, frType)>,
+    }
+
+    let getField = (key: string, parser: fnApp<'a>): t<'a> => {
+      let func = (a: Reducer_T.map) =>
+        switch Belt.Map.String.get(a, key) {
+        | Some(x) => parser.result(x)
+        | None => Error(impossibleError)
+        }
+      {result: func, typesRequired: [(key, parser.typeRequired)]}
+    }
+
+    let merge = (m1: t<'a>, m2: t<'b>): t<('a, 'b)> => {
+      {
+        result: (a: Reducer_T.map) => E.R.merge(m1.result(a), m2.result(a)),
+        typesRequired: Belt.Array.concat(m1.typesRequired, m2.typesRequired),
+      }
+    }
+
+    let fmap = (f: 'a => 'b, m: t<'a>): t<'b> => {
+      {
+        result: (a: Reducer_T.map) => E.R.fmap(f, m.result(a)),
+        typesRequired: m.typesRequired,
+      }
+    }
+
+    let app = (m1: t<'a => 'b>, m2: t<'a>): t<'b> => {
+      {
+        result: (a: Reducer_T.map) =>
+          E.R.merge(m1.result(a), m2.result(a))->E.R2.fmap(((f, x)) => f(x)),
+        typesRequired: Belt.Array.concat(m1.typesRequired, m2.typesRequired),
+      }
+    }
+  }
+
+  let getString: fnApp<string> = {
+    let func = (a: Reducer_T.value) =>
+      switch a {
+      | IEvString(s) => Ok(s)
+      | _ => Error(impossibleError)
+      }
+    {result: func, typeRequired: FRTypeString}
+  }
+
+  let getArray = (child: fnApp<'a>): fnApp<array<'a>> => {
+    let func = (a: Reducer_T.value) =>
+      switch a {
+      | IEvArray(x) => x->E.A2.fmap(child.result)->E.A.R.firstErrorOrOpen
+      | _ => Error(impossibleError)
+      }
+    {result: func, typeRequired: FRTypeArray(child.typeRequired)}
+  }
+  let getRecord = (recMonad: Record.t<'a>): fnApp<'a> => {
+    let func = (a: Reducer_T.value) =>
+      switch a {
+      | IEvRecord(s) => recMonad.result(s)
+      | _ => Error(impossibleError)
+      }
+    {result: func, typeRequired: FRTypeRecord(recMonad.typesRequired)}
+  }
+
+  let getDistOrNumber: fnApp<GenericDist.t> = {
+    let func = (a: Reducer_T.value) =>
+      switch a {
+      | IEvDistribution(s) => Ok(s)
+      | IEvNumber(s) => Ok(GenericDist.fromFloat(s))
+      | _ => Error(impossibleError)
+      }
+    {result: func, typeRequired: FRTypeDistOrNumber}
+  }
+
+  let oneArgDef = (
+    name: string,
+    arg1: fnApp<'a>,
+    def: 'a => result<Reducer_T.value, SqError.Message.t>,
+  ): FnDefinition.t =>
+    FnDefinition.make(
+      ~name,
+      ~inputs=[arg1.typeRequired],
+      ~run=(inputs, _, _) => {
+        E.R.bind(arg1.result(inputs[0]), def)
+      },
+      (),
+    )
+}
+
 module Internals = {
-  let parseString = (a: Reducer_T.value): result<string, SqError.Message.t> => {
-    switch a {
-    | IEvString(s) => Ok(s)
-    | _ => Error(SqError.Message.REOther("Expected to be a string"))
-    }
+  let makeLabeledDistribution = (
+    name: string,
+    distribution: GenericDist.t,
+  ): Reducer_T.labeledDistribution => {name: name, distribution: distribution}
+
+  let getLabeledDistribution: FnApp.fnApp<Reducer_T.labeledDistribution> = {
+    makeLabeledDistribution
+    ->FnApp.Record.fmap(FnApp.Record.getField("name", FnApp.getString))
+    ->FnApp.Record.app(FnApp.Record.getField("value", FnApp.getDistOrNumber))
+    ->FnApp.getRecord
   }
 
-  let parseDistributionOrNumber = (a: Reducer_T.value): result<
-    GenericDist.t,
-    SqError.Message.t,
-  > => {
-    switch a {
-    | IEvDistribution(s) => Ok(s)
-    | IEvNumber(s) => Ok(GenericDist.fromFloat(s))
-    | _ => Error(SqError.Message.REOther("Expected to be a distribution"))
-    }
+  let makePlot = (show: array<Reducer_T.labeledDistribution>): Reducer_T.plotValue => {
+    distributions: show,
   }
 
-  let parseArray = (
-    parser: Reducer_T.value => result<'a, SqError.Message.t>,
-    a: Reducer_T.value,
-  ): result<array<'a>, SqError.Message.t> => {
-    switch a {
-    | IEvArray(x) => x->E.A2.fmap(parser)->E.A.R.firstErrorOrOpen
-    | _ => Error(SqError.Message.REOther("Expected to be an array"))
-    }
+  let parsePlotValue: FnApp.fnApp<Reducer_T.plotValue> = {
+    makePlot
+    ->FnApp.Record.fmap(FnApp.Record.getField("show", FnApp.getArray(getLabeledDistribution)))
+    ->FnApp.getRecord
   }
-
-  let parseRecord = (
-    parser: Reducer_T.map => result<'b, SqError.Message.t>,
-    a: Reducer_T.value,
-  ): result<'b, SqError.Message.t> => {
-    switch a {
-    | IEvRecord(x) => parser(x)
-    | _ => Error(SqError.Message.REOther("Expected to be an array"))
-    }
-  }
-
-  let parseField = (
-    a: Reducer_T.map,
-    key: string,
-    parser: Reducer_T.value => result<'a, SqError.Message.t>,
-  ): result<'a, SqError.Message.t> => {
-    switch Belt.Map.String.get(a, key) {
-    | Some(x) => parser(x)
-    | None => Error(SqError.Message.REOther("expected field " ++ key ++ " in plot dictionary."))
-    }
-  }
-
-  let parseLabeledDistribution = (a: Reducer_T.map): result<
-    Reducer_T.labeledDistribution,
-    SqError.Message.t,
-  > => {
-    let name = parseField(a, "name", parseString)
-    let distribution = parseField(a, "value", parseDistributionOrNumber)
-    switch E.R.merge(name, distribution) {
-    | Ok(name, distribution) => Ok({name: name, distribution: distribution})
-    | Error(err) => Error(err)
-    }
-  }
-
-  let parsePlotValue = (a: Reducer_T.map): result<Reducer_T.plotValue, SqError.Message.t> => {
-    parseField(a, "show", parseArray(parseRecord(parseLabeledDistribution)))->E.R2.fmap(dists => {
-      let plot: Reducer_T.plotValue = {distributions: dists}
-      plot
-    })
-  }
-
-  let dist = (a: Reducer_T.map): result<Reducer_T.value, SqError.Message.t> =>
-    E.R2.fmap(parsePlotValue(a), x => Reducer_T.IEvPlot(x))
 }
 
 let library = [
@@ -86,17 +139,7 @@ let library = [
       `Plot.dist({show: [{name: "Control", value: 1 to 2}, {name: "Treatment", value: 1.5 to 2.5}]}) `,
     ],
     ~definitions=[
-      FnDefinition.make(
-        ~name="dist",
-        ~inputs=[FRTypeDict(FRTypeAny)],
-        ~run=(inputs, _, _) => {
-          switch inputs {
-          | [IEvRecord(plot)] => Internals.dist(plot)
-          | _ => impossibleError->Error
-          }
-        },
-        (),
-      ),
+      FnApp.oneArgDef("dist", Internals.parsePlotValue, (a: Reducer_T.plotValue) => Ok(IEvPlot(a))),
     ],
     (),
   ),

packages/squiggle-lang/src/rescript/FunctionRegistry/FunctionRegistry_Core.res

@@ -1,4 +1,5 @@
 type internalExpressionValueType = Reducer_Value.internalExpressionValueType
+let valueTypeToString = Reducer_Value.valueTypeToString
 type errorMessage = SqError.Message.t
 
 /*