module system: extensible option types

1 files changed, 115 insertions, 27 deletions

diff --git a/lib/types.nix b/lib/types.nix
index 991fa0e5c29..26523f59f25 100644
--- a/lib/types.nix
+++ b/lib/types.nix
@@ -17,10 +17,43 @@ rec {
   };
 
 
+  # Default type merging function
+  # takes two type functors and return the merged type
+  defaultTypeMerge = f: f':
+    let wrapped = f.wrapped.typeMerge f'.wrapped.functor;
+        payload = f.binOp f.payload f'.payload;
+    in
+    # cannot merge different types
+    if f.name != f'.name
+       then null
+    # simple types
+    else if    (f.wrapped == null && f'.wrapped == null)
+            && (f.payload == null && f'.payload == null)
+       then f.type
+    # composed types
+    else if (f.wrapped != null && f'.wrapped != null) && (wrapped != null)
+       then f.type wrapped
+    # value types
+    else if (f.payload != null && f'.payload != null) && (payload != null)
+       then f.type payload
+    else null;
+
+  # Default type functor
+  defaultFunctor = name: {
+    inherit name;
+    type    = types."${name}" or null;
+    wrapped = null;
+    payload = null;
+    binOp   = a: b: null;
+  };
+
   isOptionType = isType "option-type";
   mkOptionType =
-    { # Human-readable representation of the type.
+    { # Human-readable representation of the type, should be equivalent to
+      # the type function name.
       name
+    , # Description of the type, defined recursively by embedding the the wrapped type if any.
+      description ? null
     , # Function applied to each definition that should return true if
       # its type-correct, false otherwise.
       check ? (x: true)
@@ -36,12 +69,26 @@ rec {
       getSubOptions ? prefix: {}
     , # List of modules if any, or null if none.
       getSubModules ? null
-    , # Function for building the same option type  with a different list of
+    , # Function for building the same option type with a different list of
       # modules.
       substSubModules ? m: null
+    , # Function that merge type declarations.
+      # internal, takes a functor as argument and returns the merged type.
+      # returning null means the type is not mergeable
+      typeMerge ? defaultTypeMerge functor
+    , # The type functor.
+      # internal, representation of the type as an attribute set.
+      #   name: name of the type
+      #   type: type function.
+      #   wrapped: the type wrapped in case of compound types.
+      #   payload: values of the type, two payloads of the same type must be 
+      #            combinable with the binOp binary operation.
+      #   binOp: binary operation that merge two payloads of the same type.
+      functor ? defaultFunctor name
     }:
     { _type = "option-type";
-      inherit name check merge getSubOptions getSubModules substSubModules;
+      inherit name check merge getSubOptions getSubModules substSubModules typeMerge functor;
+      description = if description == null then name else description;
     };
 
 
@@ -52,29 +99,39 @@ rec {
     };
 
     bool = mkOptionType {
-      name = "boolean";
+      name = "bool";
+      description = "boolean";
       check = isBool;
       merge = mergeEqualOption;
     };
 
-    int = mkOptionType {
-      name = "integer";
+    int = mkOptionType rec {
+      name = "int";
+      description = "integer";
       check = isInt;
       merge = mergeOneOption;
     };
 
     str = mkOptionType {
-      name = "string";
+      name = "str";
+      description = "string";
       check = isString;
       merge = mergeOneOption;
     };
 
     # Merge multiple definitions by concatenating them (with the given
     # separator between the values).
-    separatedString = sep: mkOptionType {
-      name = "string";
+    separatedString = sep: mkOptionType rec {
+      name = "separatedString";
+      description = "string";
       check = isString;
       merge = loc: defs: concatStringsSep sep (getValues defs);
+      functor = (defaultFunctor name) // {
+        payload = sep;
+        binOp = sepLhs: sepRhs:
+          if sepLhs == sepRhs then sepLhs
+          else null;
+      };
     };
 
     lines = separatedString "\n";
@@ -86,7 +143,8 @@ rec {
     string = separatedString "";
 
     attrs = mkOptionType {
-      name = "attribute set";
+      name = "attrs";
+      description = "attribute set";
       check = isAttrs;
       merge = loc: foldl' (res: def: mergeAttrs res def.value) {};
     };
@@ -114,8 +172,9 @@ rec {
     # drop this in the future:
     list = builtins.trace "`types.list' is deprecated; use `types.listOf' instead" types.listOf;
 
-    listOf = elemType: mkOptionType {
-      name = "list of ${elemType.name}s";
+    listOf = elemType: mkOptionType rec {
+      name = "listOf";
+      description = "list of ${elemType.description}s";
       check = isList;
       merge = loc: defs:
         map (x: x.value) (filter (x: x ? value) (concatLists (imap (n: def:
@@ -132,10 +191,12 @@ rec {
       getSubOptions = prefix: elemType.getSubOptions (prefix ++ ["*"]);
       getSubModules = elemType.getSubModules;
       substSubModules = m: listOf (elemType.substSubModules m);
+      functor = (defaultFunctor name) // { wrapped = elemType; };
     };
 
-    attrsOf = elemType: mkOptionType {
-      name = "attribute set of ${elemType.name}s";
+    attrsOf = elemType: mkOptionType rec {
+      name = "attrsOf";
+      description = "attribute set of ${elemType.description}s";
       check = isAttrs;
       merge = loc: defs:
         mapAttrs (n: v: v.value) (filterAttrs (n: v: v ? value) (zipAttrsWith (name: defs:
@@ -147,6 +208,7 @@ rec {
       getSubOptions = prefix: elemType.getSubOptions (prefix ++ ["<name>"]);
       getSubModules = elemType.getSubModules;
       substSubModules = m: attrsOf (elemType.substSubModules m);
+      functor = (defaultFunctor name) // { wrapped = elemType; };
     };
 
     # List or attribute set of ...
@@ -165,18 +227,21 @@ rec {
             def;
         listOnly = listOf elemType;
         attrOnly = attrsOf elemType;
-      in mkOptionType {
-        name = "list or attribute set of ${elemType.name}s";
+      in mkOptionType rec {
+        name = "loaOf";
+        description = "list or attribute set of ${elemType.description}s";
         check = x: isList x || isAttrs x;
         merge = loc: defs: attrOnly.merge loc (imap convertIfList defs);
         getSubOptions = prefix: elemType.getSubOptions (prefix ++ ["<name?>"]);
         getSubModules = elemType.getSubModules;
         substSubModules = m: loaOf (elemType.substSubModules m);
+        functor = (defaultFunctor name) // { wrapped = elemType; };
       };
 
     # List or element of ...
-    loeOf = elemType: mkOptionType {
-      name = "element or list of ${elemType.name}s";
+    loeOf = elemType: mkOptionType rec {
+      name = "loeOf";
+      description = "element or list of ${elemType.description}s";
       check = x: isList x || elemType.check x;
       merge = loc: defs:
         let
@@ -189,18 +254,22 @@ rec {
         else if !isString res then
           throw "The option `${showOption loc}' does not have a string value, in ${showFiles (getFiles defs)}."
         else res;
+      functor = (defaultFunctor name) // { wrapped = elemType; };
     };
 
-    uniq = elemType: mkOptionType {
-      inherit (elemType) name check;
+    uniq = elemType: mkOptionType rec {
+      name = "uniq";
+      inherit (elemType) description check;
       merge = mergeOneOption;
       getSubOptions = elemType.getSubOptions;
       getSubModules = elemType.getSubModules;
       substSubModules = m: uniq (elemType.substSubModules m);
+      functor = (defaultFunctor name) // { wrapped = elemType; };
     };
 
-    nullOr = elemType: mkOptionType {
-      name = "null or ${elemType.name}";
+    nullOr = elemType: mkOptionType rec {
+      name = "nullOr";
+      description = "null or ${elemType.description}";
       check = x: x == null || elemType.check x;
       merge = loc: defs:
         let nrNulls = count (def: def.value == null) defs; in
@@ -211,6 +280,7 @@ rec {
       getSubOptions = elemType.getSubOptions;
       getSubModules = elemType.getSubModules;
       substSubModules = m: nullOr (elemType.substSubModules m);
+      functor = (defaultFunctor name) // { wrapped = elemType; };
     };
 
     submodule = opts:
@@ -236,6 +306,12 @@ rec {
             args = { name = ""; }; }).options;
         getSubModules = opts';
         substSubModules = m: submodule m;
+        functor = (defaultFunctor name) // {
+          # Merging of submodules is done as part of mergeOptionDecls, as we have to annotate
+          # each submodule with its location.
+          payload = [];
+          binOp = lhs: rhs: [];
+        };
       };
 
     enum = values:
@@ -245,23 +321,35 @@ rec {
           else if builtins.isInt v then builtins.toString v
           else ''<${builtins.typeOf v}>'';
       in
-      mkOptionType {
-        name = "one of ${concatMapStringsSep ", " show values}";
+      mkOptionType rec {
+        name = "enum";
+        description = "one of ${concatMapStringsSep ", " show values}";
         check = flip elem values;
         merge = mergeOneOption;
+        functor = (defaultFunctor name) // { payload = values; binOp = a: b: unique (a ++ b); };
       };
 
-    either = t1: t2: mkOptionType {
-      name = "${t1.name} or ${t2.name}";
+    either = t1: t2: mkOptionType rec {
+      name = "either";
+      description = "${t1.description} or ${t2.description}";
       check = x: t1.check x || t2.check x;
       merge = mergeOneOption;
+      typeMerge = f':
+        let mt1 = t1.typeMerge (elemAt f'.wrapped 0).functor;
+            mt2 = t2.typeMerge (elemAt f'.wrapped 1).functor;
+        in
+           if (name == f'.name) && (mt1 != null) && (mt2 != null)
+           then functor.type mt1 mt2
+           else null;
+      functor = (defaultFunctor name) // { wrapped = [ t1 t2 ]; };
     };
 
     # Obsolete alternative to configOf.  It takes its option
     # declarations from the ‘options’ attribute of containing option
     # declaration.
     optionSet = mkOptionType {
-      name = builtins.trace "types.optionSet is deprecated; use types.submodule instead" "option set";
+      name = builtins.trace "types.optionSet is deprecated; use types.submodule instead" "optionSet";
+      description = "option set";
     };
 
     # Augment the given type with an additional type check function.