Migrate to Applicative Functors
This commit is contained in:
parent
c060304161
commit
8d612f75f0
|
@ -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)",
|
||||||
|
)
|
||||||
})
|
})
|
||||||
|
|
|
@ -3,77 +3,130 @@ 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)
|
||||||
|
},
|
||||||
|
(),
|
||||||
|
)
|
||||||
|
}
|
||||||
|
|
||||||
|
module Internals = {
|
||||||
|
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 parseRecord = (
|
let makePlot = (show: array<Reducer_T.labeledDistribution>): Reducer_T.plotValue => {
|
||||||
parser: Reducer_T.map => result<'b, SqError.Message.t>,
|
distributions: show,
|
||||||
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 = (
|
let parsePlotValue: FnApp.fnApp<Reducer_T.plotValue> = {
|
||||||
a: Reducer_T.map,
|
makePlot
|
||||||
key: string,
|
->FnApp.Record.fmap(FnApp.Record.getField("show", FnApp.getArray(getLabeledDistribution)))
|
||||||
parser: Reducer_T.value => result<'a, SqError.Message.t>,
|
->FnApp.getRecord
|
||||||
): 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 = [
|
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}]}) `,
|
`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
|
|
||||||
}
|
|
||||||
},
|
|
||||||
(),
|
|
||||||
),
|
|
||||||
],
|
],
|
||||||
(),
|
(),
|
||||||
),
|
),
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
/*
|
/*
|
||||||
|
|
Loading…
Reference in New Issue
Block a user