[m-rev.] for review / comment: structured errors for getopt

Julien Fischer jfischer at opturion.com
Tue Mar 25 17:21:34 AEDT 2014


For review / feedback.

I'm not intending to push this to github in its current form; in requesting a review
I am mainly seeking feedback on the following things:

(1) the overall proposal.

(2) in particular, the names of the constructors of the option_error/1 type and
     their documentation.

Before pushing this change (in whatever form it ends up) a corresponding set of
changes will be made to library/getopt.m.

Julien.

--------------------

Predicates in the getopt_io module currently return strings that describe
errors that occur during option processing.  There are a couple of problems
with this:

(1) it makes some assumptions about how client programs want to word, and to a
large extent, format these error messages.

(2) it assumes that the error messages are in English.

This diff changes the getopt_io library to return errors as values of a
structured type instead of strings.  The structured representation of getopt
errors is given by the new option_error/1 type.  We introduce new versions of
the various process_options predicates that are suffixed with "_se" (standing
for "structured error") that return values of type option_error/1.  A new
function, option_error_to_string/1, converts, option_error/1 values into the
strings that the getopt_io module previously generated as errors.  The existing
process_options predicates are just wrappers around all of this for the
purposes of backwards compatibility.

The new option_error/1 type returns more information than existing error
messages require, for example, where possible we return both the element of the
option enumeration involved and a string giving the option as it actually
appeared on the command line.

library/getopt_io.m:
 	Make the above changes.

diff --git a/library/getopt_io.m b/library/getopt_io.m
index 84ea522..69cac88 100644
--- a/library/getopt_io.m
+++ b/library/getopt_io.m
@@ -153,6 +153,27 @@
      option_table(OptionType)::in, maybe_option_table(OptionType)::out,
      set(OptionType)::out, io::di, io::uo) is det.

+% Variants of the above that return structured errors.
+% These behave as the above versions except that any error values returned are
+% members of the option_error/1 type rather than strings.
+
+:- pred getopt_io.process_options_se(option_ops(OptionType)::in(option_ops),
+    list(string)::in, list(string)::out, maybe_option_table_se(OptionType)::out,
+    io::di, io::uo) is det.
+
+:- pred getopt_io.process_options_se(option_ops(OptionType)::in(option_ops),
+    list(string)::in, list(string)::out, list(string)::out,
+    maybe_option_table_se(OptionType)::out, io::di, io::uo) is det.
+
+% getopt_io.process_options_track(OptionOps, Args, OptionArgs,
+%       NonOptionArgs, OptionTable0, Result, OptionsSet)
+
+:- pred getopt_io.process_options_track_se(
+    option_ops_track(OptionType)::in(option_ops_track),
+    list(string)::in, list(string)::out, list(string)::out,
+    option_table(OptionType)::in, maybe_option_table_se(OptionType)::out,
+    set(OptionType)::out, io::di, io::uo) is det.
+
  :- pred init_option_table(
      pred(OptionType, option_data)::in(pred(out, out) is nondet),
      option_table(OptionType)::out) is det.
@@ -255,12 +276,78 @@
      ;       string(string)
      ;       maybe_string(maybe(string)).

-:- type option_table(OptionType) ==  map(OptionType, option_data).
+:- type option_table(OptionType) == map(OptionType, option_data).

  :- type maybe_option_table(OptionType)
      --->    ok(option_table(OptionType))
      ;       error(string).

+:- type maybe_option_table_se(OptionType)
+    --->    ok(option_table(OptionType))
+    ;       error(option_error(OptionType)).
+
+:- type option_error(OptionType)
+    --->    unrecognized(string)
+            % An option that is not recognized appeared on the command line.
+            % The argument gives the option as it appeared on the command line.
+
+    % The first two arguments of the remaining constructors of this type
+    % identify the option enumeration value and the string that appeared on the
+    % command line for that option respectively.
+
+    ;       unknown_type(OptionType, string)
+            % No type has been specified for the option.
+
+    ;       requires_argument(OptionType, string)
+            % The option requires an argument but it occurred on the command
+            % line without one.
+
+    ;       does_not_allow_argument(OptionType, string, string)
+            % The option does not allow an argument but it was provided with
+            % one on the command line.
+            % The third argument gives the contents of the argument position
+            % on the command line.
+
+    ;       cannot_negate(OptionType, string)
+            % The option cannot be negated but its negated form appeared on
+            % the command line.
+
+    ;       special_handler_failed(OptionType, string)
+            % The special option handler predicate for the option failed.
+
+    ;       special_handler_missing(OptionType, string)
+            % A special option handler predicate was not provided for the option.
+
+    ;       special_handler_error(OptionType, string, string)
+            % The special option handler predicate for the option returned an
+            % error.
+            % The third argument is a string describing the error.
+
+    ;       requires_numeric_argument(OptionType, string, string)
+            % The option requires a numeric argument but it occurred on the
+            % command line with a non-numeric argument.
+            % The third argument gives the argument as it appeared on the 
+            % command line.
+
+    ;       file_special_cannot_open(OptionType, string, string, io.error)
+            % The option is a file_special option whose argument is the file
+            % named by the third argument.
+            % Attempting to open this file resulted in the I/O error given
+            % by the fourth argument.
+
+    ;       file_special_cannot_read(OptionType, string, string, io.error)
+            % The option is a file_special option whose argument is the file
+            % named by the third argument.
+            % Attempting to read from this file resulted in the I/O error given
+            % by the fourth argument.
+
+    ;       file_special_contains_non_option_args(OptionType, string, string).
+            % The option is a file_special option whose argument is the file
+            % named by the third argument.  This file contained some non-option
+            % arguments.
+
+:- func getopt_io.option_error_to_string(option_error(OptionType)) = string.
+
      % The following three predicates search the option table for
      % an option of the specified type; if it is not found, they
      % report an error by calling error/1.
@@ -357,11 +444,47 @@ init_option_table_multi(OptionDefaultsPred, OptionTable) :-
          ), OptionDefaultsList),
      map.from_assoc_list(OptionDefaultsList, OptionTable).

-getopt_io.process_options(OptionOps, Args0, NonOptionArgs, Result, !IO) :-
-    getopt_io.process_options(OptionOps, Args0, _OptionArgs, NonOptionArgs,
+process_options(OptionOps, Args0, NonOptionArgs, Result, !IO) :-
+    process_options_se(OptionOps, Args0, NonOptionArgs, Result0, !IO),
+    (
+        Result0 = ok(OptionTable),
+        Result = ok(OptionTable)
+    ;
+        Result0 = error(Error),
+        Msg = option_error_to_string(Error),
+        Result = error(Msg)
+    ).
+
+process_options(OptionOps, Args0, OptionArgs, NonOptionArgs, Result, !IO) :-
+    process_options_se(OptionOps, Args0, OptionArgs, NonOptionArgs, Result0,
+        !IO),
+    (
+        Result0 = ok(OptionTable),
+        Result = ok(OptionTable)
+    ;
+        Result0 = error(Error),
+        Msg = option_error_to_string(Error),
+        Result = error(Msg)
+    ).
+
+process_options_track(OptionOps, Args0, OptionArgs, NonOptionArgs,
+        OptionTable0, Result, OptionsSet, !IO) :-
+    process_options_track_se(OptionOps, Args0, OptionArgs, NonOptionArgs,
+        OptionTable0, Result0, OptionsSet, !IO),
+    (
+        Result0 = ok(OptionTable),
+        Result = ok(OptionTable)
+    ;
+        Result0 = error(Error),
+        Msg = option_error_to_string(Error),
+        Result = error(Msg)
+    ).
+
+getopt_io.process_options_se(OptionOps, Args0, NonOptionArgs, Result, !IO) :-
+    getopt_io.process_options_se(OptionOps, Args0, _OptionArgs, NonOptionArgs,
          Result, !IO).

-getopt_io.process_options(OptionOps, Args0, OptionArgs, NonOptionArgs, Result,
+getopt_io.process_options_se(OptionOps, Args0, OptionArgs, NonOptionArgs, Result,
          !IO) :-
      (
          OptionOps = option_ops(Short, Long, Defaults),
@@ -385,7 +508,7 @@ getopt_io.process_options(OptionOps, Args0, OptionArgs, NonOptionArgs, Result,
          [], RevOptionArgs, OptionTable0, Result, set.init, _OptionsSet, !IO),
      OptionArgs = list.reverse(RevOptionArgs).

-getopt_io.process_options_track(OptionOps, Args0, OptionArgs, NonOptionArgs,
+getopt_io.process_options_track_se(OptionOps, Args0, OptionArgs, NonOptionArgs,
          OptionTable0, Result, OptionsSet, !IO) :-
      OptionOps = option_ops_track(Short, Long, Special),
      Internal = option_ops_internal(Short, Long, track(Special)),
@@ -396,7 +519,7 @@ getopt_io.process_options_track(OptionOps, Args0, OptionArgs, NonOptionArgs,
  :- pred getopt_io.process_arguments(list(string)::in, list(string)::out,
      option_ops_internal(OptionType)::in(option_ops_internal), list(string)::in,
      list(string)::out, option_table(OptionType)::in,
-    maybe_option_table(OptionType)::out,
+    maybe_option_table_se(OptionType)::out,
      set(OptionType)::in, set(OptionType)::out, io::di, io::uo) is det.

  getopt_io.process_arguments([], [], _, OptionArgs, OptionArgs,
@@ -425,8 +548,8 @@ getopt_io.process_arguments([Option | Args0], Args, OptionOps,
                  Args = Args0
              )
          ;
-            ErrorMsg = "unrecognized option `-" ++ Option ++ "'",
-            Result = error(ErrorMsg),
+            Error = unrecognized(Option),
+            Result = error(Error),
              OptionArgs = OptionArgs0,
              Args = Args0
          )
@@ -452,14 +575,14 @@ getopt_io.process_arguments([Option | Args0], Args, OptionOps,
                      [Option | OptionArgs0], OptionArgs,
                      OptionTable0, Result, !OptionsSet, !IO)
              ;
-                ErrorMsg = "unknown type for option `" ++ Option ++ "'",
-                Result = error(ErrorMsg),
+                Error = unknown_type(Flag, Option),
+                Result = error(Error),
                  OptionArgs = OptionArgs0,
                  Args = Args0
              )
          ;
-            ErrorMsg = "unrecognized option `" ++ OptionName ++ "'",
-            Result = error(ErrorMsg),
+            Error = unrecognized(OptionName),
+            Result = error(Error),
              OptionArgs = OptionArgs0,
              Args = Args0
          )
@@ -484,8 +607,8 @@ getopt_io.process_arguments([Option | Args0], Args, OptionOps,
                      Args = Args0
                  )
              ;
-                ErrorMsg = "unrecognized option `-" ++ ShortOptions ++ "'",
-                Result = error(ErrorMsg),
+                Error = unrecognized("-" ++ ShortOptions),
+                Result = error(Error),
                  OptionArgs = OptionArgs0,
                  Args = Args0
              )
@@ -524,7 +647,7 @@ getopt_io.process_arguments([Option | Args0], Args, OptionOps,
      maybe(string)::in, list(string)::in, list(string)::out,
      option_ops_internal(OptionType)::in(option_ops_internal), list(string)::in,
      list(string)::out, option_table(OptionType)::in,
-    maybe_option_table(OptionType)::out,
+    maybe_option_table_se(OptionType)::out,
      set(OptionType)::in, set(OptionType)::out, io::di, io::uo) is det.

  getopt_io.handle_long_option(Option, Flag, OptionData, MaybeOptionArg0,
@@ -556,16 +679,16 @@ getopt_io.handle_long_option(Option, Flag, OptionData, MaybeOptionArg0,
      ( MissingArg = yes ->
          Args = Args0,
          OptionArgs = OptionArgs1,
-        ErrorMsg = "option `" ++ Option ++ "' needs an argument",
-        Result = error(ErrorMsg)
+        Error = requires_argument(Flag, Option),
+        Result = error(Error)
      ;
          getopt_io.need_arg(OptionData, no),
-        MaybeOptionArg = yes(_)
+        MaybeOptionArg = yes(ArgVal)
      ->
          Args = Args0,
          OptionArgs = OptionArgs1,
-        ErrorMsg = "option `" ++ Option ++ "' does not allow an argument",
-        Result = error(ErrorMsg)
+        Error = does_not_allow_argument(Flag, Option, ArgVal),
+        Result = error(Error)
      ;
          getopt_io.process_option(OptionData, Option, Flag, MaybeOptionArg,
              OptionOps, OptionTable0, Result1, !OptionsSet, !IO),
@@ -586,7 +709,7 @@ getopt_io.handle_long_option(Option, Flag, OptionData, MaybeOptionArg0,
      option_ops_internal(OptionType)::in(option_ops_internal), list(string)::in,
      list(string)::out, list(string)::in, list(string)::out,
      option_table(OptionType)::in,
-    maybe_option_table(OptionType)::out,
+    maybe_option_table_se(OptionType)::out,
      set(OptionType)::in, set(OptionType)::out, io::di, io::uo) is det.

  getopt_io.handle_short_options([], _, Args, Args, OptionArgs, OptionArgs,
@@ -623,15 +746,15 @@ getopt_io.handle_short_options([Opt | Opts0], OptionOps, Args0, Args,
              )
          ;
              string.char_to_string(Opt, OptString),
-            ErrorMsg = "unknown type for option `-" ++ OptString ++ "'",
-            Result = error(ErrorMsg),
+            Error = unknown_type(Flag, "-" ++ OptString),
+            Result = error(Error),
              OptionArgs = OptionArgs0,
              Args = Args0
          )
      ;
          string.char_to_string(Opt, OptString),
-        ErrorMsg = "unrecognized option `-" ++ OptString ++ "'",
-        Result = error(ErrorMsg),
+        Error = unrecognized("-" ++ OptString),
+        Result = error(Error),
          OptionArgs = OptionArgs0,
          Args = Args0
      ).
@@ -658,7 +781,7 @@ getopt_io.get_short_option_arg(Opts, Arg, Args0, Args,
  :- pred getopt_io.process_option(option_data::in, string::in, OptionType::in,
      maybe(string)::in, option_ops_internal(OptionType)::in(option_ops_internal),
      option_table(OptionType)::in,
-    maybe_option_table(OptionType)::out,
+    maybe_option_table_se(OptionType)::out,
      set(OptionType)::in, set(OptionType)::out, io::di, io::uo) is det.

  getopt_io.process_option(bool(_), _Option, Flag, MaybeArg, _OptionOps,
@@ -682,7 +805,7 @@ getopt_io.process_option(int(_), Option, Flag, MaybeArg, _OptionOps,
              map.set(Flag, int(IntArg), !OptionTable),
              Result = ok(!.OptionTable)
          ;
-            getopt_io.numeric_argument(Option, Arg, Result)
+            getopt_io.numeric_argument(Flag, Option, Arg, Result)
          )
      ;
          MaybeArg = no,
@@ -708,7 +831,7 @@ getopt_io.process_option(maybe_int(_), Option, Flag, MaybeArg, _OptionOps,
              map.set(Flag, maybe_int(yes(IntArg)), !OptionTable),
              Result = ok(!.OptionTable)
          ;
-            getopt_io.numeric_argument(Option, Arg, Result)
+            getopt_io.numeric_argument(Flag, Option, Arg, Result)
          )
      ;
          MaybeArg = no,
@@ -769,7 +892,7 @@ getopt_io.process_option(int_special, Option, Flag, MaybeArg, OptionOps,
              getopt_io.process_special(Option, Flag, int(IntArg),
                  OptionOps, OptionTable0, Result, !OptionsSet)
          ;
-            getopt_io.numeric_argument(Option, Arg, Result)
+            getopt_io.numeric_argument(Flag, Option, Arg, Result)
          )
      ;
          MaybeArg = no,
@@ -797,7 +920,7 @@ getopt_io.process_option(maybe_string_special, Option, Flag, MaybeArg,
          error("maybe_string_special argument expected " ++
              "in getopt_io.process_option")
      ).
-getopt_io.process_option(file_special, _Option, _Flag, MaybeArg, OptionOps,
+getopt_io.process_option(file_special, Option, Flag, MaybeArg, OptionOps,
          OptionTable0, Result, !OptionsSet, !IO) :-
      (
          MaybeArg = yes(FileName),
@@ -815,19 +938,22 @@ getopt_io.process_option(file_special, _Option, _Flag, MaybeArg, OptionOps,
                      Result = Result0
                  ;
                      Args = [_ | _],
-                    Result = error(FileName ++
-                        " contains non-option arguments")
+                    Error = file_special_contains_non_option_args(Flag,
+                        Option, FileName),
+                    Result = error(Error)
                  )
              ;
-                ReadRes = error(_, Error),
-                io.error_message(Error, Msg),
-                Result = error("cannot read " ++ FileName ++ ": " ++ Msg)
+                ReadRes = error(_, IO_Error),
+                Error = file_special_cannot_read(Flag, Option, FileName,
+                    IO_Error),
+                Result = error(Error)
              ),
              io.seen(!IO)
          ;
-            SeeRes = error(Error),
-            io.error_message(Error, Msg),
-            Result = error("cannot open " ++ FileName ++ ": " ++ Msg)
+            SeeRes = error(IO_Error),
+            Error = file_special_cannot_open(Flag, Option, FileName,
+                IO_Error),
+            Result = error(Error)
          )
      ;
          MaybeArg = no,
@@ -836,7 +962,7 @@ getopt_io.process_option(file_special, _Option, _Flag, MaybeArg, OptionOps,

  :- pred process_negated_option(string::in, OptionType::in,
      option_ops_internal(OptionType)::in(option_ops_internal),
-    option_table(OptionType)::in, maybe_option_table(OptionType)::out,
+    option_table(OptionType)::in, maybe_option_table_se(OptionType)::out,
      set(OptionType)::in, set(OptionType)::out) is det.

  process_negated_option(Option, Flag, OptionOps, OptionTable0, Result,
@@ -873,45 +999,24 @@ process_negated_option(Option, Flag, OptionOps, OptionTable0, Result,
              getopt_io.process_special(Option, Flag, maybe_string(no),
                  OptionOps, OptionTable0, Result, !OptionsSet)
          ;
-            OptionData = int_special,
-            ErrorMsg = "cannot negate option `" ++ Option ++ "' --" ++
-                "only boolean, maybe and accumulating options can be negated",
-            Result = error(ErrorMsg)
-        ;
-            OptionData = string_special,
-            ErrorMsg = "cannot negate option `" ++ Option ++ "' --" ++
-                "only boolean, maybe and accumulating options can be negated",
-            Result = error(ErrorMsg)
-        ;
-            OptionData = int(_),
-            ErrorMsg = "cannot negate option `" ++ Option ++ "' --" ++
-                "only boolean, maybe and accumulating options can be negated",
-            Result = error(ErrorMsg)
-        ;
-            OptionData = string(_),
-            ErrorMsg = "cannot negate option `" ++ Option ++ "' --" ++
-                "only boolean, maybe and accumulating options can be negated",
-            Result = error(ErrorMsg)
-        ;
-            OptionData = special,
-            ErrorMsg = "cannot negate option `" ++ Option ++ "' --" ++
-                "only boolean, maybe and accumulating options can be negated",
-            Result = error(ErrorMsg)
-        ;
-            OptionData = file_special,
-            ErrorMsg = "cannot negate option `" ++ Option ++ "' --" ++
-                "only boolean, maybe and accumulating options can be negated",
-            Result = error(ErrorMsg)
+            ( OptionData = int_special
+            ; OptionData = string_special
+            ; OptionData = int(_)
+            ; OptionData = string(_)
+            ; OptionData = special
+            ; OptionData = file_special
+            ),
+            Error = cannot_negate(Flag, Option),
+            Result = error(Error)
          )
      ;
-        string.append_list(["unknown type for option `", Option, "'"],
-            ErrorMsg),
-        Result = error(ErrorMsg)
+        Error = unknown_type(Flag, Option),
+        Result = error(Error)
      ).

  :- pred getopt_io.process_special(string::in, OptionType::in, special_data::in,
      option_ops_internal(OptionType)::in(option_ops_internal),
-    option_table(OptionType)::in, maybe_option_table(OptionType)::out,
+    option_table(OptionType)::in, maybe_option_table_se(OptionType)::out,
      set(OptionType)::in, set(OptionType)::out) is det.

  getopt_io.process_special(Option, Flag, OptionData, OptionOps,
@@ -922,11 +1027,17 @@ getopt_io.process_special(Option, Flag, OptionData, OptionOps,
          (
              Handler(Flag, OptionData, OptionTable0, Result0)
          ->
-            Result = Result0
+            (
+                Result0 = ok(OptionTable),
+                Result = ok(OptionTable)
+            ;
+                Result0 = error(HandlerMsg),
+                Error = special_handler_error(Flag, Option, HandlerMsg),
+                Result = error(Error)
+            )
          ;
-            string.append_list(["the handler of option `",
-                Option, "' failed"], ErrorMsg),
-            Result = error(ErrorMsg)
+            Error = special_handler_failed(Flag, Option),
+            Result = error(Error)
          )
      ;
          MaybeHandler = track(TrackHandler),
@@ -935,16 +1046,22 @@ getopt_io.process_special(Option, Flag, OptionData, OptionOps,
                  NewOptionsSet)
          ->
              set.union(NewOptionsSet, !OptionsSet),
-            Result = Result0
+            (
+                Result0 = ok(OptionTable),
+                Result = ok(OptionTable)
+            ; 
+                Result0 = error(TrackHandlerMsg),
+                Error = special_handler_error(Flag, Option, TrackHandlerMsg),
+                Result = error(Error)
+            )
          ;
-            string.append_list(["the handler of option `",
-                Option, "' failed"], ErrorMsg),
-            Result = error(ErrorMsg)
+            Error = special_handler_failed(Flag, Option),
+            Result = error(Error)
          )
      ;
          MaybeHandler = none,
-        ErrorMsg = "option `" ++ Option ++ "' has no handler",
-        Result = error(ErrorMsg)
+        Error = special_handler_missing(Flag, Option),
+        Result = error(Error)
      ).

  %-----------------------------------------------------------------------------%
@@ -964,13 +1081,58 @@ getopt_io.need_arg(string_special, yes).
  getopt_io.need_arg(maybe_string_special, yes).
  getopt_io.need_arg(file_special, yes).

-:- pred getopt_io.numeric_argument(string::in, string::in,
-    maybe_option_table(OptionType)::out) is det.
+:- pred getopt_io.numeric_argument(OptionType::in, string::in, string::in,
+    maybe_option_table_se(OptionType)::out) is det.
+
+getopt_io.numeric_argument(Flag, Option, Arg, Result) :-
+    Error = requires_numeric_argument(Flag, Option, Arg),
+    Result = error(Error).
+
+%-----------------------------------------------------------------------------%

-getopt_io.numeric_argument(Option, Arg, Result) :-
-    ErrorMsg = "option `" ++ Option ++
-        "' requires a numeric argument; `" ++ Arg ++ "' is not numeric",
-    Result = error(ErrorMsg).
+option_error_to_string(Error) = String :-
+    (
+        Error = unrecognized(OptionName),
+        string.format("unrecognized option `%s'", [s(OptionName)], String)
+    ;
+        Error = unknown_type(_, OptionName),
+        string.format("unknown type for option `%s'", [s(OptionName)], String)
+    ;
+        Error = requires_argument(_, OptionName),
+        string.format("option `%s' needs an argument", [s(OptionName)], String)
+    ;
+        Error = does_not_allow_argument(_, OptionName, _),
+        string.format("option `%s' does not allow an argument", [s(OptionName)], String)
+    ;
+        Error = cannot_negate(_, OptionName),
+        string.format("cannot negate option `%s' -- " ++
+            "only boolean, maybe and accumulating options can can be negated",
+            [s(OptionName)], String)
+    ;
+        Error = special_handler_failed(_, OptionName),
+        string.format("the handler of option `%s' failed",
+            [s(OptionName)], String)
+    ;
+        Error = special_handler_missing(_, OptionName),
+        string.format("option `%s' has no handler", [s(OptionName)], String)
+    ;
+        Error = special_handler_error(_, _, String)
+    ;
+        Error = requires_numeric_argument(_, OptionName, Arg),
+        string.format("option `%s' requires a numeric argument; `%s' is not numeric",
+            [s(OptionName), s(Arg)], String)
+    ;
+        Error = file_special_cannot_open(_, _, FileName, IO_Error),
+        io.error_message(IO_Error, Msg),
+        string.format("cannot open %s: %s", [s(FileName), s(Msg)], String)
+    ;
+        Error = file_special_cannot_read(_, _, FileName, IO_Error),
+        io.error_message(IO_Error, Msg),
+        string.format("cannot read %s: %s", [s(FileName), s(Msg)], String)
+    ;
+        Error = file_special_contains_non_option_args(_, _, FileName),
+        string.format("%s contains non-option arguments", [s(FileName)], String)
+    ).

  %-----------------------------------------------------------------------------%


More information about the reviews mailing list