From 5d4032671d15456ba8f7eacea332fa9168eec13d Mon Sep 17 00:00:00 2001 From: David Chambers Date: Sun, 12 Jun 2016 17:12:36 -0700 Subject: [PATCH] define $.Function and $.UnaryTypeVariable --- README.md | 238 +++++--- index.js | 1522 +++++++++++++++++++++++++++---------------------- test/index.js | 472 ++++++++++++--- 3 files changed, 1377 insertions(+), 855 deletions(-) diff --git a/README.md b/README.md index bb7b500..e7935fd 100644 --- a/README.md +++ b/README.md @@ -23,7 +23,7 @@ const Integer = ...; // NonZeroInteger :: Type const NonZeroInteger = ...; -// env :: [Type] +// env :: Array Type const env = $.env.concat([Integer, NonZeroInteger]); ``` @@ -165,6 +165,14 @@ $.Any :: Type Type comprising every JavaScript value. +#### `AnyFunction` + +```haskell +$.AnyFunction :: Type +``` + +Type comprising every Function value. + #### `Arguments` ```haskell @@ -218,10 +226,15 @@ Type comprising every [`ValidNumber`](#validnumber) value except `Infinity` and #### `Function` ```haskell -$.Function :: Type +$.Function :: Array Type -> Type ``` -Type comprising every Function value. +Constructor for Function types. + +Examples: + + - `$.Function([$.Date, $.String])` represents the `Date -> String` type; and + - `$.Function([a, b, a])` represents the `(a, b) -> a` type. #### `Integer` @@ -425,12 +438,12 @@ counterpart). `$.env` is a list of [types](#types): + - [`$.AnyFunction`](#anyfunction) - [`$.Arguments`](#arguments) - [`$.Array`](#array) - [`$.Boolean`](#boolean) - [`$.Date`](#date) - [`$.Error`](#error) - - [`$.Function`](#function) - [`$.Null`](#null) - [`$.Number`](#number) - [`$.Object`](#object) @@ -474,63 +487,6 @@ bodies of incoming POST requests against these types. sanctuary-def provides several functions for defining types. -#### `TypeVariable` - -Polymorphism is powerful. Not being able to define a function for all types -would be very limiting indeed: one couldn't even define the identity function! - -```haskell -TypeVariable :: String -> Type -``` - -Before defining a polymorphic function one must define one or more type -variables: - -```javascript -const a = $.TypeVariable('a'); -const b = $.TypeVariable('b'); - -// id :: a -> a -const id = def('id', {}, [a, a], x => x); - -id(42); -// => 42 - -id(null); -// => null -``` - -The same type variable may be used in multiple positions, creating a -constraint: - -```javascript -// cmp :: a -> a -> Number -const cmp = -def('cmp', {}, [a, a, $.Number], (x, y) => x < y ? -1 : x > y ? 1 : 0); - -cmp(42, 42); -// => 0 - -cmp('a', 'z'); -// => -1 - -cmp('z', 'a'); -// => 1 - -cmp(0, '1'); -// ! TypeError: Type-variable constraint violation -// -// cmp :: a -> a -> Number -// ^ ^ -// 1 2 -// -// 1) 0 :: Number -// -// 2) "1" :: String -// -// Since there is no type of which all the above values are members, the type-variable constraint has been violated. -``` - #### `NullaryType` `NullaryType` is used to construct types with no type variables. `$.Number` is @@ -602,7 +558,7 @@ rem(42, 0); defined via `UnaryType`. ```javascript -// sum :: [Number] -> Number +// sum :: Array Number -> Number const sum = def('sum', {}, [$.Array($.Number), $.Number], xs => xs.reduce((x, y) => x + y, 0)); @@ -629,12 +585,13 @@ To define a unary type `t a` one must provide: if (and only if) the value is a member of `t x` for some type `x`; - a function which takes any value of type `t a` and returns an array - of the values of type `a` contained in the `t` (exposed as `t._1`); and + of the values of type `a` contained in the `t` (exposed as + `t.types.$1.extractor`); and - - the type of `a` (exposed as `t.$1`). + - the type of `a` (exposed as `t.types.$1.type`). ```haskell -UnaryType :: String -> (Any -> Boolean) -> (t a -> [a]) -> Type -> Type +UnaryType :: String -> (Any -> Boolean) -> (t a -> Array a) -> Type -> Type ``` For example: @@ -650,18 +607,18 @@ const Maybe = $.UnaryType( // Nothing :: Maybe a const Nothing = { '@@type': 'my-package/Maybe', - 'isJust': false, - 'isNothing': true, - 'toString': () => 'Nothing', + isJust: false, + isNothing: true, + toString: () => 'Nothing', }; // Just :: a -> Maybe a const Just = x => ({ '@@type': 'my-package/Maybe', - 'isJust': true, - 'isNothing': false, - 'toString': () => 'Just(' + JSON.stringify(x) + ')', - 'value': x, + isJust: true, + isNothing: false, + toString: () => 'Just(' + JSON.stringify(x) + ')', + value: x, }); // fromMaybe :: a -> Maybe a -> a @@ -701,17 +658,19 @@ To define a binary type `t a b` one must provide: `x` and `y`; - a function which takes any value of type `t a b` and returns an array - of the values of type `a` contained in the `t` (exposed as `t._1`); + of the values of type `a` contained in the `t` (exposed as + `t.types.$1.extractor`); - a function which takes any value of type `t a b` and returns an array - of the values of type `b` contained in the `t` (exposed as `t._2`); + of the values of type `b` contained in the `t` (exposed as + `t.types.$2.extractor`); - - the type of `a` (exposed as `t.$1`); and + - the type of `a` (exposed as `t.types.$1.type`); and - - the type of `b` (exposed as `t.$2`). + - the type of `b` (exposed as `t.types.$2.type`). ```haskell -BinaryType :: String -> (Any -> Boolean) -> (t a b -> [a]) -> (t a b -> [b]) -> Type -> Type -> Type +BinaryType :: String -> (Any -> Boolean) -> (t a b -> Array a) -> (t a b -> Array b) -> Type -> Type -> Type ``` For example: @@ -730,8 +689,8 @@ const Pair = def('Pair', {}, [a, b, $Pair(a, b)], (x, y) => ({ '0': x, '1': y, '@@type': 'my-package/Pair', - 'length': 2, - 'toString': () => 'Pair(' + JSON.stringify(x) + ', ' + JSON.stringify(y) + ')', + length: 2, + toString: () => 'Pair(' + JSON.stringify(x) + ', ' + JSON.stringify(y) + ')', })); // Rank :: Type @@ -779,7 +738,7 @@ To define an enumerated type one must provide: - an array of values with distinct [`R.toString`][9] representations. ```haskell -EnumType :: [Any] -> Type +EnumType :: Array Any -> Type ``` For example: @@ -827,7 +786,7 @@ To define a record type one must provide: - an object mapping field name to type. ```haskell -RecordType :: {Type} -> Type +RecordType :: StrMap Type -> Type ``` For example: @@ -851,12 +810,12 @@ dist({x: 0, y: 0}, {x: NaN, y: NaN}); // ! TypeError: Invalid value // // dist :: { x :: FiniteNumber, y :: FiniteNumber } -> { x :: FiniteNumber, y :: FiniteNumber } -> FiniteNumber -// ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -// 1 +// ^^^^^^^^^^^^ +// 1 // -// 1) {"x": NaN, "y": NaN} :: Object, StrMap Number +// 1) NaN :: Number // -// The value at position 1 is not a member of ‘{ x :: FiniteNumber, y :: FiniteNumber }’. +// The value at position 1 is not a member of ‘FiniteNumber’. dist(0); // ! TypeError: Invalid value @@ -870,6 +829,115 @@ dist(0); // The value at position 1 is not a member of ‘{ x :: FiniteNumber, y :: FiniteNumber }’. ``` +#### `TypeVariable` + +Polymorphism is powerful. Not being able to define a function for all types +would be very limiting indeed: one couldn't even define the identity function! + +```haskell +TypeVariable :: String -> Type +``` + +Before defining a polymorphic function one must define one or more type +variables: + +```javascript +const a = $.TypeVariable('a'); +const b = $.TypeVariable('b'); + +// id :: a -> a +const id = def('id', {}, [a, a], x => x); + +id(42); +// => 42 + +id(null); +// => null +``` + +The same type variable may be used in multiple positions, creating a +constraint: + +```javascript +// cmp :: a -> a -> Number +const cmp = +def('cmp', {}, [a, a, $.Number], (x, y) => x < y ? -1 : x > y ? 1 : 0); + +cmp(42, 42); +// => 0 + +cmp('a', 'z'); +// => -1 + +cmp('z', 'a'); +// => 1 + +cmp(0, '1'); +// ! TypeError: Type-variable constraint violation +// +// cmp :: a -> a -> Number +// ^ ^ +// 1 2 +// +// 1) 0 :: Number +// +// 2) "1" :: String +// +// Since there is no type of which all the above values are members, the type-variable constraint has been violated. +``` + +#### `UnaryTypeVariable` + +As its name suggests, `UnaryTypeVariable` combines [`UnaryType`](#unarytype) +and [`TypeVariable`](#typevariable). + +To define a unary type variable `t a` one must provide: + + - a name (conventionally matching `^[a-z]$`); and + + - the type of `a` (exposed as `t.types.$1.type`). + +```haskell +UnaryTypeVariable :: String -> Type -> Type +``` + +Consider the type of a generalized `map`: + +```haskell +map :: Functor f => (a -> b) -> f a -> f b +``` + +`f` is a unary type variable. With two (regular) type variables, one unary +type variable, and one [type class](#type-classes) it's possible to define +a fully polymorphic `map` function: + +```javascript +const a = $.TypeVariable('a'); +const b = $.TypeVariable('b'); +const f = $.UnaryTypeVariable('f'); + +// Functor :: TypeClass +const Functor = ...; + +// map :: Functor f => (a -> b) -> f a -> f b +const map = +def('map', + {f: [Functor]}, + [$.Function([a, b]), f(a), f(b)], + (fn, functor) => functor.map(fn)); +``` + +Whereas a regular type variable is fully resolved (`a` might become +`Array (Array String)`, for example), a unary type variable defers to +its type argument, which may itself be a type variable. The type argument +corresponds to the type argument of a unary type or the *second* type +argument of a binary type. The second type argument of `Map k v`, for +example, is `v`. One could replace `Functor => f` with `Map k` or with +`Map Integer`, but not with `Map`. + +This shallow inspection makes it possible to constrain a value's "outer" +and "inner" types independently. + ### Type classes `concatS`, defined earlier, is a function which concatenates two strings. diff --git a/index.js b/index.js index 7eef60a..eb0e2f1 100644 --- a/index.js +++ b/index.js @@ -20,10 +20,10 @@ var MAX_SAFE_INTEGER = Math.pow(2, 53) - 1; var MIN_SAFE_INTEGER = -MAX_SAFE_INTEGER; - var LEFT_SINGLE_QUOTATION_MARK = '\u2018'; - var RIGHT_SINGLE_QUOTATION_MARK = '\u2019'; - + var forEach = Array.prototype.forEach; + var map = Array.prototype.map; var push = Array.prototype.push; + var slice = Array.prototype.slice; var hasOwnProperty = Object.prototype.hasOwnProperty; var toString = Object.prototype.toString; @@ -54,83 +54,42 @@ // K :: a -> b -> a var K = function(x) { return function(y) { return x; }; }; - // all :: ([a], (a -> Boolean)) -> Boolean - var all = function(xs, pred) { - for (var idx = 0; idx < xs.length; idx += 1) { - if (!pred(xs[idx])) return false; - } - return true; - }; - // always :: a -> (-> a) var always = function(x) { return function() { return x; }; }; - // assoc :: (String, a, StrMap a) -> StrMap a - var assoc = function(key, value, strMap) { - var result = {}; - for (var k in strMap) { - result[k] = strMap[k]; - } - result[key] = value; - return result; - }; + // always2 :: a -> (b, c) -> a + var always2 = function(x) { return function(y, z) { return x; }; }; - // chain :: ([a], (a -> [b])) -> [b] + // chain :: (Array a, a -> Array b) -> Array b var chain = function(xs, f) { var result = []; - for (var idx = 0; idx < xs.length; idx += 1) { - push.apply(result, f(xs[idx])); - } + xs.forEach(function(x) { push.apply(result, f(x)); }); return result; }; - // filter :: ([a], (a -> Boolean)) -> [a] - var filter = function(xs, pred) { - var result = []; - for (var idx = 0; idx < xs.length; idx += 1) { - if (pred(xs[idx])) { - result.push(xs[idx]); - } - } - return result; - }; - - // has :: (String, Object) -> Boolean - var has = function(key, obj) { return hasOwnProperty.call(obj, key); }; - // id :: a -> a var id = function(x) { return x; }; - // isEmpty :: [a] -> Boolean + // isEmpty :: Array a -> Boolean var isEmpty = function(xs) { return xs.length === 0; }; - // keys :: Object -> [String] - var keys = function(obj) { - var result = []; - for (var key in obj) if (has(key, obj)) result.push(key); - return result.sort(); + // isPrefix :: Array a -> Array a -> Boolean + var isPrefix = function(candidate) { + return function(xs) { + if (candidate.length > xs.length) return false; + for (var idx = 0; idx < candidate.length; idx += 1) { + if (candidate[idx] !== xs[idx]) return false; + } + return true; + }; }; - // last :: [a] -> a + // last :: Array a -> a var last = function(xs) { return xs[xs.length - 1]; }; - // map :: ([a], (a -> b)) -> [b] - var map = function(xs, f) { - var result = []; - for (var idx = 0; idx < xs.length; idx += 1) result.push(f(xs[idx])); - return result; - }; - - // or :: ([a], [a]) -> [a] + // or :: (Array a, Array a) -> Array a var or = function(xs, ys) { return isEmpty(xs) ? ys : xs; }; - // prefix :: String -> String -> String - var prefix = function(x) { - return function(y) { - return x + y; - }; - }; - // quote :: String -> String var quote = function(s) { var escaped = s @@ -147,20 +106,13 @@ return '"' + escaped.replace(/"/g, '\\"') + '"'; }; - // range :: (Number, Number) -> [Number] + // range :: (Number, Number) -> Array Number var range = function(start, stop) { var result = []; for (var n = start; n < stop; n += 1) result.push(n); return result; }; - // reduce :: ([a], b, (b, a) -> b) -> b - var reduce = function(xs, y, f) { - var result = y; - for (var idx = 0; idx < xs.length; idx += 1) result = f(result, xs[idx]); - return result; - }; - // strRepeat :: (String, Integer) -> String var strRepeat = function(s, times) { return Array(times + 1).join(s); @@ -176,9 +128,9 @@ // _ :: String -> String var _ = r(' '); - // toPairs :: StrMap a -> [Pair String a] - var toPairs = function(obj) { - return map(keys(obj), function(k) { return [k, obj[k]]; }); + // stripOutermostParens :: String -> String + var stripOutermostParens = function(s) { + return s.slice('('.length, -')'.length); }; // trimTrailingSpaces :: String -> String @@ -186,11 +138,9 @@ return s.replace(/[ ]+$/gm, ''); }; - // unlines :: [String] -> String - var unlines = function(lines) { - var s = ''; - for (var idx = 0; idx < lines.length; idx += 1) s += lines[idx] + '\n'; - return s; + // unless :: (Boolean, (a -> a), a) -> a + var unless = function(bool, f, x) { + return bool ? x : f(x); }; // when :: (Boolean, (a -> a), a) -> a @@ -198,14 +148,21 @@ return bool ? f(x) : x; }; + // wrap :: String -> String -> String -> String + var wrap = function(prefix) { + return function(suffix) { + return function(s) { + return prefix + s + suffix; + }; + }; + }; + + // q :: String -> String + var q = wrap('\u2018')('\u2019'); + // stripNamespace :: String -> String var stripNamespace = function(s) { return s.slice(s.indexOf('/') + 1); }; - // typeOf :: a -> String - var typeOf = function(x) { - return toString.call(x).slice('[object '.length, -']'.length); - }; - var _show = function show(x, seen) { var recur = function(y) { var xs = seen.concat([x]); @@ -219,41 +176,43 @@ }; }; - switch (typeOf(x)) { - case 'Arguments': + switch (toString.call(x)) { + case '[object Arguments]': return '(function() { return arguments; }(' + - map(x, recur).join(', ') + '))'; - case 'Array': - var reprs = map(x, recur).concat(chain(keys(x), function(k) { - return /^\d+$/.test(k) ? [] : [formatKeyVal(x)(k)]; - })); - return '[' + reprs.join(', ') + ']'; - case 'Boolean': + map.call(x, recur).join(', ') + '))'; + case '[object Array]': + var $reprs = x.map(recur); + Object.keys(x).sort().forEach(function(k) { + if (!/^\d+$/.test(k)) $reprs.push(formatKeyVal(x)(k)); + }); + return '[' + $reprs.join(', ') + ']'; + case '[object Boolean]': return typeof x === 'object' ? 'new Boolean(' + recur(x.valueOf()) + ')' : x.toString(); - case 'Date': + case '[object Date]': return 'new Date(' + (isNaN(x.valueOf()) ? recur(NaN) : quote(x.toISOString())) + ')'; - case 'Null': + case '[object Null]': return 'null'; - case 'Number': + case '[object Number]': return typeof x === 'object' ? 'new Number(' + recur(x.valueOf()) + ')' : 1 / x === -Infinity ? '-0' : x.toString(10); - case 'String': + case '[object String]': return typeof x === 'object' ? 'new String(' + recur(x.valueOf()) + ')' : quote(x); - case 'Undefined': + case '[object Undefined]': return 'undefined'; default: if (typeof x.toString === 'function') { var repr = x.toString(); if (repr !== '[object Object]') return repr; } - return '{' + map(keys(x), formatKeyVal(x)).join(', ') + '}'; + var keys = Object.keys(x).sort(); + return '{' + keys.map(formatKeyVal(x)).join(', ') + '}'; } }; @@ -264,250 +223,257 @@ $.TypeClass = function(name, test) { return { '@@type': 'sanctuary-def/TypeClass', - name: name, _test: test, + name: name, toString: always(stripNamespace(name)) }; }; - // testFrom :: (a -> Result) -> a -> Boolean - var testFrom = function(validate) { - return function(x) { - return validate(x).isRight; + // createType :: ... -> Type + var createType = function( + typeName, // :: String + name, // :: String + format, // :: (String -> String, String -> String -> String) -> String + test, // :: Any -> Boolean + keys, // :: Array String + types // :: StrMap { extractor :: a -> Array b, type :: Type } + ) { + var validate = function(x) { + if (!test(x)) return Left({value: x, propPath: []}); + for (var idx = 0; idx < keys.length; idx += 1) { + var k = keys[idx]; + var t = types[k]; + for (var idx2 = 0, ys = t.extractor(x); idx2 < ys.length; idx2 += 1) { + var result = t.type.validate(ys[idx2]); + if (result.isLeft) { + var value = result.value.value; + var propPath = [k].concat(result.value.propPath); + return Left({value: value, propPath: propPath}); + } + } + } + return Right(x); + }; + + return { + '@@type': 'sanctuary-def/Type', + _test: function(x) { return validate(x).isRight; }, + format: format, + keys: keys, + name: name, + toString: always(format(id, K(id))), + type: typeName, + types: types, + validate: validate }; }; + var BINARY = 'BINARY'; + var ENUM = 'ENUM'; + var FUNCTION = 'FUNCTION'; + var INCONSISTENT = 'INCONSISTENT'; + var NULLARY = 'NULLARY'; + var RECORD = 'RECORD'; + var UNARY = 'UNARY'; + var UNKNOWN = 'UNKNOWN'; + var VARIABLE = 'VARIABLE'; + // Unknown :: Type - var Unknown = { - '@@type': 'sanctuary-def/Type', - type: 'UNKNOWN', - validate: Right, - _test: K(true), - toString: always('???') - }; + var Unknown = $.Unknown = + createType(UNKNOWN, '', always2('???'), K(true), [], {}); // Inconsistent :: Type - var Inconsistent = { - '@@type': 'sanctuary-def/Type', - type: 'INCONSISTENT', - toString: always('???') - }; + var Inconsistent = + createType(INCONSISTENT, '', always2('???'), K(false), [], {}); // TypeVariable :: String -> Type $.TypeVariable = function(name) { - return { - '@@type': 'sanctuary-def/Type', - type: 'VARIABLE', - name: name, - validate: Right, - _test: K(true), - toString: always(name) + return createType(VARIABLE, name, always2(name), K(true), [], {}); + }; + + // UnaryTypeVariable :: String -> Type -> Type + $.UnaryTypeVariable = function(name) { + return function($1) { + var format = function(outer, inner) { + return outer('(' + name + ' ') + inner('$1')(String($1)) + outer(')'); + }; + var types = {$1: {extractor: K([]), type: $1}}; + return createType(VARIABLE, name, format, K(true), ['$1'], types); }; }; // NullaryType :: (String, (x -> Boolean)) -> Type var NullaryType = $.NullaryType = function(name, test) { - var t = { - '@@type': 'sanctuary-def/Type', - type: 'NULLARY', - name: name, - validate: function(x) { - return test(x) ? Right(x) - : Left({value: x, typePath: [t], propPath: []}); - }, - _test: test, - toString: always(stripNamespace(name)) + var format = function(outer, inner) { + return outer(stripNamespace(name)); }; - return t; + return createType(NULLARY, name, format, test, [], {}); }; - // UnaryType :: (String, (x -> Boolean), (t a -> [a])) -> Type -> Type + // UnaryType :: (String, (x -> Boolean), (t a -> Array a)) -> Type -> Type var UnaryType = $.UnaryType = function(name, test, _1) { return function($1) { - var format = function(f, f$1) { - return f('(' + stripNamespace(name) + ' ') + f$1(String($1)) + f(')'); + var format = function(outer, inner) { + return outer('(' + stripNamespace(name) + ' ') + + inner('$1')(String($1)) + outer(')'); }; - var validate = function(x) { - if (!test(x)) { - return Left({value: x, typePath: [t], propPath: []}); - } - for (var idx = 0, xs = _1(x); idx < xs.length; idx += 1) { - var result = $1.validate(xs[idx]); - if (result.isLeft) { - return Left({value: result.value.value, - typePath: [t].concat(result.value.typePath), - propPath: ['$1'].concat(result.value.propPath)}); - } - } - return Right(x); - }; - var t = { - '@@type': 'sanctuary-def/Type', - type: 'UNARY', - name: name, - validate: validate, - _test: testFrom(validate), - format: format, - toString: always(format(id, id)), - _1: _1, - $1: $1 - }; - return t; + var types = {$1: {extractor: _1, type: $1}}; + return createType(UNARY, name, format, test, ['$1'], types); }; }; // UnaryType.from :: Type -> (Type -> Type) UnaryType.from = function(t) { - return UnaryType(t.name, t._test, t._1); + return UnaryType(t.name, t._test, t.types.$1.extractor); }; - // BinaryType :: (String, (x -> Boolean), (t a b -> [a]), (t a b -> [b])) -> - // (Type, Type) -> Type + // BinaryType :: + // (String, (x -> Boolean), (t a b -> Array a), (t a b -> Array b)) -> + // (Type, Type) -> Type var BinaryType = $.BinaryType = function(name, test, _1, _2) { return function($1, $2) { - var format = function(f, f$1, f$2) { - return f('(' + stripNamespace(name) + ' ') + - f$1(String($1)) + f(' ') + f$2(String($2)) + f(')'); + var format = function(outer, inner) { + return outer('(' + stripNamespace(name) + ' ') + + inner('$1')(String($1)) + outer(' ') + + inner('$2')(String($2)) + outer(')'); }; - var validate = function(x) { - if (!test(x)) { - return Left({value: x, typePath: [t], propPath: []}); - } - for (var n = 1; n <= 2; n += 1) { - var _ = '_' + String(n); - var $ = '$' + String(n); - for (var idx = 0, xs = t[_](x); idx < xs.length; idx += 1) { - var result = t[$].validate(xs[idx]); - if (result.isLeft) { - return Left({value: result.value.value, - typePath: [t].concat(result.value.typePath), - propPath: [$].concat(result.value.propPath)}); - } - } - } - return Right(x); - }; - var t = { - '@@type': 'sanctuary-def/Type', - type: 'BINARY', - name: name, - validate: validate, - _test: testFrom(validate), - format: format, - toString: always(format(id, id, id)), - _1: _1, - _2: _2, - $1: $1, - $2: $2 - }; - return t; + var types = {$1: {extractor: _1, type: $1}, + $2: {extractor: _2, type: $2}}; + return createType(BINARY, name, format, test, ['$1', '$2'], types); }; }; - // BinaryType.from :: Type -> ((Type, Type) -> Type) - BinaryType.from = function(t) { - return BinaryType(t.name, t._test, t._1, t._2); - }; - - // BinaryType.xprod :: (Type, [Type], [Type]) -> [Type] + // BinaryType.xprod :: (Type, Array Type, Array Type) -> Array Type BinaryType.xprod = function(t, $1s, $2s) { - var specialize = BinaryType.from(t); - return chain($1s, function($1) { - return map($2s, function($2) { - return specialize($1, $2); + var specialize = BinaryType(t.name, + t._test, + t.types.$1.extractor, + t.types.$2.extractor); + var $types = []; + $1s.forEach(function($1) { + $2s.forEach(function($2) { + $types.push(specialize($1, $2)); }); }); + return $types; + }; + + // $$type :: a -> String + var $$type = function(x) { + return x != null && toString.call(x['@@type']) === '[object String]' ? + x['@@type'] : + toString.call(x).slice('[object '.length, -']'.length); + }; + + // $$typeEq :: String -> a -> Boolean + var $$typeEq = function(name) { + return function(x) { + return $$type(x) === name; + }; + }; + + // type0 :: String -> Type + var type0 = function(name) { + return NullaryType(name, $$typeEq(name)); + }; + + // type1 :: (String, (t a -> Array a)) -> Type -> Type + var type1 = function(name, _1) { + return UnaryType(name, $$typeEq(name), _1); }; - // EnumType :: [Any] -> Type + // EnumType :: Array Any -> Type var EnumType = $.EnumType = function(members) { - var types = map(members, $$type); - var reprs = map(members, show); - var validate = function(x) { + var types = members.map($$type); + var reprs = members.map(show); + + var format = function(outer, inner) { + return outer('(' + reprs.join(' | ') + ')'); + }; + + var test = function(x) { // We use `show` to perform value-based equality checks (since we // don't have access to `R.equals` and don't want to implement it). // We avoid a lot of unnecessary work by checking the type of `x` // before determining its string representation. Only if `x` is of // the same type as one or more of the `members` do we incur the // cost of determining its string representation. - return types.indexOf($$type(x)) >= 0 && reprs.indexOf(show(x)) >= 0 ? - Right(x) : - Left({value: x, typePath: [t], propPath: []}); - }; - var t = { - '@@type': 'sanctuary-def/Type', - type: 'ENUM', - validate: validate, - _test: testFrom(validate), - toString: always('(' + reprs.join(' | ') + ')') + return types.indexOf($$type(x)) >= 0 && reprs.indexOf(show(x)) >= 0; }; - return t; + + return createType(ENUM, '', format, test, [], {}); }; - // RecordType :: {Type} -> Type + // RecordType :: StrMap Type -> Type var RecordType = $.RecordType = function(fields) { - var names = keys(fields); + var keys = Object.keys(fields).sort(); - // invalidMappings :: [String] - var invalidMappings = chain(names, function(name) { - return $$type(fields[name]) === 'sanctuary-def/Type' ? - [] : - [show(name) + ': ' + show(fields[name])]; + var invalidFieldNames = keys.filter(function(k) { + return $$type(fields[k]) !== 'sanctuary-def/Type'; }); - - if (!isEmpty(invalidMappings)) { - throw new TypeError(trimTrailingSpaces(unlines([ - 'Invalid values', - '', + if (!isEmpty(invalidFieldNames)) { + throw new TypeError(trimTrailingSpaces( + 'Invalid values\n\n' + 'The argument to ‘RecordType’ must be an object ' + - 'mapping field name to type.', - '', - 'The following mappings are invalid:', - '', - map(invalidMappings, prefix(' - ')).join('\n') - ]))); + 'mapping field name to type.\n\n' + + 'The following mappings are invalid:\n\n' + + invalidFieldNames.reduce(function(s, k) { + return s + ' - ' + show(k) + ': ' + show(fields[k]) + '\n'; + }, '') + )); } - var format = function(f, kv) { - var s = f('{'); - for (var idx = 0; idx < names.length; idx += 1) { - var name = names[idx]; - s += f(idx === 0 ? ' ' : ', '); - s += f(name + ' :: ') + kv(name)(showType(fields[name])); - if (idx === names.length - 1) s += f(' '); - } - return s + f('}'); + var format = function(outer, inner) { + return wrap(outer('{'))(outer(' }'))(keys.map(function(k) { + var t = fields[k]; + return outer(' ' + k + ' :: ') + + unless(t.type === RECORD || isEmpty(t.keys), + stripOutermostParens, + inner(k)(String(t))); + }).join(outer(','))); }; - var validate = function(x) { - if (x == null) { - return Left({value: x, typePath: [t], propPath: []}); - } - for (var idx = 0; idx < names.length; idx += 1) { - var name = names[idx]; - if (!has(name, x)) { - return Left({value: x, typePath: [t], propPath: []}); - } - var result = fields[name].validate(x[name]); - if (result.isLeft) { - return Left({value: result.value.value, - typePath: [t].concat(result.value.typePath), - propPath: [name].concat(result.value.propPath)}); - } - } - return Right(x); + var test = function(x) { + return x != null && + keys.every(function(k) { return hasOwnProperty.call(x, k); }); }; - var t = { - '@@type': 'sanctuary-def/Type', - type: 'RECORD', - validate: validate, - _test: testFrom(validate), - format: format, - toString: always(format(id, K(id))), - fields: fields + var $types = {}; + keys.forEach(function(k) { + $types[k] = {extractor: function(x) { return [x[k]]; }, type: fields[k]}; + }); + + return createType(RECORD, '', format, test, keys, $types); + }; + + // AnyFunction :: Type + var AnyFunction = type0('Function'); + + // $.Function :: Array Type -> Type + $.Function = function(types) { + var format = function(outer, inner) { + var xs = types.map(function(t, idx) { + return unless(t.type === RECORD || isEmpty(t.keys), + stripOutermostParens, + inner('$' + String(idx + 1))(String(t))); + }); + var parenthesize = wrap(outer('('))(outer(')')); + return parenthesize(unless(types.length === 2, + parenthesize, + xs.slice(0, -1).join(outer(', '))) + + outer(' -> ') + + last(xs)); }; - return t; + + var $keys = []; + var $types = {}; + types.forEach(function(t, idx) { + var k = '$' + String(idx + 1); + $keys.push(k); + $types[k] = {extractor: K([]), type: t}; + }); + + return createType(FUNCTION, '', format, AnyFunction._test, $keys, $types); }; // Nullable :: Type -> Type @@ -522,58 +488,34 @@ 'sanctuary-def/StrMap', function(x) { return $.Object._test(x); }, function(strMap) { - return map(keys(strMap), function(k) { return strMap[k]; }); + return Object.keys(strMap).sort().map(function(k) { return strMap[k]; }); } ); - // $$type :: a -> String - var $$type = function(x) { - return x != null && typeOf(x['@@type']) === 'String' ? - x['@@type'] : - typeOf(x); - }; - - // $$typeEq :: String -> a -> Boolean - var $$typeEq = function(name) { - return function(x) { - return $$type(x) === name; - }; - }; - - // type0 :: String -> Type - var type0 = function(name) { - return NullaryType(name, $$typeEq(name)); - }; - - // type1 :: (String, (t a -> [a])) -> Type -> Type - var type1 = function(name, _1) { - return UnaryType(name, $$typeEq(name), _1); - }; - - // applyParameterizedTypes :: [Type] -> [Type] + // applyParameterizedTypes :: Array Type -> Array Type var applyParameterizedTypes = function(types) { - return map(types, function(x) { + return types.map(function(x) { return typeof x === 'function' ? - x.apply(null, map(range(0, x.length), K(Unknown))) : + x.apply(null, range(0, x.length).map(K(Unknown))) : x; }); }; - // defaultEnv :: [Type] + // defaultEnv :: Array Type var defaultEnv = $.env = applyParameterizedTypes([ - $.Arguments = type0('Arguments'), - $.Array = type1('Array', id), - $.Boolean = type0('Boolean'), - $.Date = type0('Date'), - $.Error = type0('Error'), - $.Function = type0('Function'), - $.Null = type0('Null'), - $.Number = type0('Number'), - $.Object = type0('Object'), - $.RegExp = type0('RegExp'), - $.StrMap = StrMap, - $.String = type0('String'), - $.Undefined = type0('Undefined') + $.AnyFunction = AnyFunction, + $.Arguments = type0('Arguments'), + $.Array = type1('Array', id), + $.Boolean = type0('Boolean'), + $.Date = type0('Date'), + $.Error = type0('Error'), + $.Null = type0('Null'), + $.Number = type0('Number'), + $.Object = type0('Object'), + $.RegExp = type0('RegExp'), + $.StrMap = StrMap, + $.String = type0('String'), + $.Undefined = type0('Undefined') ]); // Any :: Type @@ -762,13 +704,13 @@ } }; - // _determineActualTypes :: ... -> [Type] + // _determineActualTypes :: ... -> Array Type var _determineActualTypes = function recur( loose, // :: Boolean - env, // :: [Type] - types, // :: [Type] - seen, // :: [Object] - values // :: [Any] + env, // :: Array Type + types, // :: Array Type + seen, // :: Array Object + values // :: Array Any ) { var refine = function(types, value) { var seen$; @@ -785,17 +727,19 @@ return ( t.name === 'sanctuary-def/Nullable' || !t._test(value) ? [] : - t.type === 'UNARY' ? - map(recur(loose, env, env, seen$, t._1(value)), - UnaryType.from(t)) : - t.type === 'BINARY' ? - BinaryType.xprod(t, - t.$1.type === 'UNKNOWN' ? - recur(loose, env, env, seen$, t._1(value)) : - [t.$1], - t.$2.type === 'UNKNOWN' ? - recur(loose, env, env, seen$, t._2(value)) : - [t.$2]) : + t.type === UNARY ? + recur(loose, env, env, seen$, t.types.$1.extractor(value)) + .map(UnaryType.from(t)) : + t.type === BINARY ? + BinaryType.xprod( + t, + t.types.$1.type.type === UNKNOWN ? + recur(loose, env, env, seen$, t.types.$1.extractor(value)) : + [t.types.$1.type], + t.types.$2.type.type === UNKNOWN ? + recur(loose, env, env, seen$, t.types.$2.extractor(value)) : + [t.types.$2.type] + ) : // else [t] ); @@ -804,160 +748,257 @@ return isEmpty(values) ? [Unknown] : - or(reduce(values, types, refine), loose ? [Inconsistent] : []); + or(values.reduce(refine, types), loose ? [Inconsistent] : []); }; - // rejectInconsistent :: [Type] -> [Type] + // rejectInconsistent :: Array Type -> Array Type var rejectInconsistent = function(types) { - return filter(types, function(t) { - return t.type !== 'INCONSISTENT' && t.type !== 'UNKNOWN'; + return types.filter(function(t) { + return t.type !== INCONSISTENT && t.type !== UNKNOWN; }); }; - // determineActualTypesStrict :: ([Type], [Type], [Any]) -> [Type] + // determineActualTypesStrict :: + // (Array Type, Array Type, Array Any) -> Array Type var determineActualTypesStrict = function(env, types, values) { var types$ = _determineActualTypes(false, env, types, [], values); return rejectInconsistent(types$); }; - // determineActualTypesLoose :: ([Type], [Type], [Any]) -> [Type] + // determineActualTypesLoose :: + // (Array Type, Array Type, Array Any) -> Array Type var determineActualTypesLoose = function(env, types, values) { var types$ = _determineActualTypes(true, env, types, [], values); return rejectInconsistent(types$); }; - // valuesToPairs :: ([Type], [Any]) -> [Pair Any [Type]] - var valuesToPairs = function(env, values) { - return map(values, function(x) { - return [x, determineActualTypesLoose(env, env, [x])]; + // TypeVarMap = StrMap { types :: Array Type + // , valuesByPath :: StrMap (Array Any) } + // + // PropPath = Array (Number | String) + + // updateTypeVarMap :: ... -> TypeVarMap + var updateTypeVarMap = function( + env, // :: Array Type + typeVarMap, // :: TypeVarMap + typeVar, // :: Type + index, // :: Integer + propPath, // :: PropPath + values // :: Array Any + ) { + var $typeVarMap = {}; + for (var typeVarName in typeVarMap) { + var entry = typeVarMap[typeVarName]; + var $entry = {types: entry.types.slice(), valuesByPath: {}}; + for (var k in entry.valuesByPath) { + $entry.valuesByPath[k] = entry.valuesByPath[k].slice(); + } + $typeVarMap[typeVarName] = $entry; + } + if (!hasOwnProperty.call($typeVarMap, typeVar.name)) { + $typeVarMap[typeVar.name] = {types: env.slice(), valuesByPath: {}}; + } + + var key = JSON.stringify([index].concat(propPath)); + if (!hasOwnProperty.call($typeVarMap[typeVar.name].valuesByPath, key)) { + $typeVarMap[typeVar.name].valuesByPath[key] = []; + } + + values.forEach(function(value) { + $typeVarMap[typeVar.name].valuesByPath[key].push(value); + $typeVarMap[typeVar.name].types = chain( + $typeVarMap[typeVar.name].types, + function(t) { + var xs; + var invalid = !test(env, t, value); + return ( + invalid ? + [] : + typeVar.keys.length === 1 ? + [t].filter(function(t) { + return ( + !isEmpty(t.keys) && + t.type !== RECORD && + (isEmpty(xs = t.types[last(t.keys)].extractor(value)) + || !isEmpty(determineActualTypesStrict(env, env, xs))) + ); + }) : + t.type === UNARY ? + t.types.$1.type.type === UNKNOWN && + !isEmpty(xs = t.types.$1.extractor(value)) ? + determineActualTypesStrict(env, env, xs) + .map(UnaryType.from(t)) : + [t] : + t.type === BINARY ? + BinaryType.xprod( + t, + t.types.$1.type.type === UNKNOWN && + !isEmpty(xs = t.types.$1.extractor(value)) ? + determineActualTypesStrict(env, env, xs) : + [t.types.$1.type], + t.types.$2.type.type === UNKNOWN && + !isEmpty(xs = t.types.$2.extractor(value)) ? + determineActualTypesStrict(env, env, xs) : + [t.types.$2.type] + ) : + // else + [t] + ); + } + ); }); + + return $typeVarMap; + }; + + // underlineTypeVars :: ... -> String + var underlineTypeVars = function( + name, // :: String + constraints, // :: StrMap (Array TypeClass) + expTypes, // :: Array Type + valuesByPath // :: StrMap (Array Any) + ) { + // Note: Sorting these keys lexicographically is not "correct", but it + // does the right thing for indexes less than 10. + var paths = Object.keys(valuesByPath).sort().map(JSON.parse); + return underline( + name, + constraints, + expTypes, + K(K(_)), + function(index) { + return function(f) { + return function(t) { + return function(propPath) { + var indexedPropPath = [index].concat(propPath); + return function(s) { + if (t.type === VARIABLE) { + var key = JSON.stringify(indexedPropPath); + var exists = hasOwnProperty.call(valuesByPath, key); + return (exists && !isEmpty(valuesByPath[key]) ? f : _)(s); + } else { + return unless(paths.some(isPrefix(indexedPropPath)), _, s); + } + }; + }; + }; + }; + } + ); }; // _satisfactoryTypes :: - // ... -> Either Error { typeVarMap :: StrMap { info :: Info - // , types :: [Type] } - // , types :: [Type] } + // ... -> Either Error { typeVarMap :: TypeVarMap, types :: Array Type } var _satisfactoryTypes = function( - env, // :: [Type] + env, // :: Array Type name, // :: String - constraints, // :: StrMap [TypeClass] - expTypes, // :: [Type] + constraints, // :: StrMap (Array TypeClass) + expTypes, // :: Array Type index // :: Integer ) { return function recur( - typeVarMap, // :: StrMap { info :: Info, types :: [Type] } + typeVarMap, // :: TypeVarMap expType, // :: Type - values, // :: [Any] - typePath, // :: [Type] - propPath // :: [String] + values, // :: Array Any + propPath // :: PropPath ) { - var idx, okTypes; - if (!all(values, expType._test)) { + if (!values.every(expType._test)) { return Left(new TypeError('Invalid value')); } switch (expType.type) { - case 'VARIABLE': + case VARIABLE: var typeVarName = expType.name; - if (has(typeVarName, constraints)) { + if (hasOwnProperty.call(constraints, typeVarName)) { var typeClasses = constraints[typeVarName]; - for (idx = 0; idx < values.length; idx += 1) { + for (var idx = 0; idx < values.length; idx += 1) { for (var idx2 = 0; idx2 < typeClasses.length; idx2 += 1) { if (!typeClasses[idx2]._test(values[idx])) { return Left(typeClassConstraintViolation( + env, name, constraints, expTypes, typeClasses[idx2], - Info(env, - [values[idx]], - typePath.concat([expType]), - propPath, - index) + index, + propPath, + values[idx], + typeVarMap )); } } } } - if (has(typeVarName, typeVarMap)) { - okTypes = _determineActualTypes(false, - env, - typeVarMap[typeVarName].types, - [], - values); - if (isEmpty(okTypes)) { - return Left(typeVarConstraintViolation2( - name, - constraints, - expTypes, - Info(env, - values, - typePath.concat([expType]), - propPath, - index), - typeVarMap[typeVarName].info - )); - } - } else { - okTypes = determineActualTypesStrict(env, env, values); - if (isEmpty(okTypes) && !isEmpty(values)) { - return Left(typeVarConstraintViolation( - name, - constraints, - expTypes, - Info(env, - values, - typePath.concat([expType]), - propPath, - index) - )); - } - } - return Right({ - typeVarMap: isEmpty(okTypes) ? typeVarMap : assoc( - typeVarName, - {types: okTypes, - info: Info(env, - values, - typePath.concat([expType]), - propPath, - index)}, - typeVarMap - ), - types: okTypes - }); - case 'UNARY': + var typeVarMap$ = updateTypeVarMap(env, + typeVarMap, + expType, + index, + propPath, + values); + + var okTypes = typeVarMap$[typeVarName].types; + return isEmpty(okTypes) && !isEmpty(values) ? + Left(typeVarConstraintViolation( + env, + name, + constraints, + expTypes, + index, + propPath, + typeVarMap$[typeVarName].valuesByPath + )) : + okTypes.reduce(function(e, t) { + return isEmpty(expType.keys) || isEmpty(t.keys) ? + e : + e.chain(function(r) { + var $1 = expType.types[expType.keys[0]].type; + var k = last(t.keys); + var innerValues = chain(values, t.types[k].extractor); + return innerValues.reduce(function(e, x) { + return e.chain(function(r) { + return $1.type === VARIABLE || test(env, $1, x) ? + Right(r) : + Left(invalidValue(env, + name, + constraints, + expTypes, + index, + propPath.concat([k]), + x)); + }); + }, Right(r)); + }); + }, Right({typeVarMap: typeVarMap$, types: okTypes})); + + case UNARY: return recur( typeVarMap, - expType.$1, - chain(values, expType._1), - typePath.concat([expType]), + expType.types.$1.type, + chain(values, expType.types.$1.extractor), propPath.concat(['$1']) ) .map(function(result) { return { typeVarMap: result.typeVarMap, - types: map(or(result.types, [expType.$1]), - UnaryType.from(expType)) + types: or(result.types, [expType.types.$1.type]) + .map(UnaryType.from(expType)) }; }); - case 'BINARY': + case BINARY: return recur( typeVarMap, - expType.$1, - chain(values, expType._1), - typePath.concat([expType]), + expType.types.$1.type, + chain(values, expType.types.$1.extractor), propPath.concat(['$1']) ) .chain(function(result) { var $1s = result.types; return recur( result.typeVarMap, - expType.$2, - chain(values, expType._2), - typePath.concat([expType]), + expType.types.$2.type, + chain(values, expType.types.$2.extractor), propPath.concat(['$2']) ) .map(function(result) { @@ -965,8 +1006,8 @@ return { typeVarMap: result.typeVarMap, types: BinaryType.xprod(expType, - or($1s, [expType.$1]), - or($2s, [expType.$2])) + or($1s, [expType.types.$1.type]), + or($2s, [expType.types.$2.type])) }; }); }); @@ -978,60 +1019,163 @@ }; }; - // satisfactoryTypes :: ... -> Either Error [Type] + // satisfactoryTypes :: ... -> Either Error (Array Type) var satisfactoryTypes = function( - env, // :: [Type] + env, // :: Array Type name, // :: String - constraints, // :: StrMap [TypeClass] - expTypes, // :: [Type] - typeVarMap, // :: StrMap { info :: Info, types :: [Type] } + constraints, // :: StrMap (Array TypeClass) + expTypes, // :: Array Type + typeVarMap, // :: TypeVarMap value, // :: Any index // :: Integer ) { var result = expTypes[index].validate(value); return result.isLeft ? - Left(invalidValue(name, + Left(invalidValue(env, + name, constraints, expTypes, - Info(env, - [result.value.value], - result.value.typePath, - result.value.propPath, - index))) : + index, + result.value.propPath, + result.value.value)) : result.chain(function(value) { var f = _satisfactoryTypes(env, name, constraints, expTypes, index); - return f(typeVarMap, expTypes[index], [value], [], []); + return f(typeVarMap, expTypes[index], [value], []); }); }; - // test :: ([Type], Type, Any) -> Boolean - $.test = function(_env, t, x) { + // test :: (Array Type, Type, Any) -> Boolean + var test = $.test = function(_env, t, x) { var env = applyParameterizedTypes(_env); var f = _satisfactoryTypes(env, 'name', {}, [t], 0); return f({}, t, [x], [], []).isRight; }; + // checkValue :: ... -> Undefined + var checkValue = function( + env, // :: Array Type + name, // :: String + constraints, // :: StrMap (Array TypeClass) + expTypes, // :: Array Type + $typeVarMapBox, // :: Box TypeVarMap + index, // :: Integer + propPath, // :: PropPath + t, // :: Type + value // :: Any + ) { + if (t.type === VARIABLE) { + $typeVarMapBox[0] = + updateTypeVarMap(env, $typeVarMapBox[0], t, index, propPath, [value]); + if (isEmpty($typeVarMapBox[0][t.name].types)) { + throw typeVarConstraintViolation( + env, + name, + constraints, + expTypes, + index, + propPath, + $typeVarMapBox[0][t.name].valuesByPath + ); + } + } else if (!test(env, t, value)) { + throw invalidValue( + env, name, constraints, expTypes, index, propPath, value + ); + } + }; + + // wrapFunction :: ... -> Function + var wrapFunction = function( + env, // :: Array Type + name, // :: String + constraints, // :: StrMap (Array TypeClass) + expTypes, // :: Array Type + $typeVarMapBox, // :: Box TypeVarMap + index, // :: Integer + f // :: Function + ) { + return function() { + var args = slice.call(arguments); + var expType = expTypes[index]; + var numArgsExpected = expType.keys.length - 1; + if (args.length !== numArgsExpected) { + throw invalidArgumentsLength_(env, + name, + constraints, + expTypes, + index, + numArgsExpected, + args); + } + var checkValue$ = function(propPath, t, x) { + checkValue(env, + name, + constraints, + expTypes, + $typeVarMapBox, + index, + propPath, + t, + x); + }; + expType.keys.slice(0, -1).forEach(function(k, idx) { + checkValue$([k], expType.types[k].type, args[idx]); + }); + + var output = f.apply(this, arguments); + var k = last(expType.keys); + checkValue$([k], expType.types[k].type, output); + return output; + }; + }; + + // wrapFunctions :: ... -> Array Any + var wrapFunctions = function( + env, // :: Array Type + name, // :: String + constraints, // :: StrMap (Array TypeClass) + expTypes, // :: Array Type + $typeVarMapBox, // :: Box TypeVarMap + values // :: Array Any + ) { + return values.map(function(value, idx) { + return expTypes[idx].type === FUNCTION ? + wrapFunction(env, + name, + constraints, + expTypes, + $typeVarMapBox, + idx, + value) : + value; + }); + }; + // invalidArgumentsLength :: (String, Integer, Integer) -> Error var invalidArgumentsLength = function(name, expectedLength, actualLength) { - return new TypeError( - LEFT_SINGLE_QUOTATION_MARK + name + RIGHT_SINGLE_QUOTATION_MARK + - ' requires ' + numArgs(expectedLength) + ';' + - ' received ' + numArgs(actualLength) - ); + return new TypeError(q(name) + + ' requires ' + numArgs(expectedLength) + ';' + + ' received ' + numArgs(actualLength)); }; - // constraintsRepr :: StrMap [TypeClass] -> String - var constraintsRepr = function(constraints) { - var reprs = chain(toPairs(constraints), function(pair) { - return map(pair[1], function(typeClass) { - return stripNamespace(typeClass.name) + ' ' + pair[0]; + // constraintsRepr :: ... -> String + var constraintsRepr = function( + constraints, // :: StrMap (Array TypeClass) + outer, // :: String -> String + inner // :: String -> TypeClass -> String -> String + ) { + var $reprs = []; + Object.keys(constraints).sort().forEach(function(k) { + var f = inner(k); + constraints[k].forEach(function(typeClass) { + $reprs.push(f(typeClass)(stripNamespace(typeClass.name) + ' ' + k)); }); }); - return when(reprs.length > 0, - function(s) { return s + ' => '; }, - when(reprs.length > 1, - function(s) { return '(' + s + ')'; }, - reprs.join(', '))); + return when($reprs.length > 0, + function(s) { return s + outer(' => '); }, + when($reprs.length > 1, + wrap(outer('('))(outer(')')), + $reprs.join(outer(', ')))); }; // label :: String -> String -> String @@ -1043,239 +1187,251 @@ }; }; - // arrowJoin :: [String] -> String - var arrowJoin = function(xs) { - return xs.join(' -> '); - }; - - // isParameterizedType :: Object -> Boolean - var isParameterizedType = function(t) { - return t.type === 'UNARY' || t.type === 'BINARY'; - }; - // showType :: Type -> String var showType = function(t) { - var s = String(t); - return isParameterizedType(t) ? s.slice(1, -1) : s; + return unless(t.type === FUNCTION || t.type === RECORD || isEmpty(t.keys), + stripOutermostParens, + String(t)); }; // showTypeQuoted :: Type -> String var showTypeQuoted = function(t) { - return LEFT_SINGLE_QUOTATION_MARK + - showType(t) + - RIGHT_SINGLE_QUOTATION_MARK; - }; - - // showTypeSig :: [Type] -> String - var showTypeSig = function(types) { - return arrowJoin(map(types, showType)); - }; - - // showTypeSig_ :: [Type] -> String - var showTypeSig_ = function(types) { - return arrowJoin(map(types, showType).concat([''])); + return q(unless(t.type === RECORD || isEmpty(t.keys), + stripOutermostParens, + String(t))); }; - // _showTypeSig :: [Type] -> String - var _showTypeSig = function(types) { - return arrowJoin([''].concat(map(types, showType))); + // showValuesAndTypes :: (Array Type, Array Any, Integer) -> String + var showValuesAndTypes = function(env, values, pos) { + return String(pos) + ') ' + values.map(function(x) { + var types = determineActualTypesLoose(env, env, [x]); + return show(x) + ' :: ' + types.map(showType).join(', '); + }, '').join('\n '); }; - // _showTypeSig_ :: [Type] -> String - var _showTypeSig_ = function(types) { - return arrowJoin([''].concat(map(types, showType)).concat([''])); - }; - - // showValueAndType :: Pair Any [Type] -> String - var showValueAndType = function(pair) { - return show(pair[0]) + ' :: ' + map(pair[1], showType).join(', '); - }; - - // underline :: Type -> [String] -> (String -> String) -> String - var underline = function(type) { - return function(propPath) { + // _underline :: ... -> String + var _underline = function recur( + t, // :: Type + propPath, // :: PropPath + formatType3 // :: Type -> Array String -> String -> String + ) { + return unless(t.type === RECORD || + isEmpty(t.keys) || + t.type === FUNCTION && isEmpty(propPath) || + !isEmpty(propPath), + stripOutermostParens, + formatType3(t)(propPath)(t.format(_, function(k) { + return K(recur(t.types[k].type, + propPath.concat([k]), + formatType3)); + }))); + }; + + // underline :: ... -> String + var underline = function( + name, // :: String + constraints, // :: StrMap (Array TypeClass) + expTypes, // :: Array Type + underlineConstraint, // :: String -> TypeClass -> String -> String + formatType5 // :: Integer -> (String -> String) -> Type -> + // PropPath -> String -> String + ) { + var st = expTypes.reduce(function(st, t, index) { + var formatType4 = formatType5(index); + var counter = st.counter; + var replace = function(s) { return label(String(counter += 1))(s); }; + return { + carets: st.carets.concat([_underline(t, [], formatType4(r('^')))]), + numbers: st.numbers.concat([_underline(t, [], formatType4(replace))]), + counter: counter + }; + }, {carets: [], numbers: [], counter: 0}); + + return name + ' :: ' + + constraintsRepr(constraints, id, K(K(id))) + + expTypes.map(showType).join(' -> ') + '\n' + + _(name + ' :: ') + + constraintsRepr(constraints, _, underlineConstraint) + + st.carets.join(_(' -> ')) + '\n' + + _(name + ' :: ') + + constraintsRepr(constraints, _, K(K(_))) + + st.numbers.join(_(' -> ')) + '\n'; + }; + + // resolvePropPath :: (Type, Array String) -> Type + var resolvePropPath = function(t, propPath) { + var f = function(t, prop) { return t.types[prop].type; }; + return propPath.reduce(f, t); + }; + + // formatType6 :: + // PropPath -> Integer -> (String -> String) -> + // Type -> PropPath -> String -> String + var formatType6 = function(indexedPropPath) { + return function(index_) { return function(f) { - var t = type; - var types = [t]; - for (var idx = 0; idx < propPath.length; idx += 1) { - types.push(t = (t.type === 'RECORD' ? t.fields : t)[propPath[idx]]); - } - - var s = f(String(last(types))); - for (idx = types.length - 2; idx >= 0; idx -= 1) { - var k = propPath[idx]; - t = types[idx]; - s = t.type === 'UNARY' ? - t.format(_, K(s)) : - t.type === 'BINARY' && k === '$1' ? - t.format(_, K(s), _) : - t.type === 'BINARY' && k === '$2' ? - t.format(_, _, K(s)) : - // else - t.format(_, function(k$) { return k$ === k ? K(s) : _; }); - } - - return isParameterizedType(type) ? s.slice(1, -1) : s; + return function(t) { + return function(propPath_) { + var indexedPropPath_ = [index_].concat(propPath_); + var p = isPrefix(indexedPropPath_)(indexedPropPath); + var q = isPrefix(indexedPropPath)(indexedPropPath_); + return p && q ? f : p ? id : _; + }; + }; }; }; }; - // Info = { index :: Integer - // , pairs :: [Pair Any [Type]] - // , propPath :: [String] - // , typePath :: [Type] } - - // Info :: ([Type], [Any], [Type], [String], Integer) -> Info - var Info = function(env, values, typePath, propPath, index) { - return {index: index, - pairs: valuesToPairs(env, values), - propPath: propPath, - typePath: typePath}; - }; - // typeClassConstraintViolation :: ... -> Error var typeClassConstraintViolation = function( + env, // :: Array Type name, // :: String - constraints, // :: StrMap [TypeClass] - expTypes, // :: [Type] + constraints, // :: StrMap (Array TypeClass) + expTypes, // :: Array Type typeClass, // :: TypeClass - info // :: Info - ) { - var typeVarName = last(info.typePath).name; - var reprs = chain(toPairs(constraints), function(pair) { - return map(pair[1], function(tc) { - var match = tc.name === typeClass.name && pair[0] === typeVarName; - return r(match ? '^' : ' ')(stripNamespace(tc.name) + ' ' + pair[0]); - }); - }); - - var carets = when(reprs.length > 1, - function(s) { return _('(') + s + _(')'); }, - reprs.join(_(', '))); - - var padding = _(showTypeSig_(expTypes.slice(0, info.index))); - var f = underline(info.typePath[0])(info.propPath); - - return new TypeError(trimTrailingSpaces(unlines([ - 'Type-class constraint violation', - '', - name + ' :: ' + constraintsRepr(constraints) + showTypeSig(expTypes), - _(name + ' :: ') + carets + _(' => ') + padding + f(r('^')), - _(name + ' :: ' + carets + ' => ') + padding + f(label('1')), - '', - '1) ' + map(info.pairs, showValueAndType).join('\n '), - '', - LEFT_SINGLE_QUOTATION_MARK + name + RIGHT_SINGLE_QUOTATION_MARK + - ' requires ' + LEFT_SINGLE_QUOTATION_MARK + - typeVarName + RIGHT_SINGLE_QUOTATION_MARK + - ' to satisfy the ' + typeClass + ' type-class constraint;' + - ' the value at position 1 does not.' - ]))); - }; - - // annotateSig :: ... -> String - var annotateSig = function( - types, // :: [Type] - fst, // :: Info - snd, // :: Info - f, // :: String -> String - g // :: String -> String - ) { - return _(_showTypeSig(types.slice(0, fst.index))) + - underline(fst.typePath[0])(fst.propPath)(f) + - _(_showTypeSig_(types.slice(fst.index + 1, snd.index))) + - underline(snd.typePath[0])(snd.propPath)(g); - }; - - // _typeVarConstraintViolation :: ... -> Error - var _typeVarConstraintViolation = function( - name, // :: String - constraints, // :: StrMap [TypeClass] - expTypes, // :: [Type] - carets, // :: String - numbers, // :: String - pairss // :: [[Pair Any [Type]]] + index, // :: Integer + propPath, // :: PropPath + value, // :: Any + typeVarMap // :: TypeVarMap ) { - var nameAndConstraints = name + ' :: ' + constraintsRepr(constraints); - var lines = []; - lines.push('Type-variable constraint violation'); - lines.push(''); - lines.push(nameAndConstraints + showTypeSig(expTypes)); - lines.push(_(nameAndConstraints) + carets); - lines.push(_(nameAndConstraints) + numbers); - for (var idx = 0; idx < pairss.length; idx += 1) { - lines.push(''); - lines.push(String(idx + 1) + ') ' + - map(pairss[idx], showValueAndType).join('\n ')); - } - lines.push(''); - lines.push('Since there is no type of which all the above values are ' + - 'members, the type-variable constraint has been violated.'); - return new TypeError(trimTrailingSpaces(unlines(lines))); + var expType = resolvePropPath(expTypes[index], propPath); + return new TypeError(trimTrailingSpaces( + 'Type-class constraint violation\n\n' + + underline(name, + constraints, + expTypes, + function(tvn) { + return function(tc) { + return tvn === expType.name && tc.name === typeClass.name ? + r('^') : + _; + }; + }, + formatType6([index].concat(propPath))) + + '\n' + + showValuesAndTypes(env, [value], 1) + '\n\n' + + q(name) + ' requires ' + q(expType.name) + ' to satisfy the ' + + typeClass + ' type-class constraint; the value at position 1 does not.\n' + )); }; // typeVarConstraintViolation :: ... -> Error var typeVarConstraintViolation = function( + env, // :: Array Type name, // :: String - constraints, // :: StrMap [TypeClass] - expTypes, // :: [Type] - info // :: Info + constraints, // :: StrMap (Array TypeClass) + expTypes, // :: Array Type + index, // :: Integer + propPath, // :: PropPath + valuesByPath // :: StrMap (Array Any) ) { - var padding = _(_showTypeSig(expTypes.slice(0, info.index))); - var f = underline(expTypes[info.index])(info.propPath); - return _typeVarConstraintViolation( - name, - constraints, - expTypes, - padding + f(r('^')), - padding + f(label('1')), - [info.pairs] - ); - }; + // If we apply an ‘a -> a -> a -> a’ function to Left('x'), Right(1), and + // Right(null) we'd like to avoid underlining the first argument position, + // since Left('x') is compatible with the other ‘a’ values. + var key = JSON.stringify([index].concat(propPath)); + var values = valuesByPath[key]; + + // Note: Sorting these keys lexicographically is not "correct", but it + // does the right thing for indexes less than 10. + var keys = Object.keys(valuesByPath).sort().filter(function(k) { + var values_ = valuesByPath[k]; + return ( + // Keep X, the position at which the violation was observed. + k === key || + // Keep positions whose values are incompatible with the values at X. + isEmpty(determineActualTypesStrict(env, env, values.concat(values_))) + ); + }); - // typeVarConstraintViolation2 :: ... -> Error - var typeVarConstraintViolation2 = function( - name, // :: String - constraints, // :: StrMap [TypeClass] - expTypes, // :: [Type] - _fst, // :: Info - _snd // :: Info - ) { - var fst = _fst.index < _snd.index ? _fst : _snd; - var snd = _fst.index < _snd.index ? _snd : _fst; - return _typeVarConstraintViolation( - name, - constraints, - expTypes, - annotateSig(expTypes, fst, snd, r('^'), r('^')), - annotateSig(expTypes, fst, snd, label('1'), label('2')), - [fst.pairs, snd.pairs] - ); + return new TypeError(trimTrailingSpaces( + 'Type-variable constraint violation\n\n' + + underlineTypeVars(name, + constraints, + expTypes, + keys.reduce(function($valuesByPath, k) { + $valuesByPath[k] = valuesByPath[k]; + return $valuesByPath; + }, {})) + + keys.reduce(function(st, k) { + var values = valuesByPath[k]; + return isEmpty(values) ? st : { + idx: st.idx + 1, + s: st.s + '\n' + showValuesAndTypes(env, values, st.idx + 1) + '\n' + }; + }, {idx: 0, s: ''}).s + '\n' + + 'Since there is no type of which all the above values are ' + + 'members, the type-variable constraint has been violated.\n' + )); }; // invalidValue :: ... -> Error var invalidValue = function( + env, // :: Array Type name, // :: String - constraints, // :: StrMap [TypeClass] - expTypes, // :: [Type] - info // :: Info + constraints, // :: StrMap (Array TypeClass) + expTypes, // :: Array Type + index, // :: Integer + propPath, // :: PropPath + value // :: Any ) { - var nameAndConstraints = name + ' :: ' + constraintsRepr(constraints); - var padding = _(_showTypeSig(expTypes.slice(0, info.index))); - var f = underline(info.typePath[0])(info.propPath); - - return new TypeError(trimTrailingSpaces(unlines([ - 'Invalid value', - '', - nameAndConstraints + showTypeSig(expTypes), - _(nameAndConstraints) + padding + f(r('^')), - _(nameAndConstraints) + padding + f(label('1')), - '', - '1) ' + map(info.pairs, showValueAndType).join('\n '), - '', + return new TypeError(trimTrailingSpaces( + 'Invalid value\n\n' + + underline(name, + constraints, + expTypes, + K(K(_)), + formatType6([index].concat(propPath))) + + '\n' + + showValuesAndTypes(env, [value], 1) + '\n\n' + 'The value at position 1 is not a member of ' + - showTypeQuoted(last(info.typePath)) + '.' - ]))); + showTypeQuoted(resolvePropPath(expTypes[index], propPath)) + '.\n' + )); + }; + + // invalidArgumentsLength_ :: ... -> Error + var invalidArgumentsLength_ = function( + env, // :: Array Type + name, // :: String + constraints, // :: StrMap (Array TypeClass) + expTypes, // :: Array Type + index, // :: Integer + numArgsExpected, // :: Integer + args // :: Array Any + ) { + return new TypeError(trimTrailingSpaces( + q(name) + ' applied ' + showTypeQuoted(expTypes[index]) + + ' to the wrong number of arguments\n\n' + + underline( + name, + constraints, + expTypes, + K(K(_)), + function(index_) { + return function(f) { + return function(t) { + return function(propPath) { + return function(s) { + return index_ === index ? + String(t).replace( + /^[(](.*) -> (.*)[)]$/, + function(s, $1, $2) { + return _('(') + f($1) + _(' -> ' + $2 + ')'); + } + ) : + _(s); + }; + }; + }; + }; + } + ) + '\n' + + 'Expected ' + numArgs(numArgsExpected) + + ' but received ' + numArgs(args.length) + + (args.length === 0 ? + '.\n' : + args.reduce(function(s, x) { return s + ' - ' + show(x) + '\n'; }, + ':\n\n')) + )); }; // assertRight :: Either a b -> Undefined ! @@ -1291,7 +1447,7 @@ assertRight(satisfactoryTypes(defaultEnv, 'create', {}, - [Options, $.Function], + [Options, AnyFunction], {}, opts, 0)); @@ -1299,17 +1455,17 @@ // checkTypes :: Boolean var checkTypes = opts.checkTypes; - // env :: [Type] + // env :: Array Type var env = applyParameterizedTypes(opts.env); // curry :: ... -> Function var curry = function( name, // :: String - constraints, // :: StrMap [TypeClass] - expTypes, // :: [Type] - _typeVarMap, // :: StrMap { info :: Info, types :: [Type] } - _values, // :: [Any] - _indexes, // :: [Integer] + constraints, // :: StrMap (Array TypeClass) + expTypes, // :: Array Type + _typeVarMap, // :: TypeVarMap + _values, // :: Array Any + _indexes, // :: Array Integer impl // :: Function ) { return arity(_indexes.length, function() { @@ -1350,8 +1506,14 @@ } } if (isEmpty(indexes)) { - var returnValue = impl.apply(this, values); if (checkTypes) { + var returnValue = impl.apply(this, + wrapFunctions(env, + name, + constraints, + expTypes, + [typeVarMap], + values)); assertRight(satisfactoryTypes(env, name, constraints, @@ -1359,8 +1521,10 @@ typeVarMap, returnValue, expTypes.length - 1)); + return returnValue; + } else { + return impl.apply(this, values); } - return returnValue; } else { return curry(name, constraints, @@ -1382,33 +1546,27 @@ var types = [$.String, StrMap($.Array(TypeClass)), $.Array(Type), - $.Function, - $.Function]; - for (var idx = 0; idx < types.length - 1; idx += 1) { - assertRight(satisfactoryTypes(defaultEnv, - 'def', - {}, - types, - {}, - arguments[idx], - idx)); - } + AnyFunction, + AnyFunction]; + forEach.call(arguments, function(arg, idx) { + assertRight( + satisfactoryTypes(defaultEnv, 'def', {}, types, {}, arg, idx) + ); + }); } - var arity = expTypes.length - 1; - if (arity > 9) { - throw new RangeError( - LEFT_SINGLE_QUOTATION_MARK + 'def' + RIGHT_SINGLE_QUOTATION_MARK + - ' cannot define a function with arity greater than nine' - ); + var values = new Array(expTypes.length - 1); + if (values.length > 9) { + throw new RangeError(q('def') + ' cannot define a function ' + + 'with arity greater than nine'); } return curry(name, constraints, expTypes, {}, - new Array(arity), - range(0, arity), + values, + range(0, values.length), impl); }; }; diff --git a/test/index.js b/test/index.js index 3266a36..d96773e 100644 --- a/test/index.js +++ b/test/index.js @@ -20,11 +20,18 @@ var errorEq = R.curry(function(type, message, error) { return error.constructor === type && error.message === message; }); +// hasMethods :: Array String -> a -> Boolean +var hasMethods = R.curry(function(names, x) { + return x != null && + R.all(function(k) { return typeof x[k] === 'function'; }, names); +}); + var def = $.create({checkTypes: true, env: $.env}); var a = $.TypeVariable('a'); var b = $.TypeVariable('b'); +var m = $.UnaryTypeVariable('m'); var list = R.unapply(R.identity); @@ -55,19 +62,19 @@ var Integer = $.NullaryType( ); -// Nothing :: -> Maybe a -var Nothing = function() { - return { - '@@type': 'my-package/Maybe', - chain: function(f) { return this; }, - concat: function() { throw new Error('Not implemented'); }, - empty: function() { return this; }, - isNothing: true, - isJust: false, - of: function(x) { return Just(x); }, - or: R.identity, - toString: R.always('Nothing()') - }; +// Nothing :: Maybe a +var Nothing = { + '@@type': 'my-package/Maybe', + chain: function(f) { return this; }, + concat: function() { throw new Error('Not implemented'); }, + empty: function() { return this; }, + isNothing: true, + isJust: false, + map: function(f) { return this; }, + of: function(x) { return Just(x); }, + or: R.identity, + reduce: function(f, initial) { return initial; }, + toString: R.always('Nothing') }; // Just :: a -> Maybe a @@ -76,11 +83,13 @@ var Just = function(x) { '@@type': 'my-package/Maybe', chain: function(f) { return f(x); }, concat: function() { throw new Error('Not implemented'); }, - empty: R.always(Nothing()), + empty: R.always(Nothing), isNothing: false, isJust: true, + map: function(f) { return Just(f(x)); }, of: function(x) { return Just(x); }, or: function() { return this; }, + reduce: function(f, initial) { return f(initial, x); }, toString: R.always('Just(' + R.toString(x) + ')'), value: x }; @@ -102,6 +111,7 @@ var Left = function(x) { isLeft: true, isRight: false, of: function(x) { return Right(x); }, + reduce: function(f, initial) { return initial; }, toString: R.always('Left(' + R.toString(x) + ')'), value: x }; @@ -115,6 +125,7 @@ var Right = function(x) { isLeft: false, isRight: true, of: function(x) { return Right(x); }, + reduce: function(f, initial) { return f(initial, x); }, toString: R.always('Right(' + R.toString(x) + ')'), value: x }; @@ -333,7 +344,7 @@ describe('def', function() { }); it('returns a function which accepts placeholders', function() { - // triple :: Number -> Number -> Number -> [Number] + // triple :: Number -> Number -> Number -> Array Number var triple = def('triple', {}, [$.Number, $.Number, $.Number, $.Array($.Number)], list); @@ -569,7 +580,7 @@ describe('def', function() { }); it('creates a proper curry closure', function() { - // a000 :: a -> a -> a -> [a] + // a000 :: a -> a -> a -> Array a var a000 = def('a00', {}, [a, a, a, $.Array(a)], Array); var anum = a000(1); var astr = a000('a'); @@ -591,17 +602,17 @@ describe('def', function() { // a00 :: a -> a -> a var a00 = def('a00', {}, [a, a, a], R.identity); - // a01 :: a -> [a] -> a + // a01 :: a -> Array a -> a var a01 = def('a01', {}, [a, $.Array(a), a], R.identity); - // a02 :: a -> [[a]] -> a + // a02 :: a -> Array (Array a) -> a var a02 = def('a02', {}, [a, $.Array($.Array(a)), a], R.identity); - // ab02e :: a -> b -> [[Either a b]] -> a + // ab02e :: a -> b -> Array (Array (Either a b)) -> a var ab02e = def('ab02e', {}, [a, b, $.Array($.Array(Either(a, b))), a], R.identity); - // ab0e21 :: a -> b -> Either [[a]] [b] -> a + // ab0e21 :: a -> b -> Either (Array (Array a)) (Array b) -> a var ab0e21 = def('ab0e21', {}, [a, b, Either($.Array($.Array(a)), $.Array(b)), a], R.identity); @@ -821,7 +832,7 @@ describe('def', function() { eq(inc(new Number(42)), 43); eq(inc(vm.runInNewContext('new Number(42)')), 43); - // length :: [String] -> Number + // length :: Array String -> Number var length = def('length', {}, [$.Array($.String), $.Number], R.length); eq(length(['foo', 'bar', 'baz']), 3); @@ -874,9 +885,6 @@ describe('def', function() { function(maybe) { return maybe.isJust ? [maybe.value] : []; } ); - var env = $.env.concat([Integer, $Pair, AnonMaybe]); - var def = $.create({checkTypes: true, env: env}); - // even :: Integer -> Boolean var even = def('even', {}, [Integer, $.Boolean], function(x) { return x % 2 === 0; @@ -923,9 +931,6 @@ describe('def', function() { // TimeUnit :: Type var TimeUnit = $.EnumType(['milliseconds', 'seconds', 'minutes', 'hours']); - var env = $.env.concat([TimeUnit, $.ValidDate, $.ValidNumber]); - var def = $.create({checkTypes: true, env: env}); - // convertTo :: TimeUnit -> ValidDate -> ValidNumber var convertTo = def('convertTo', @@ -992,9 +997,6 @@ describe('def', function() { // Line :: Type var Line = $.RecordType({start: Point, end: Point}); - var env = $.env.concat([Point, Line]); - var def = $.create({checkTypes: true, env: env}); - // dist :: Point -> Point -> Number var dist = def('dist', {}, [Point, Point, $.Number], function(p, q) { return Math.sqrt(Math.pow(p.x - q.x, 2) + Math.pow(p.y - q.y, 2)); @@ -1103,9 +1105,6 @@ describe('def', function() { }); it('supports "nullable" types', function() { - var env = $.env.concat([$.Nullable]); - var def = $.create({checkTypes: true, env: env}); - // toUpper :: Nullable String -> Nullable String var toUpper = def('toUpper', @@ -1174,9 +1173,6 @@ describe('def', function() { }); it('supports the "ValidDate" type', function() { - var env = $.env.concat([$.ValidDate]); - var def = $.create({checkTypes: true, env: env}); - // sinceEpoch :: ValidDate -> Number var sinceEpoch = def('sinceEpoch', {}, @@ -1421,20 +1417,17 @@ describe('def', function() { }); it('supports the "StrMap" type constructor', function() { - var env = $.env.concat([Either]); - var def = $.create({checkTypes: true, env: env}); - // id :: a -> a var id = def('id', {}, [a, a], R.identity); - // keys :: StrMap a -> [String] + // keys :: StrMap a -> Array String var keys = def('keys', {}, [$.StrMap(a), $.Array($.String)], function(m) { return R.keys(m).sort(); }); - // values :: StrMap a -> [a] + // values :: StrMap a -> Array a var values = def('values', {}, @@ -1485,7 +1478,7 @@ describe('def', function() { '\n' + 'Since there is no type of which all the above values are members, the type-variable constraint has been violated.\n')); - // testUnaryType :: [StrMap Number] -> [StrMap Number] + // testUnaryType :: Array (StrMap Number) -> Array (StrMap Number) var testUnaryType = def('testUnaryType', {}, @@ -1530,9 +1523,6 @@ describe('def', function() { }); it('supports the "Pair" type constructor', function() { - var env = $.env.concat([$.Pair]); - var def = $.create({checkTypes: true, env: env}); - // fst :: Pair a b -> a var fst = def('fst', {}, [$.Pair(a, b), a], R.nth(0)); @@ -1663,7 +1653,7 @@ describe('def', function() { return maybe.isJust ? maybe.value : x; }); - eq(fromMaybe(0, Nothing()), 0); + eq(fromMaybe(0, Nothing), 0); eq(fromMaybe(0, Just(42)), 42); throws(function() { fromMaybe(0, [1, 2, 3]); }, @@ -1695,6 +1685,30 @@ describe('def', function() { '\n' + 'The value at position 1 is not a member of ‘Pair a b’.\n')); + // twin :: Pair a a -> Boolean + var twin = + def('twin', + {}, + [$Pair(a, a), $.Boolean], + function(pair) { return R.equals(pair[0], pair[1]); }); + + eq(twin(Pair(42, 42)), true); + eq(twin(Pair(42, 99)), false); + + throws(function() { twin(Pair(42, 'XXX')); }, + errorEq(TypeError, + 'Type-variable constraint violation\n' + + '\n' + + 'twin :: Pair a a -> Boolean\n' + + ' ^ ^\n' + + ' 1 2\n' + + '\n' + + '1) 42 :: Number\n' + + '\n' + + '2) "XXX" :: String\n' + + '\n' + + 'Since there is no type of which all the above values are members, the type-variable constraint has been violated.\n')); + // concat :: Either a b -> Either a b -> Either a b var concat = def('concat', @@ -1770,19 +1784,19 @@ describe('def', function() { '\n' + 'Since there is no type of which all the above values are members, the type-variable constraint has been violated.\n')); -// throws(function() { f(Left('abc'), Right(123), Left(/XXX/)); }, -// errorEq(TypeError, -// 'Type-variable constraint violation\n' + -// '\n' + -// 'f :: a -> a -> a -> a\n' + -// ' ^ ^\n' + -// ' 1 2\n' + -// '\n' + -// '1) Left("abc") :: Either String ???\n' + -// '\n' + -// '2) Left(/XXX/) :: Either RegExp ???\n' + -// '\n' + -// 'Since there is no type of which all the above values are members, the type-variable constraint has been violated.\n')); + throws(function() { f(Left('abc'), Right(123), Left(/XXX/)); }, + errorEq(TypeError, + 'Type-variable constraint violation\n' + + '\n' + + 'f :: a -> a -> a -> a\n' + + ' ^ ^\n' + + ' 1 2\n' + + '\n' + + '1) Left("abc") :: Either String ???\n' + + '\n' + + '2) Left(/XXX/) :: Either RegExp ???\n' + + '\n' + + 'Since there is no type of which all the above values are members, the type-variable constraint has been violated.\n')); throws(function() { f(Left('abc'), Right(123), Right(/XXX/)); }, errorEq(TypeError, @@ -1803,7 +1817,7 @@ describe('def', function() { var env = $.env.concat([Either, $.Integer]); var def = $.create({checkTypes: true, env: env}); - // unnest :: [[a]] -> [a] + // unnest :: Array (Array a) -> Array a var unnest = def('unnest', {}, [$.Array($.Array(a)), $.Array(a)], R.unnest); @@ -1822,7 +1836,7 @@ describe('def', function() { '\n' + 'The value at position 1 is not a member of ‘Array a’.\n')); - // concatComplex :: [Either String Integer] -> [Either String Integer] -> [Either String Integer] + // concatComplex :: Array (Either String Integer) -> Array (Either String Integer) -> Array (Either String Integer) var concatComplex = def('concatComplex', {}, @@ -1896,7 +1910,7 @@ describe('def', function() { var env = $.env.concat([Either]); var def = $.create({checkTypes: true, env: env}); - // concat :: [a] -> [a] -> [a] + // concat :: Array a -> Array a -> Array a var concat = def('concat', {}, [$.Array(a), $.Array(a), $.Array(a)], function(xs, ys) { return xs.concat(ys); @@ -1934,7 +1948,7 @@ describe('def', function() { '\n' + 'Since there is no type of which all the above values are members, the type-variable constraint has been violated.\n')); - // concatNested :: [[a]] -> [[a]] -> [[a]] + // concatNested :: Array (Array a) -> Array (Array a) -> Array (Array a) var concatNested = def('concatNested', {}, @@ -2026,16 +2040,194 @@ describe('def', function() { 'Since there is no type of which all the above values are members, the type-variable constraint has been violated.\n')); }); + it('supports higher-order functions', function() { + // f :: (String -> Number) -> Array String -> Array Number + var f = + def('f', + {}, + [$.Function([$.String, $.Number]), $.Array($.String), $.Array($.Number)], + R.map); + + // g :: (String -> Number) -> Array String -> Array Number + var g = + def('g', + {}, + [$.Function([$.String, $.Number]), $.Array($.String), $.Array($.Number)], + function(f, xs) { return f(xs); }); + + eq(f(R.length, ['foo', 'bar', 'baz', 'quux']), [3, 3, 3, 4]); + + throws(function() { g(/xxx/); }, + errorEq(TypeError, + 'Invalid value\n' + + '\n' + + 'g :: (String -> Number) -> Array String -> Array Number\n' + + ' ^^^^^^^^^^^^^^^^^^\n' + + ' 1\n' + + '\n' + + '1) /xxx/ :: RegExp\n' + + '\n' + + 'The value at position 1 is not a member of ‘String -> Number’.\n')); + + throws(function() { g(R.length, ['a', 'b', 'c']); }, + errorEq(TypeError, + 'Invalid value\n' + + '\n' + + 'g :: (String -> Number) -> Array String -> Array Number\n' + + ' ^^^^^^\n' + + ' 1\n' + + '\n' + + '1) ["a", "b", "c"] :: Array String\n' + + '\n' + + 'The value at position 1 is not a member of ‘String’.\n')); + + throws(function() { f(R.identity, ['a', 'b', 'c']); }, + errorEq(TypeError, + 'Invalid value\n' + + '\n' + + 'f :: (String -> Number) -> Array String -> Array Number\n' + + ' ^^^^^^\n' + + ' 1\n' + + '\n' + + '1) "a" :: String\n' + + '\n' + + 'The value at position 1 is not a member of ‘Number’.\n')); + + // map :: (a -> b) -> Array a -> Array b + var map = + def('map', + {}, + [$.Function([a, b]), $.Array(a), $.Array(b)], + function(f, xs) { + var result = []; + for (var idx = 0; idx < xs.length; idx += 1) { + result.push(f(idx === 3 ? null : xs[idx])); + } + return result; + }); + + // length :: Array a -> Integer + var length = function(xs) { return xs.length; }; + + eq(map(length, ['foo', 'bar']), [3, 3]); + + throws(function() { map(length, ['foo', 'bar', 'baz', 'quux']); }, + errorEq(TypeError, + 'Type-variable constraint violation\n' + + '\n' + + 'map :: (a -> b) -> Array a -> Array b\n' + + ' ^ ^\n' + + ' 1 2\n' + + '\n' + + '1) "foo" :: String\n' + + ' "bar" :: String\n' + + ' "baz" :: String\n' + + ' null :: Null\n' + + '\n' + + '2) "foo" :: String\n' + + ' "bar" :: String\n' + + ' "baz" :: String\n' + + ' "quux" :: String\n' + + '\n' + + 'Since there is no type of which all the above values are members, the type-variable constraint has been violated.\n')); + + throws(function() { map(function(s) { return s === 'baz' ? null : s.length; }, ['foo', 'bar', 'baz']); }, + errorEq(TypeError, + 'Type-variable constraint violation\n' + + '\n' + + 'map :: (a -> b) -> Array a -> Array b\n' + + ' ^\n' + + ' 1\n' + + '\n' + + '1) 3 :: Number\n' + + ' 3 :: Number\n' + + ' null :: Null\n' + + '\n' + + 'Since there is no type of which all the above values are members, the type-variable constraint has been violated.\n')); + + // reduce_ :: ((a, b) -> a) -> a -> Array b -> a + var reduce_ = + def('reduce_', + {}, + [$.Function([a, b, a]), a, $.Array(b), a], + function(f, initial, xs) { + var result = initial; + for (var idx = 0; idx < xs.length; idx += 1) { + result = f(result, xs[idx]); + } + return result; + }); + + eq(reduce_(function(x, y) { return x + y; }, 0, [1, 2, 3, 4, 5, 6]), 21); + + throws(function() { reduce_(null); }, + errorEq(TypeError, + 'Invalid value\n' + + '\n' + + 'reduce_ :: ((a, b) -> a) -> a -> Array b -> a\n' + + ' ^^^^^^^^^^^^^\n' + + ' 1\n' + + '\n' + + '1) null :: Null\n' + + '\n' + + 'The value at position 1 is not a member of ‘(a, b) -> a’.\n')); + + // unfoldr :: (b -> Maybe (Pair a b)) -> b -> Array a + var unfoldr = + def('unfoldr', + {}, + [$.Function([b, Maybe($.Pair(a, b))]), b, $.Array(a)], + function(f, x) { + var result = []; + var m = f(x); + while (m.isJust) { + result.push(m.value[0]); + m = f(m.value[1]); + } + return result; + }); + + // h :: Integer -> Maybe (Pair Integer Integer) + var h = function(n) { return n >= 5 ? Nothing : Just([n, n + 1]); }; + + eq(unfoldr(h, 5), []); + eq(unfoldr(h, 4), [4]); + eq(unfoldr(h, 1), [1, 2, 3, 4]); + + throws(function() { unfoldr(null); }, + errorEq(TypeError, + 'Invalid value\n' + + '\n' + + 'unfoldr :: (b -> Maybe (Pair a b)) -> b -> Array a\n' + + ' ^^^^^^^^^^^^^^^^^^^^^^^\n' + + ' 1\n' + + '\n' + + '1) null :: Null\n' + + '\n' + + 'The value at position 1 is not a member of ‘b -> Maybe (Pair a b)’.\n')); + + // T :: a -> (a -> b) -> b + var T = + def('T', + {}, + [a, $.Function([a, b]), b], + function(x, f) { return f(/* x */); }); + + throws(function() { T(100, Math.sqrt); }, + errorEq(TypeError, + '‘T’ applied ‘a -> b’ to the wrong number of arguments\n' + + '\n' + + 'T :: a -> (a -> b) -> b\n' + + ' ^\n' + + ' 1\n' + + '\n' + + 'Expected one argument but received zero arguments.\n')); + }); + it('supports type-class constraints', function() { var env = $.env.concat([Integer, Maybe, Either]); var def = $.create({checkTypes: true, env: env}); - // hasMethods :: [String] -> a -> Boolean - var hasMethods = R.curry(function(names, x) { - return x != null && - R.all(function(k) { return typeof x[k] === 'function'; }, names); - }); - // Alternative :: TypeClass var Alternative = $.TypeClass('my-package/Alternative', hasMethods(['empty', 'or'])); @@ -2045,9 +2237,9 @@ describe('def', function() { return x.or(y); }); - eq(or(Nothing(), Nothing()), Nothing()); - eq(or(Nothing(), Just(1)), Just(1)); - eq(or(Just(2), Nothing()), Just(2)); + eq(or(Nothing, Nothing), Nothing); + eq(or(Nothing, Just(1)), Just(1)); + eq(or(Just(2), Nothing), Just(2)); eq(or(Just(3), Just(4)), Just(3)); throws(function() { or(Left(1)); }, @@ -2148,40 +2340,43 @@ describe('def', function() { // filter :: (Monad m, Monoid (m a)) => (a -> Boolean) -> m a -> m a var filter = - def('filter', {a: [Monad, Monoid]}, [$.Function, a, a], function(pred, m) { - return m.chain(function(x) { - return pred(x) ? m.of(x) : m.empty(); - }); - }); + def('filter', + {m: [Monad, Monoid]}, + [$.Function([a, $.Boolean]), m(a), m(a)], + function(pred, m) { + return m.chain(function(x) { + return pred(x) ? m.of(x) : m.empty(); + }); + }); eq(filter(R.T, Just(42)), Just(42)); - eq(filter(R.F, Just(42)), Nothing()); - eq(filter(R.T, Nothing()), Nothing()); - eq(filter(R.F, Nothing()), Nothing()); + eq(filter(R.F, Just(42)), Nothing); + eq(filter(R.T, Nothing), Nothing); + eq(filter(R.F, Nothing), Nothing); throws(function() { filter(R.F, [1, 2, 3]); }, errorEq(TypeError, 'Type-class constraint violation\n' + '\n' + - 'filter :: (Monad a, Monoid a) => Function -> a -> a\n' + - ' ^^^^^^^ ^\n' + - ' 1\n' + + 'filter :: (Monad m, Monoid m) => (a -> Boolean) -> m a -> m a\n' + + ' ^^^^^^^ ^^^\n' + + ' 1\n' + '\n' + '1) [1, 2, 3] :: Array Number, Array Integer\n' + '\n' + - '‘filter’ requires ‘a’ to satisfy the Monad type-class constraint; the value at position 1 does not.\n')); + '‘filter’ requires ‘m’ to satisfy the Monad type-class constraint; the value at position 1 does not.\n')); throws(function() { filter(R.F, Right(42)); }, errorEq(TypeError, 'Type-class constraint violation\n' + '\n' + - 'filter :: (Monad a, Monoid a) => Function -> a -> a\n' + - ' ^^^^^^^^ ^\n' + - ' 1\n' + + 'filter :: (Monad m, Monoid m) => (a -> Boolean) -> m a -> m a\n' + + ' ^^^^^^^^ ^^^\n' + + ' 1\n' + '\n' + '1) Right(42) :: Either ??? Number, Either ??? Integer\n' + '\n' + - '‘filter’ requires ‘a’ to satisfy the Monoid type-class constraint; the value at position 1 does not.\n')); + '‘filter’ requires ‘m’ to satisfy the Monoid type-class constraint; the value at position 1 does not.\n')); // concatMaybes :: Semigroup a => Maybe a -> Maybe a -> Maybe a var concatMaybes = @@ -2225,6 +2420,107 @@ describe('def', function() { '1) /xxx/ :: RegExp\n' + '\n' + '‘concatMaybes’ requires ‘a’ to satisfy the Semigroup type-class constraint; the value at position 1 does not.\n')); + + // sillyConst :: (Alternative a, Semigroup b) => a -> b -> a + var sillyConst = + def('sillyConst', + {a: [Alternative], b: [Semigroup]}, + [a, b, a], + function(x, y) { return x; }); + + eq(sillyConst(Just(42), [1, 2, 3]), Just(42)); + + throws(function() { sillyConst([1, 2, 3]); }, + errorEq(TypeError, + 'Type-class constraint violation\n' + + '\n' + + 'sillyConst :: (Alternative a, Semigroup b) => a -> b -> a\n' + + ' ^^^^^^^^^^^^^ ^\n' + + ' 1\n' + + '\n' + + '1) [1, 2, 3] :: Array Number, Array Integer\n' + + '\n' + + '‘sillyConst’ requires ‘a’ to satisfy the Alternative type-class constraint; the value at position 1 does not.\n')); + }); + + it('supports unary type variables', function() { + var env = $.env.concat([Either, Maybe]); + var def = $.create({checkTypes: true, env: env}); + + // f :: Type + var f = $.UnaryTypeVariable('f'); + + // Functor :: TypeClass + var Functor = $.TypeClass( + 'my-package/Functor', + function(x) { return x != null && typeof x.map === 'function'; } + ); + + // map :: Functor f => (a -> b) -> f a -> f b + var map = + def('map', + {f: [Functor]}, + [$.Function([a, b]), f(a), f(b)], + function(f, functor) { return functor.map(f); }); + + eq(map(R.inc, Nothing), Nothing); + eq(map(R.inc, Just(42)), Just(43)); + + throws(function() { map(R.inc, [1, 2, 3]); }, + errorEq(TypeError, + '‘map’ applied ‘a -> b’ to the wrong number of arguments\n' + + '\n' + + 'map :: Functor f => (a -> b) -> f a -> f b\n' + + ' ^\n' + + ' 1\n' + + '\n' + + 'Expected one argument but received three arguments:\n' + + '\n' + + ' - 1\n' + + ' - 0\n' + + ' - [1, 2, 3]\n')); + + // Foldable :: TypeClass + var Foldable = $.TypeClass('my-package/Foldable', hasMethods(['reduce'])); + + // sum :: Foldable f => f FiniteNumber -> FiniteNumber + var sum = + def('sum', + {f: [Foldable]}, + [f($.FiniteNumber), $.FiniteNumber], + function(foldable) { + return foldable.reduce(function(x, y) { return x + y; }, 0); + }); + + eq(sum([1, 2, 3, 4, 5]), 15); + eq(sum(Nothing), 0); + eq(sum(Just(42)), 42); + eq(sum(Left('XXX')), 0); + eq(sum(Right(42)), 42); + + throws(function() { sum({x: 1, y: 2, z: 3}); }, + errorEq(TypeError, + 'Type-class constraint violation\n' + + '\n' + + 'sum :: Foldable f => f FiniteNumber -> FiniteNumber\n' + + ' ^^^^^^^^^^ ^^^^^^^^^^^^^^\n' + + ' 1\n' + + '\n' + + '1) {"x": 1, "y": 2, "z": 3} :: Object, StrMap Number\n' + + '\n' + + '‘sum’ requires ‘f’ to satisfy the Foldable type-class constraint; the value at position 1 does not.\n')); + + throws(function() { sum(['foo', 'bar', 'baz']); }, + errorEq(TypeError, + 'Invalid value\n' + + '\n' + + 'sum :: Foldable f => f FiniteNumber -> FiniteNumber\n' + + ' ^^^^^^^^^^^^\n' + + ' 1\n' + + '\n' + + '1) "foo" :: String\n' + + '\n' + + 'The value at position 1 is not a member of ‘FiniteNumber’.\n')); }); });