type check

packages/squiggle-lang/__tests__/Reducer/Reducer_Type/Reducer_Type_TypeChecker_arguments_test.res

@@ -0,0 +1,52 @@
+module Expression = Reducer_Expression
+module ExpressionT = Reducer_Expression_T
+module ErrorValue = Reducer_ErrorValue
+module InternalExpressionValue = ReducerInterface_InternalExpressionValue
+module Module = Reducer_Module
+module T = Reducer_Type_T
+module TypeChecker = Reducer_Type_TypeChecker
+
+open Jest
+open Expect
+
+let checkArgumentsSourceCode = (aTypeSourceCode: string, sourceCode: string): result<
+  'v,
+  ErrorValue.t,
+> => {
+  let reducerFn = Expression.reduceExpression
+  let rResult =
+    Reducer.parse(sourceCode)->Belt.Result.flatMap(expr =>
+      reducerFn(expr, Module.emptyBindings, InternalExpressionValue.defaultEnvironment)
+    )
+  rResult->Belt.Result.flatMap(result =>
+    switch result {
+    | IEvArray(args) => TypeChecker.checkArguments(aTypeSourceCode, args, reducerFn)
+    | _ => Js.Exn.raiseError("Arguments has to be an array")
+    }
+  )
+}
+
+let myCheckArguments = (aTypeSourceCode: string, sourceCode: string): string =>
+  switch checkArgumentsSourceCode(aTypeSourceCode, sourceCode) {
+  | Ok(_) => "Ok"
+  | Error(error) => ErrorValue.errorToString(error)
+  }
+
+let myCheckArgumentsExpectEqual = (aTypeSourceCode, sourceCode, answer) =>
+  expect(myCheckArguments(aTypeSourceCode, sourceCode))->toEqual(answer)
+
+let _myCheckArgumentsTest = (test, aTypeSourceCode, sourceCode, answer) =>
+  test(aTypeSourceCode, () => myCheckArgumentsExpectEqual(aTypeSourceCode, sourceCode, answer))
+
+let myCheckArgumentsTest = (aTypeSourceCode, sourceCode, answer) =>
+  _myCheckArgumentsTest(test, aTypeSourceCode, sourceCode, answer)
+module MySkip = {
+  let myCheckArgumentsTest = (aTypeSourceCode, sourceCode, answer) =>
+    _myCheckArgumentsTest(Skip.test, aTypeSourceCode, sourceCode, answer)
+}
+module MyOnly = {
+  let myCheckArgumentsTest = (aTypeSourceCode, sourceCode, answer) =>
+    _myCheckArgumentsTest(Only.test, aTypeSourceCode, sourceCode, answer)
+}
+
+myCheckArgumentsTest("number=>number=>number", "[1,2]", "Ok")

packages/squiggle-lang/__tests__/Reducer/Reducer_Type/Reducer_Type_TypeChecker_test.res

@@ -0,0 +1,78 @@
+module Expression = Reducer_Expression
+module ExpressionT = Reducer_Expression_T
+module ErrorValue = Reducer_ErrorValue
+module InternalExpressionValue = ReducerInterface_InternalExpressionValue
+module Module = Reducer_Module
+module T = Reducer_Type_T
+module TypeChecker = Reducer_Type_TypeChecker
+
+open Jest
+open Expect
+
+// In development, you are expected to use TypeChecker.isTypeOf(aTypeSourceCode, result, reducerFn).
+// isTypeOfSourceCode is written to use strings instead of expression values.
+
+let isTypeOfSourceCode = (aTypeSourceCode: string, sourceCode: string): result<
+  'v,
+  ErrorValue.t,
+> => {
+  let reducerFn = Expression.reduceExpression
+  let rResult =
+    Reducer.parse(sourceCode)->Belt.Result.flatMap(expr =>
+      reducerFn(expr, Module.emptyBindings, InternalExpressionValue.defaultEnvironment)
+    )
+  rResult->Belt.Result.flatMap(result => TypeChecker.isTypeOf(aTypeSourceCode, result, reducerFn))
+}
+
+let myTypeCheck = (aTypeSourceCode: string, sourceCode: string): string =>
+  switch isTypeOfSourceCode(aTypeSourceCode, sourceCode) {
+  | Ok(_) => "Ok"
+  | Error(error) => ErrorValue.errorToString(error)
+  }
+
+let myTypeCheckExpectEqual = (aTypeSourceCode, sourceCode, answer) =>
+  expect(myTypeCheck(aTypeSourceCode, sourceCode))->toEqual(answer)
+
+let _myTypeCheckTest = (test, aTypeSourceCode, sourceCode, answer) =>
+  test(aTypeSourceCode, () => myTypeCheckExpectEqual(aTypeSourceCode, sourceCode, answer))
+
+let myTypeCheckTest = (aTypeSourceCode, sourceCode, answer) =>
+  _myTypeCheckTest(test, aTypeSourceCode, sourceCode, answer)
+module MySkip = {
+  let myTypeCheckTest = (aTypeSourceCode, sourceCode, answer) =>
+    _myTypeCheckTest(Skip.test, aTypeSourceCode, sourceCode, answer)
+}
+module MyOnly = {
+  let myTypeCheckTest = (aTypeSourceCode, sourceCode, answer) =>
+    _myTypeCheckTest(Only.test, aTypeSourceCode, sourceCode, answer)
+}
+
+myTypeCheckTest("number", "1", "Ok")
+myTypeCheckTest("number", "'2'", "Expected type: number but got: '2'")
+myTypeCheckTest("string", "3", "Expected type: string but got: 3")
+myTypeCheckTest("string", "'a'", "Ok")
+myTypeCheckTest("[number]", "[1,2,3]", "Ok")
+myTypeCheckTest("[number]", "['a','a','a']", "Expected type: number but got: 'a'")
+myTypeCheckTest("[number]", "[1,'a',3]", "Expected type: number but got: 'a'")
+myTypeCheckTest("[number, string]", "[1,'a']", "Ok")
+myTypeCheckTest("[number, string]", "[1, 2]", "Expected type: string but got: 2")
+myTypeCheckTest(
+  "[number, string, string]",
+  "[1,'a']",
+  "Expected type: [number, string, string] but got: [1,'a']",
+)
+myTypeCheckTest(
+  "[number, string]",
+  "[1,'a', 3]",
+  "Expected type: [number, string] but got: [1,'a',3]",
+)
+myTypeCheckTest("{age: number, name: string}", "{age: 1, name: 'a'}", "Ok")
+myTypeCheckTest(
+  "{age: number, name: string}",
+  "{age: 1, name: 'a', job: 'IT'}",
+  "Expected type: {age: number, name: string} but got: {age: 1,job: 'IT',name: 'a'}",
+)
+myTypeCheckTest("number | string", "1", "Ok")
+myTypeCheckTest("date | string", "1", "Expected type: (date | string) but got: 1")
+myTypeCheckTest("number<-min(10)", "10", "Ok")
+myTypeCheckTest("number<-min(10)", "0", "Expected type: number<-min(10) but got: 0")

packages/squiggle-lang/src/rescript/Reducer/Reducer_Dispatch/Reducer_Dispatch_BuiltInMacros.res

@@ -144,7 +144,7 @@ let dispatchMacroCall = (
           let ifTrueBlock = eBlock(list{ifTrue})
           ExpressionWithContext.withContext(ifTrueBlock, bindings)->Ok
         }
-      | _ => REExpectedType("Boolean")->Error
+      | _ => REExpectedType("Boolean", "")->Error
       }
     )
   }

packages/squiggle-lang/src/rescript/Reducer/Reducer_ErrorValue.res

@@ -7,7 +7,7 @@ type errorValue =
   | REArrayIndexNotFound(string, int)
   | REAssignmentExpected
   | REDistributionError(DistributionTypes.error)
-  | REExpectedType(string)
+  | REExpectedType(string, string)
   | REExpressionExpected
   | REFunctionExpected(string)
   | REFunctionNotFound(string)
@@ -55,6 +55,6 @@ let errorToString = err =>
   | RESymbolNotFound(symbolName) => `${symbolName} is not defined`
   | RESyntaxError(desc, _) => `Syntax Error: ${desc}`
   | RETodo(msg) => `TODO: ${msg}`
-  | REExpectedType(typeName) => `Expected type: ${typeName}`
+  | REExpectedType(typeName, valueString) => `Expected type: ${typeName} but got: ${valueString}`
   | REUnitNotFound(unitName) => `Unit not found: ${unitName}`
   }

packages/squiggle-lang/src/rescript/Reducer/Reducer_Type/Reducer_Type_Modifiers.res

@@ -0,0 +1,53 @@
+module InternalExpressionValue = ReducerInterface_InternalExpressionValue
+module T = Reducer_Type_T
+
+let isMin = (modifierArg: InternalExpressionValue.t, aValue: InternalExpressionValue.t): bool => {
+  let pair = (modifierArg, aValue)
+  switch pair {
+  | (IEvNumber(a), IEvNumber(b)) => a <= b
+  | _ => false
+  }
+}
+
+let isMax = (modifierArg: InternalExpressionValue.t, aValue: InternalExpressionValue.t): bool => {
+  let pair = (modifierArg, aValue)
+  switch pair {
+  | (IEvNumber(a), IEvNumber(b)) => a >= b
+  | _ => false
+  }
+}
+
+let isMemberOf = (
+  modifierArg: InternalExpressionValue.t,
+  aValue: InternalExpressionValue.t,
+): bool => {
+  let pair = (modifierArg, aValue)
+  switch pair {
+  | (ievA, IEvArray(b)) => Js.Array2.includes(b, ievA)
+  | _ => false
+  }
+}
+
+let checkModifier = (
+  key: string,
+  modifierArg: InternalExpressionValue.t,
+  aValue: InternalExpressionValue.t,
+): bool =>
+  switch key {
+  | "min" => isMin(modifierArg, aValue)
+  | "max" => isMax(modifierArg, aValue)
+  | "isMemberOf" => isMemberOf(modifierArg, aValue)
+  | _ => false
+  }
+
+let checkModifiers = (
+  modifiers: Belt.Map.String.t<InternalExpressionValue.t>,
+  aValue: InternalExpressionValue.t,
+): bool => {
+  modifiers->Belt.Map.String.reduce(true, (acc, key, modifierArg) =>
+    switch acc {
+    | true => checkModifier(key, modifierArg, aValue)
+    | _ => acc
+    }
+  )
+}

packages/squiggle-lang/src/rescript/Reducer/Reducer_Type/Reducer_Type_T.res

@@ -11,6 +11,7 @@ type rec iType =
   | ItTypeRecord({properties: Belt.Map.String.t<iType>})
 
 type t = iType
+type typeErrorValue = TypeMismatch(t, InternalExpressionValue.t)
 
 let rec toString = (t: t): string => {
   switch t {

packages/squiggle-lang/src/rescript/Reducer/Reducer_Type/Reducer_Type_TypeChecker.res

@@ -1,71 +1,168 @@
-// module ErrorValue = Reducer_ErrorValue
+module ExpressionT = Reducer_Expression_T
 module InternalExpressionValue = ReducerInterface_InternalExpressionValue
 module T = Reducer_Type_T
-// module TypeBuilder = Reducer_Type_TypeBuilder
+module TypeModifiers = Reducer_Type_Modifiers
 open InternalExpressionValue
 
-type typeErrorValue = TypeError(T.t, InternalExpressionValue.t)
+let rec isITypeOf = (anIType: T.iType, aValue): result<bool, T.typeErrorValue> => {
-
-let rec isOfResolvedIType = (anIType: T.iType, aValue): result<bool, typeErrorValue> => {
   let caseTypeIdentifier = (anUpperTypeName, aValue) => {
     let aTypeName = anUpperTypeName->Js.String2.toLowerCase
     let valueTypeName = aValue->valueToValueType->valueTypeToString->Js.String2.toLowerCase
-    switch aTypeName === valueTypeName {
+    switch aTypeName == valueTypeName {
     | true => Ok(true)
-    | false => TypeError(anIType, aValue)->Error
+    | false => T.TypeMismatch(anIType, aValue)->Error
     }
   }
 
-  let _caseRecord = (anIType, evValue, propertyMap, map) => {
+  let caseRecord = (anIType, propertyMap: Belt.Map.String.t<T.iType>, evValue) =>
-    Belt.Map.String.reduce(propertyMap, Ok(true), (acc, property, propertyType) => {
+    switch evValue {
+    | IEvRecord(aRecord) =>
+      if (
+        Js.Array2.length(propertyMap->Belt.Map.String.keysToArray) ==
+          Js.Array2.length(aRecord->Belt.Map.String.keysToArray)
+      ) {
+        Belt.Map.String.reduce(propertyMap, Ok(true), (acc, property, propertyType) => {
+          Belt.Result.flatMap(acc, _ =>
+            switch Belt.Map.String.get(aRecord, property) {
+            | Some(propertyValue) => isITypeOf(propertyType, propertyValue)
+            | None => T.TypeMismatch(anIType, evValue)->Error
+            }
+          )
+        })
+      } else {
+        T.TypeMismatch(anIType, evValue)->Error
+      }
+
+    | _ => T.TypeMismatch(anIType, evValue)->Error
+    }
+
+  let caseArray = (anIType, elementType, evValue) =>
+    switch evValue {
+    | IEvArray(anArray) =>
+      Belt.Array.reduce(anArray, Ok(true), (acc, element) =>
+        Belt.Result.flatMap(acc, _ =>
+          switch isITypeOf(elementType, element) {
+          | Ok(_) => Ok(true)
+          | Error(error) => error->Error
+          }
+        )
+      )
+    | _ => T.TypeMismatch(anIType, evValue)->Error
+    }
+
+  let caseTuple = (anIType, elementTypes, evValue) =>
+    switch evValue {
+    | IEvArray(anArray) =>
+      if Js.Array2.length(elementTypes) == Js.Array2.length(anArray) {
+        let zipped = Belt.Array.zip(elementTypes, anArray)
+        Belt.Array.reduce(zipped, Ok(true), (acc, (elementType, element)) =>
+          switch acc {
+          | Ok(_) =>
+            switch isITypeOf(elementType, element) {
+            | Ok(_) => acc
+            | Error(error) => Error(error)
+            }
+          | _ => acc
+          }
+        )
+      } else {
+        T.TypeMismatch(anIType, evValue)->Error
+      }
+    | _ => T.TypeMismatch(anIType, evValue)->Error
+    }
+
+  let caseOr = (anIType, anITypeArray, evValue) =>
+    switch Belt.Array.reduce(anITypeArray, Ok(false), (acc, anIType) =>
       Belt.Result.flatMap(acc, _ =>
-        switch Belt.Map.String.get(map, property) {
+        switch acc {
-        | Some(propertyValue) => isOfResolvedIType(propertyType, propertyValue)
+        | Ok(false) =>
-        | None => TypeError(anIType, evValue)->Error
+          switch isITypeOf(anIType, evValue) {
+          | Ok(_) => Ok(true)
+          | Error(_) => acc
+          }
+        | _ => acc
         }
       )
-    })
+    ) {
-  }
+    | Ok(true) => Ok(true)
-  let _caseArray = (anIType, evValue, elementType, anArray) => {
+    | Ok(false) => T.TypeMismatch(anIType, evValue)->Error
-    Belt.Array.reduceWithIndex(anArray, Ok(true), (acc, element, _index) => {
+    | Error(error) => Error(error)
-      switch isOfResolvedIType(elementType, element) {
+    }
-      | Ok(_) => acc
+
-      | Error(_) => TypeError(anIType, evValue)->Error
+  let caseModifiedType = (
+    anIType: T.iType,
+    modifiedType: T.iType,
+    modifiers: Belt.Map.String.t<InternalExpressionValue.t>,
+    aValue: InternalExpressionValue.t,
+  ) => {
+    isITypeOf(modifiedType, aValue)->Belt.Result.flatMap(_result => {
+      if TypeModifiers.checkModifiers(modifiers, aValue) {
+        Ok(true)
+      } else {
+        T.TypeMismatch(anIType, aValue)->Error
       }
     })
   }
 
   switch anIType {
   | ItTypeIdentifier(name) => caseTypeIdentifier(name, aValue)
-  // TODO: Work in progress. Code is commented to make an a release of other features
+  | ItModifiedType({modifiedType, modifiers}) =>
-  // | ItModifiedType({modifiedType: anIType}) => raise(Reducer_Exception.ImpossibleException)
+    caseModifiedType(anIType, modifiedType, modifiers, aValue) //{modifiedType: iType, modifiers: Belt.Map.String.t<InternalExpressionValue.t>}
-  // | ItTypeOr({typeOr: anITypeArray}) => raise(Reducer_Exception.ImpossibleException)
+  | ItTypeOr({typeOr}) => caseOr(anIType, typeOr, aValue)
-  // | ItTypeFunction({inputs: anITypeArray, output: anIType}) =>
+  | ItTypeFunction(_) =>
-  //   raise(Reducer_Exception.ImpossibleException)
+    raise(
-  // | ItTypeArray({element: anIType}) => raise(Reducer_Exception.ImpossibleException)
+      Reducer_Exception.ImpossibleException(
-  // | ItTypeTuple({elements: anITypeArray}) => raise(Reducer_Exception.ImpossibleException)
+        "Reducer_TypeChecker-functions are without a type at the moment",
-  // | ItTypeRecord({properties: anITypeMap}) => raise(Reducer_Exception.ImpossibleException)
+      ),
-  | _ => raise(Reducer_Exception.ImpossibleException("Reducer_TypeChecker-isOfResolvedIType"))
+    )
+  | ItTypeArray({element}) => caseArray(anIType, element, aValue)
+  | ItTypeTuple({elements}) => caseTuple(anIType, elements, aValue)
+  | ItTypeRecord({properties}) => caseRecord(anIType, properties, aValue)
   }
 }
 
-// let isOfResolvedType = (aType: InternalExpressionValue.t, aValue): result<bool, typeErrorValue> =>
+let isTypeOf = (
-//   aType->T.fromIEvValue->isOfResolvedIType(aValue)
+  typeExpressionSourceCode: string,
+  aValue: InternalExpressionValue.t,
+  reducerFn: ExpressionT.reducerFn,
+): result<InternalExpressionValue.t, ErrorValue.t> => {
+  switch typeExpressionSourceCode->Reducer_Type_Compile.fromTypeExpression(reducerFn) {
+  | Ok(anIType) =>
+    switch isITypeOf(anIType, aValue) {
+    | Ok(_) => Ok(aValue)
+    | Error(T.TypeMismatch(anIType, evValue)) =>
+      Error(
+        ErrorValue.REExpectedType(anIType->T.toString, evValue->InternalExpressionValue.toString),
+      )
+    }
+  | Error(error) => Error(error) // Directly propagating - err => err - causes type mismatch
+  }
+}
 
-// TODO: Work in progress. Code is commented to make an a release of other features
+let checkITypeArguments = (anIType: T.iType, args: array<InternalExpressionValue.t>): result<
-// let checkArguments = (
+  bool,
-//   evFunctionType: InternalExpressionValue.t,
+  T.typeErrorValue,
-//   args: array<InternalExpressionValue.t>,
+> => {
-// ) => {
+  switch anIType {
-//   let functionType = switch evFunctionType {
+  | T.ItTypeFunction({inputs}) => isITypeOf(T.ItTypeTuple({elements: inputs}), args->IEvArray)
-//   | IEvRecord(functionType) => functionType
+  | _ => T.TypeMismatch(anIType, args->IEvArray)->Error
-//   | _ => raise(Reducer_Exception.ImpossibleException)
+  }
-//   }
+}
-//   let evInputs = functionType->Belt.Map.String.getWithDefault("inputs", []->IEvArray)
+
-//   let inputs = switch evInputs {
+let checkArguments = (
-//   | IEvArray(inputs) => inputs
+  typeExpressionSourceCode: string,
-//   | _ => raise(Reducer_Exception.ImpossibleException)
+  args: array<InternalExpressionValue.t>,
-//   }
+  reducerFn: ExpressionT.reducerFn,
-//   let rTupleType = TypeBuilder.typeTuple(inputs)
+): result<InternalExpressionValue.t, ErrorValue.t> => {
-//   Belt.Result.flatMap(rTupleType, tupleType => isOfResolvedType(tupleType, args->IEvArray))
+  switch typeExpressionSourceCode->Reducer_Type_Compile.fromTypeExpression(reducerFn) {
-// }
+  | Ok(anIType) =>
+    switch checkITypeArguments(anIType, args) {
+    | Ok(_) => Ok(args->IEvArray)
+    | Error(T.TypeMismatch(anIType, evValue)) =>
+      Error(
+        ErrorValue.REExpectedType(anIType->T.toString, evValue->InternalExpressionValue.toString),
+      )
+    }
+  | Error(error) => Error(error) // Directly propagating - err => err - causes type mismatch
+  }
+}