Migrate to Applicative Functors

This commit is contained in:
Sam Nolan 2022-10-11 17:05:37 +11:00
parent c060304161
commit 8d612f75f0
3 changed files with 125 additions and 78 deletions

View File

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

View File

@ -3,79 +3,132 @@ open FunctionRegistry_Helpers
let nameSpace = "Plot" let nameSpace = "Plot"
module Internals = { module FnApp = {
let parseString = (a: Reducer_T.value): result<string, SqError.Message.t> => { type fnApp<'a> = {
switch a { result: Reducer_T.value => result<'a, SqError.Message.t>,
| IEvString(s) => Ok(s) typeRequired: frType,
| _ => Error(SqError.Message.REOther("Expected to be a string")) }
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,
} }
} }
let parseDistributionOrNumber = (a: Reducer_T.value): result< module Record = {
GenericDist.t, type t<'a> = {
SqError.Message.t, 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 { switch a {
| IEvDistribution(s) => Ok(s) | IEvDistribution(s) => Ok(s)
| IEvNumber(s) => Ok(GenericDist.fromFloat(s)) | IEvNumber(s) => Ok(GenericDist.fromFloat(s))
| _ => Error(SqError.Message.REOther("Expected to be a distribution")) | _ => Error(impossibleError)
} }
{result: func, typeRequired: FRTypeDistOrNumber}
} }
let parseArray = ( let oneArgDef = (
parser: Reducer_T.value => result<'a, SqError.Message.t>, name: string,
a: Reducer_T.value, arg1: fnApp<'a>,
): result<array<'a>, SqError.Message.t> => { def: 'a => result<Reducer_T.value, SqError.Message.t>,
switch a { ): FnDefinition.t =>
| IEvArray(x) => x->E.A2.fmap(parser)->E.A.R.firstErrorOrOpen FnDefinition.make(
| _ => Error(SqError.Message.REOther("Expected to be an array")) ~name,
} ~inputs=[arg1.typeRequired],
~run=(inputs, _, _) => {
E.R.bind(arg1.result(inputs[0]), def)
},
(),
)
} }
let parseRecord = ( module Internals = {
parser: Reducer_T.map => result<'b, SqError.Message.t>, let makeLabeledDistribution = (
a: Reducer_T.value, name: string,
): result<'b, SqError.Message.t> => { distribution: GenericDist.t,
switch a { ): Reducer_T.labeledDistribution => {name: name, distribution: distribution}
| IEvRecord(x) => parser(x)
| _ => Error(SqError.Message.REOther("Expected to be an array")) 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 parseField = ( let makePlot = (show: array<Reducer_T.labeledDistribution>): Reducer_T.plotValue => {
a: Reducer_T.map, distributions: show,
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< let parsePlotValue: FnApp.fnApp<Reducer_T.plotValue> = {
Reducer_T.labeledDistribution, makePlot
SqError.Message.t, ->FnApp.Record.fmap(FnApp.Record.getField("show", FnApp.getArray(getLabeledDistribution)))
> => { ->FnApp.getRecord
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 = [ let library = [
Function.make( Function.make(
~name="dist", ~name="dist",
@ -86,17 +139,7 @@ let library = [
`Plot.dist({show: [{name: "Control", value: 1 to 2}, {name: "Treatment", value: 1.5 to 2.5}]}) `, `Plot.dist({show: [{name: "Control", value: 1 to 2}, {name: "Treatment", value: 1.5 to 2.5}]}) `,
], ],
~definitions=[ ~definitions=[
FnDefinition.make( FnApp.oneArgDef("dist", Internals.parsePlotValue, (a: Reducer_T.plotValue) => Ok(IEvPlot(a))),
~name="dist",
~inputs=[FRTypeDict(FRTypeAny)],
~run=(inputs, _, _) => {
switch inputs {
| [IEvRecord(plot)] => Internals.dist(plot)
| _ => impossibleError->Error
}
},
(),
),
], ],
(), (),
), ),

View File

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