Added a cmp function

8 files changed, 96 insertions, 38 deletions

diff --git a/lib/configuration/expression_parser.mly b/lib/configuration/expression_parser.mly
index 1304c4d..54f3bfe 100644
--- a/lib/configuration/expression_parser.mly
+++ b/lib/configuration/expression_parser.mly
@@ -36,6 +36,8 @@
             ImportExpression.T.Function' (ImportExpression.T.Upper, param)
         | "trim", _ -> 
             ImportExpression.T.Function' (ImportExpression.T.Trim, param)
+        | "cmp", _ -> 
+            ImportExpression.T.Function' (ImportExpression.T.Cmp, param)
         | other, _ -> 
             ImportExpression.T.Function (other, param)
 
diff --git a/lib/expression/query.ml b/lib/expression/query.ml
index 5bd914a..89c9e0a 100644
--- a/lib/expression/query.ml
+++ b/lib/expression/query.ml
@@ -1,22 +1,20 @@
-(** 
- This module create an sql query from an expression.
- *)
+(** This module create an sql query from an expression. *)
 
 open StdLabels
 
-(** This type is used in the query builder (see [query_of_expression] just
-    below in order to tell if we need to bind the parameters in the query, or
-    if we can use plain literal as is (with some risk at the execution time. *)
+(** This type is used in the query builder (see [query_of_expression] just below
+    in order to tell if we need to bind the parameters in the query, or if we
+    can use plain literal as is (with some risk at the execution time. *)
 type _ binded_query =
   | BindParam : ImportCSV.DataType.t Queue.t binded_query
   | NoParam : unit binded_query
 
 module QueryParameter = struct
-  (** Internaly, we need to keep a different type for the Literal chunks
-    (which requires to be quoted), and raw (which should be given as is to the
-    sql engine) 
+  (** Internaly, we need to keep a different type for the Literal chunks (which
+      requires to be quoted), and raw (which should be given as is to the sql
+      engine)
 
-    The Raw can be generated from both BindParam or NoParam queries. *)
+      The Raw can be generated from both BindParam or NoParam queries. *)
   type t =
     | Literal
     | Queue of ImportCSV.DataType.t Queue.t
@@ -28,10 +26,10 @@ module QueryParameter = struct
     | Literal -> Raw Literal
     | Queue q -> Raw (Queue q)
 
-  (** Nest the parameter in order to use it inside another function call. 
+  (** Nest the parameter in order to use it inside another function call.
 
-      The rule is to get out of the Raw mode as soon as we dive into another
-      one function. *)
+      The rule is to get out of the Raw mode as soon as we dive into another one
+      function. *)
   let nest : t -> t = function
     | Raw t -> t
     | other -> other
@@ -54,8 +52,8 @@ module Query = TypeBuilder.Make (struct
     let () = x formatter ~nested in
     Format.pp_print_flush formatter ()
 
-  (** Unify an external reference with a given type, using the COALESCE
-        function *)
+  (** Unify an external reference with a given type, using the COALESCE function
+  *)
   let unify :
       with_:Type_of.t ->
       nested:QueryParameter.t ->
@@ -139,8 +137,8 @@ module Query = TypeBuilder.Make (struct
        (fun f v -> (snd v) f ~nested))
       formatter expression
 
-  (** Format the partition expression. This function is used internally and
-      only form the expression inside the clause. *)
+  (** Format the partition expression. This function is used internally and only
+      form the expression inside the clause. *)
   let group_windows :
       QueryParameter.t ->
       Format.formatter ->
@@ -311,12 +309,26 @@ module Query = TypeBuilder.Make (struct
     | Upper | Trim ->
         Format.fprintf formatter "%s(%a)" (T.name_of_function name)
           (print_expression nested') expressions
+    | Cmp -> (
+        (* Transform the CMP operator into two IIF, one for the equality, and a
+           second one for the comparaison *)
+        match expressions with
+        | [ pred1; pred2; lt; eq; gt ] ->
+            let eq_expr =
+              (ImportDataTypes.Types.Bool, boperator T.Equal pred1 pred2 type_of)
+            and gt_expr =
+              (ImportDataTypes.Types.Bool, boperator T.GT pred1 pred2 type_of)
+              (* There is nothing for LT, it’s just the remaining case *)
+            in
+            funct "IIF"
+              [ eq_expr; eq; (fst gt, funct "IIF" [ gt_expr; gt; lt ] type_of) ]
+              type_of ~nested formatter
+        | _ -> raise Not_found)
 end)
 
 module M = Sym.M (Query)
 
-let query_of_expression :
-    type b.
+let query_of_expression : type b.
     b binded_query ->
     Format.formatter ->
     (Format.formatter -> 'a -> unit) ->
diff --git a/lib/expression/t.ml b/lib/expression/t.ml
index 7e61317..2df374f 100644
--- a/lib/expression/t.ml
+++ b/lib/expression/t.ml
@@ -34,12 +34,14 @@ and binary_operator =
   | Or
 
 and funct =
-  | Upper
+  | Cmp
   | Trim
+  | Upper
 
 let name_of_function = function
   | Upper -> "UPPER"
   | Trim -> "TRIM"
+  | Cmp -> "CMP"
 
 let name_of_operator = function
   | Equal -> "="
diff --git a/lib/expression/t.mli b/lib/expression/t.mli
index 840805d..3cd5d23 100644
--- a/lib/expression/t.mli
+++ b/lib/expression/t.mli
@@ -32,15 +32,16 @@ and binary_operator =
   | Or
 
 and funct =
-  | Upper
+  | Cmp
   | Trim
+  | Upper
 
 val cmp : ('a -> 'a -> int) -> 'a t -> 'a t -> int
 (** Compare two expressions *)
 
 val fold_values : f:('b -> 'a -> 'b) -> init:'b -> 'a t -> 'b
 (** Fold over all the path presents inside the expression. Used for example to
-    identify all the columns to extract from the file. 
+    identify all the columns to extract from the file.
 
     The order is not guarantee to follow the order from the expression *)
 
diff --git a/lib/expression/type_of.ml b/lib/expression/type_of.ml
index ce1a17e..f81a172 100644
--- a/lib/expression/type_of.ml
+++ b/lib/expression/type_of.ml
@@ -1,10 +1,8 @@
-(** 
- This module evaluate the type of an expression.
+(** This module evaluate the type of an expression.
 
- The type is given with an analysis from all the component involved inside
- the exrpssion. It is used inside the [query] module in order to check if one
- type need conversion before being used.
- *)
+    The type is given with an analysis from all the component involved inside
+    the expression. It is used inside the [query] module in order to check if
+    one type need conversion before being used. *)
 
 open StdLabels
 
@@ -19,7 +17,7 @@ module Lazy_Repr =
 type t = ImportDataTypes.Types.t
 
 (** Fold over the list of parameters and ensure all the elements are typed in
-the same way *)
+    the same way *)
 let group' : t list -> t =
  fun elements ->
   List.fold_left elements ~init:None
@@ -105,22 +103,28 @@ include Lazy_Repr.Make (struct
     | T.Equal | T.Different -> Bool
     | _ -> None
 
+  let check : expected:t -> actual:t -> string -> 'a Repr.E.obs Lazy.t -> t =
+   fun ~expected ~actual subset expr ->
+    if actual = expected then actual
+    else
+      let expression = (Lazy.force expr) ~top:false in
+      raise (ImportErrors.TypeError { expression; subset; expected; actual })
+
   let function' :
       T.funct ->
       ('a Repr.E.obs Lazy.t * 'a repr) list ->
       'a Repr.E.obs Lazy.t ->
       'a repr =
-   fun name expressions _ ->
-    ignore expressions;
+   fun name expressions repr ->
     match name with
     | Upper | Trim -> String
-
-  let check : expected:t -> actual:t -> string -> 'a Repr.E.obs Lazy.t -> t =
-   fun ~expected ~actual subset expr ->
-    if actual = expected then actual
-    else
-      let expression = (Lazy.force expr) ~top:false in
-      raise (ImportErrors.TypeError { expression; subset; expected; actual })
+    | Cmp -> begin
+        match expressions with
+        | [ (_, pred1); (_, pred2); first; _; _ ] ->
+            if pred1 = pred2 then snd first
+            else check ~expected:pred1 ~actual:pred2 "the second argument" repr
+        | _ -> Extern
+      end
 
   let funct :
       string ->
diff --git a/readme.rst b/readme.rst
index ab7b5df..83b29d5 100644
--- a/readme.rst
+++ b/readme.rst
@@ -444,6 +444,24 @@ Les opérateurs de comparaison `=` et `<>` peuvent accepter un groupe de valeur
 plutot qu’une valeur unique. Dans ce cas, la condition est vraie si l’une des
 valeurs est présente.
 
+`cmp`
+
+    .. code:: toml
+
+      """cmp(
+          :A
+        , :B
+        , 'A is smaller than B'
+        , 'A is equal to B'
+        , 'A is greater than B'
+      )"""
+
+    Compare les deux premiers arguments, puis évalue suivant le résultat :
+
+    - inférieur à
+    - égal à
+    - supérieur à
+
 Le cas des cellules vides
 -------------------------
 
diff --git a/tests/expression_builder.ml b/tests/expression_builder.ml
index fd9a17f..6fffc67 100644
--- a/tests/expression_builder.ml
+++ b/tests/expression_builder.ml
@@ -6,6 +6,7 @@ let literal_test : 'a T.t = T.Literal "test"
 let literal_quoted : 'a T.t = T.Literal "'"
 let literal_zero : 'a T.t = T.Literal "0"
 let integer_zero : 'a T.t = T.Integer "0"
+let integer_neg_one : 'a T.t = T.Integer "-1"
 let integer_one : 'a T.t = T.Integer "1"
 let concat : 'a T.t = T.Concat [ T.Empty; T.Literal "test" ]
 let expr : 'a T.t = T.Function ("expr", [ literal_test; T.Literal "NOT NULL" ])
diff --git a/tests/expression_query.ml b/tests/expression_query.ml
index d260a76..e2abc43 100644
--- a/tests/expression_query.ml
+++ b/tests/expression_query.ml
@@ -180,6 +180,23 @@ let counter_order =
 
   assert_equal ~printer expected content
 
+let cmp =
+  "cmp" >:: fun _ ->
+  let expr =
+    eval
+    @@ Expr.(
+         function' T.Cmp
+           [
+             Expr.integer_zero;
+             Expr.integer_one;
+             Expr.integer_neg_one;
+             Expr.integer_zero;
+             Expr.integer_one;
+           ])
+  in
+  let content = test_expr expr and expected = "IIF(0=1, 0, IIF(0>1, 1, -1))" in
+  assert_equal ~printer expected content
+
 let test_suit =
   [
     empty;
@@ -203,6 +220,7 @@ let test_suit =
     max;
     counter_no_order;
     counter_order;
+    cmp;
   ]
 
 let tests = "expression_query" >::: test_suit