about summary refs log tree commit diff
path: root/yants.nix
blob: 26c5b317c9fb8b0964395d7eb1cb18f17cdd92f6 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
# Copyright 2019 Google LLC
# SPDX-License-Identifier: Apache-2.0
#
# Provides a "type-system" for Nix that provides various primitive &
# polymorphic types as well as the ability to define & check records.
#
# All types (should) compose as expected.

{ toPretty ? ((import <nixpkgs> {}).lib.generators.toPretty {}) }:

with builtins; let
  typeError = type: val:
  throw "Expected type '${type}', but value '${toPretty val}' is of type '${typeOf val}'";

  typedef = name: check: {
    inherit name check;
    __functor = self: value:
      if check value then value
      else typeError name value;
  };

  poly = n: c: { "${n}" = t: typedef "${n}<${t.name}>" (c t); };

  poly2 = n: c: {
    "${n}" = t1: t2: typedef "${n}<${t1.name},${t2.name}>" (c t1 t2);
  };

  typeSet = foldl' (s: t: s // (if t ? "name" then { "${t.name}" = t; } else t)) {};

  # Struct implementation. 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.
  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}");
  };

  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}";
  };

  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}'";
  };

  mkFunc = sig: f: {
    inherit sig;
    __toString = self: foldl' (s: t: "${s} -> ${t.name}")
                              "λ :: ${(head self.sig).name}" (tail self.sig);
    __functor = _: f;
  };
  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)))

  (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))))

  (poly2 "either" (t1: t2: v: t1.check v || t2.check v))
]) // { inherit struct enum sum defun; }