diff options
| -rw-r--r-- | yants.nix | 369 |
1 files changed, 268 insertions, 101 deletions
diff --git a/yants.nix b/yants.nix index 26c5b317c9fb..17564b61b91e 100644 --- a/yants.nix +++ b/yants.nix @@ -6,123 +6,290 @@ # # All types (should) compose as expected. -{ toPretty ? ((import <nixpkgs> {}).lib.generators.toPretty {}) }: +{ lib ? (import <nixpkgs> {}).lib }: with builtins; let - typeError = type: val: - throw "Expected type '${type}', but value '${toPretty val}' is of type '${typeOf val}'"; + prettyPrint = lib.generators.toPretty {}; - typedef = name: check: { - inherit name check; - __functor = self: value: - if check value then value - else typeError name value; - }; + # typedef' :: struct { + # name = string; + # checkType = function; (a -> result) + # checkToBool = option function; (result -> bool) + # toError = option function; (a -> result -> string) + # def = option any; + # match = option function; + # } -> type + # -> (a -> b) + # -> (b -> bool) + # -> (a -> b -> string) + # -> type + # + # This function creates an attribute set that acts as a type. + # + # It receives a type name, a function that is used to perform a + # check on an arbitrary value, a function that can translate the + # return of that check to a boolean that informs whether the value + # is type-conformant, and a function that can construct error + # messages from the check result. + # + # This function is the low-level primitive used to create types. For + # many cases the higher-level 'typedef' function is more appropriate. + typedef' = { name, checkType + , checkToBool ? (result: result.ok) + , toError ? (_: result: result.err) + , def ? null + , match ? null }: { + inherit name checkToBool toError; + + # check :: a -> bool + # + # This function is used to determine whether a given type is + # conformant. + check = value: checkToBool (checkType value); - poly = n: c: { "${n}" = t: typedef "${n}<${t.name}>" (c t); }; + # checkType :: a -> struct { ok = bool; err = option string; } + # + # This function checks whether the passed value is type conformant + # and returns an optional type error string otherwise. + inherit checkType; - poly2 = n: c: { - "${n}" = t1: t2: typedef "${n}<${t1.name},${t2.name}>" (c t1 t2); + # __functor :: a -> a + # + # This function checks whether the passed value is type conformant + # and throws an error if it is not. + # + # The name of this function is a special attribute in Nix that + # makes it possible to execute a type attribute set like a normal + # function. + __functor = self: value: + let result = self.checkType value; + in if checkToBool result then value + else throw (toError value result); }; - typeSet = foldl' (s: t: s // (if t ? "name" then { "${t.name}" = t; } else t)) {}; + typeError = type: val: + "expected type '${type}', but value '${prettyPrint val}' is of type '${typeOf val}'"; - # Struct implementation. Checks that all fields match their declared - # types, no optional fields are missing and no unexpected fields - # occur in the struct. + # typedef :: string -> (a -> bool) -> type # - # Anonymous structs are supported (e.g. for nesting) by omitting the - # name. - checkField = def: value: current: field: - let fieldVal = if hasAttr field value then value."${field}" else null; - type = def."${field}"; - checked = type.check fieldVal; - in if checked then (current && true) - else if isNull fieldVal then (throw "Missing required ${type.name} field '${field}'") - else (throw "Field ${field} is of type ${typeOf fieldVal}, but expected ${type.name}"); - - checkExtraneous = name: def: present: - if (length present) == 0 then true - else if (hasAttr (head present) def) - then checkExtraneous name def (tail present) - else (throw "Found unexpected field '${head present}' in struct '${name}'"); - - struct' = name: def: { - inherit name def; - check = value: - let fieldMatch = foldl' (checkField def value) true (attrNames def); - noExtras = checkExtraneous name def (attrNames value); - in (isAttrs value && fieldMatch && noExtras); - - __functor = self: value: if self.check value then value - else (throw "Expected '${self.name}'-struct, but ${toPretty value} is of type ${typeOf value}"); + # typedef is the simplified version of typedef' which uses a default + # error message constructor. + typedef = name: check: typedef' { + inherit name; + checkType = check; + checkToBool = r: r; + toError = value: _result: typeError name value; }; - struct = arg: if isString arg then (struct' arg) - else (struct' "anonymous" arg); - - enum = name: values: rec { - inherit name values; - check = (x: elem x values); - __functor = self: x: if self.check x then x - else (throw "'${x}' is not a member of enum '${self.name}'"); - match = x: actions: let - actionKeys = map (__functor { inherit name check; }) (attrNames actions); - missing = foldl' (m: k: if (elem k actionKeys) then m else m ++ [ k ]) [] values; - in if (length missing) > 0 - then throw "Missing match action for members: ${toPretty missing}" - else actions."${__functor { inherit name check; } x}"; + checkEach = name: t: l: foldl' (acc: e: + let res = t.checkType e; + isT = t.checkToBool res; + in { + ok = acc.ok && isT; + err = if isT + then acc.err + else acc.err + "${prettyPrint e}: ${t.toError e res}\n"; + }) { ok = true; err = "expected type ${name}, but found:\n"; } l; +in lib.fix (self: { + # Primitive types + any = typedef "any" (_: true); + int = typedef "int" isInt; + bool = typedef "bool" isBool; + float = typedef "float" isFloat; + string = typedef "string" isString; + drv = typedef "derivation" (x: isAttrs x && x ? "type" && x.type == "derivation"); + function = typedef "function" (x: isFunction x || (isAttrs x && x ? "__functor" + && isFunction x.__functor)); + + # Type for types themselves. Useful when defining polymorphic types. + type = typedef "type" (x: + isAttrs x + && hasAttr "name" x && self.string.check x.name + && hasAttr "checkType" x && self.function.check x.checkType + && hasAttr "checkToBool" x && self.function.check x.checkToBool + && hasAttr "toError" x && self.function.check x.toError + ); + + # Polymorphic types + option = t: typedef' rec { + name = "option<${t.name}>"; + checkType = v: + let res = t.checkType v; + in { + ok = isNull v || (self.type t).checkToBool res; + err = "expected type ${name}, but value does not conform to '${t.name}': " + + t.toError v res; + }; }; - sum = name: values: let - isVariant = x: - let name = elemAt (attrNames x) 0; - in if hasAttr name values - then values."${name}".check x."${name}" - else false; - check = x: isAttrs x && length (attrNames x) == 1 && isVariant x; - in { - inherit name values check; - __functor = self: x: if self.check x - then x - else throw "'${toPretty x}' is not a valid variant of '${name}'"; + either = t1: t2: typedef "either<${t1.name},${t2.name}>" + (x: (self.type t1).check x || (self.type t2).check x); + + list = t: typedef' rec { + name = "list<${t.name}>"; + + checkType = v: if isList v + then checkEach name (self.type t) v + else { + ok = false; + err = typeError name v; + }; }; - mkFunc = sig: f: { - inherit sig; - __toString = self: foldl' (s: t: "${s} -> ${t.name}") - "λ :: ${(head self.sig).name}" (tail self.sig); - __functor = _: f; + attrs = t: typedef' rec { + name = "attrs<${t.name}>"; + + checkType = v: if isAttrs v + then checkEach name (self.type t) (attrValues v) + else { + ok = false; + err = typeError name v; + }; }; - defun' = sig: func: if length sig > 2 - then mkFunc sig (x: defun' (tail sig) (func ((head sig) x))) - else mkFunc sig (x: ((head (tail sig)) (func ((head sig) x)))); - - defun = sig: func: if length sig < 2 - then (throw "Signature must at least have two types (a -> b)") - else defun' sig func; -in (typeSet [ - # Primitive types - (typedef "any" (_: true)) - (typedef "int" isInt) - (typedef "bool" isBool) - (typedef "float" isFloat) - (typedef "string" isString) - (typedef "derivation" (x: isAttrs x && x ? "type" && x.type == "derivation")) - (typedef "function" (x: isFunction x || (isAttrs x && x ? "__functor" - && isFunction x.__functor))) - # Polymorphic types - (poly "option" (t: v: (isNull v) || t.check v)) - (poly "list" (t: v: isList v && (foldl' (s: e: s && ( - if t.check e then true - else throw "Expected list element of type '${t.name}', but '${toPretty e}' is of type '${typeOf e}'" - )) true v))) + # Structs / record types + # + # Checks that all fields match their declared types, no optional + # fields are missing and no unexpected fields occur in the struct. + # + # Anonymous structs are supported (e.g. for nesting) by omitting the + # name. + # + # TODO: Support open records? + struct = + # Struct checking is more involved than the simpler types above. + # To make the actual type definition more readable, several + # helpers are defined below. + let + # checkField checks an individual field of the struct against + # its definition and creates a typecheck result. These results + # are aggregated during the actual checking. + checkField = def: name: value: let result = def.checkType value; in rec { + ok = def.checkToBool result; + err = if !ok && isNull value + then "missing required ${def.name} field '${name}'\n" + else "field '${name}': ${def.toError value result}\n"; + }; + + # checkExtraneous determines whether a (closed) struct contains + # any fields that are not part of the definition. + checkExtraneous = def: has: acc: + if (length has) == 0 then acc + else if (hasAttr (head has) def) + then checkExtraneous def (tail has) acc + else checkExtraneous def (tail has) { + ok = false; + err = acc.err + "unexpected struct field '${head has}'\n"; + }; + + # checkStruct combines all structure checks and creates one + # typecheck result from them + checkStruct = def: value: + let + init = { ok = true; err = ""; }; + extraneous = checkExtraneous def (attrNames value) init; + + checkedFields = map (n: + let v = if hasAttr n value then value."${n}" else null; + in checkField def."${n}" n v) (attrNames def); + + combined = foldl' (acc: res: { + ok = acc.ok && res.ok; + err = if !res.ok then acc.err + res.err else acc.err; + }) init checkedFields; + in { + ok = combined.ok && extraneous.ok; + err = combined.err + extraneous.err; + }; + + struct' = name: def: typedef' { + inherit name def; + checkType = value: if isAttrs value + then (checkStruct (self.attrs self.type def) value) + else { ok = false; err = typeError name value; }; + + toError = _: result: "expected '${name}'-struct, but found:\n" + result.err; + }; + in arg: if isString arg then (struct' arg) else (struct' "anon" arg); + + # Enums & pattern matching + enum = + let + plain = name: def: typedef' { + inherit name def; + + checkType = (x: isString x && elem x def); + checkToBool = x: x; + toError = value: _: "'${prettyPrint value} is not a member of enum ${name}"; + }; + enum' = name: def: lib.fix (e: (plain name def) // { + match = x: actions: deepSeq (map e (attrNames actions)) ( + let + actionKeys = attrNames actions; + missing = foldl' (m: k: if (elem k actionKeys) then m else m ++ [ k ]) [] def; + in if (length missing) > 0 + then throw "Missing match action for members: ${prettyPrint missing}" + else actions."${e x}"); + }); + in arg: if isString arg then (enum' arg) else (enum' "anon" arg); + + # Sum types + # + # The representation of a sum type is an attribute set with only one + # value, where the key of the value denotes the variant of the type. + sum = + let + plain = name: def: typedef' { + inherit name def; + checkType = (x: + let variant = elemAt (attrNames x) 0; + in if isAttrs x && length (attrNames x) == 1 && hasAttr variant def + then let t = def."${variant}"; + v = x."${variant}"; + res = t.checkType v; + in if t.checkToBool res + then { ok = true; } + else { + ok = false; + err = "while checking '${name}' variant '${variant}': " + + t.toError v res; + } + else { ok = false; err = typeError name x; } + ); + }; + sum' = name: def: lib.fix (s: (plain name def) // { + match = x: actions: + let variant = deepSeq (s x) (elemAt (attrNames x) 0); + actionKeys = attrNames actions; + defKeys = attrNames def; + missing = foldl' (m: k: if (elem k actionKeys) then m else m ++ [ k ]) [] defKeys; + in if (length missing) > 0 + then throw "Missing match action for variants: ${prettyPrint missing}" + else actions."${variant}" x."${variant}"; + }); + in arg: if isString arg then (sum' arg) else (sum' "anon" arg); + + # Typed function definitions + # + # These definitions wrap the supplied function in type-checking + # forms that are evaluated when the function is called. + # + # Note that typed functions themselves are not types and can not be + # used to check values for conformity. + defun = + let + mkFunc = sig: f: { + inherit sig; + __toString = self: foldl' (s: t: "${s} -> ${t.name}") + "λ :: ${(head self.sig).name}" (tail self.sig); + __functor = _: f; + }; - (poly "attrs" (t: v: isAttrs v && (foldl' (s: e: s && ( - if t.check e then true - else throw "Expected attribute set element of type '${t.name}', but '${toPretty e}' is of type '${typeOf e}'" - )) true (attrValues v)))) + defun' = sig: func: if length sig > 2 + then mkFunc sig (x: defun' (tail sig) (func ((head sig) x))) + else mkFunc sig (x: ((head (tail sig)) (func ((head sig) x)))); - (poly2 "either" (t1: t2: v: t1.check v || t2.check v)) -]) // { inherit struct enum sum defun; } + in sig: func: if length sig < 2 + then (throw "Signature must at least have two types (a -> b)") + else defun' sig func; +}) |