Print iflet expressions

Author: tomgasson

src/napkin_core.ml

@@ -83,6 +83,7 @@ end
 let jsxAttr = (Location.mknoloc "JSX", Parsetree.PStr [])
 let uncurryAttr = (Location.mknoloc "bs", Parsetree.PStr [])
 let ternaryAttr = (Location.mknoloc "ns.ternary", Parsetree.PStr [])
+let ifLetAttr = (Location.mknoloc "ns.iflet", Parsetree.PStr [])
 let makeBracesAttr loc = (Location.mkloc "ns.braces" loc, Parsetree.PStr [])
 
 type typDefOrExt =
@@ -3070,7 +3071,7 @@ and parseIfLet startPos p =
     Ast_helper.Exp.construct ~loc (Location.mkloc (Longident.Lident "()") loc) None
   in
   let loc = mkLoc startPos p.prevEndPos in
-  Ast_helper.Exp.match_ ~loc conditionExpr [
+  Ast_helper.Exp.match_ ~attrs:[ifLetAttr] ~loc conditionExpr [
     Ast_helper.Exp.case pattern ?guard thenExpr;
     Ast_helper.Exp.case (Ast_helper.Pat.any ()) elseExpr;
   ]

src/napkin_parsetree_viewer.ml

@@ -42,18 +42,6 @@ open Parsetree
     in
     process false [] attrs
 
-  let collectIfExpressions expr =
-    let rec collect acc expr = match expr.pexp_desc with
-    | Pexp_ifthenelse (ifExpr, thenExpr, Some elseExpr) ->
-      collect ((ifExpr, thenExpr)::acc) elseExpr
-    | Pexp_ifthenelse (ifExpr, thenExpr, (None as elseExpr)) ->
-      let ifs = List.rev ((ifExpr, thenExpr)::acc) in
-      (ifs, elseExpr)
-    | _ ->
-      (List.rev acc, Some expr)
-    in
-    collect [] expr
-
   let collectListExpressions expr =
     let rec collect acc expr = match expr.pexp_desc with
     | Pexp_construct ({txt = Longident.Lident "[]"}, _) ->
@@ -165,7 +153,7 @@ open Parsetree
   let filterParsingAttrs attrs =
     List.filter (fun attr ->
       match attr with
-      | ({Location.txt = ("ns.ternary" | "ns.braces" | "bs" | "ns.namedArgLoc")}, _) -> false
+      | ({Location.txt = ("ns.ternary" | "ns.braces" | "bs" | "ns.iflet" | "ns.namedArgLoc")}, _) -> false
       | _ -> true
     ) attrs
 
@@ -269,7 +257,7 @@ open Parsetree
 
   let hasAttributes attrs =
     List.exists (fun attr -> match attr with
-      | ({Location.txt = "bs" | "ns.ternary" | "ns.braces"}, _) -> false
+      | ({Location.txt = "bs" | "ns.ternary" | "ns.braces" | "ns.iflet"}, _) -> false
       | _ -> true
     ) attrs
 
@@ -280,6 +268,52 @@ open Parsetree
       ) -> true
     | _ -> false
 
+  let rec hasIfLetAttribute attrs =
+    match attrs with
+    | [] -> false
+    | ({Location.txt="ns.iflet"},_)::_ -> true
+    | _::attrs -> hasIfLetAttribute attrs
+
+  let isIfLetExpr expr = match expr with
+    | {
+        pexp_attributes = attrs;
+        pexp_desc = Pexp_match _
+      } when hasIfLetAttribute attrs -> true
+    | _ -> false
+
+  type ifConditionKind =
+  | If of Parsetree.expression
+  | IfLet of Parsetree.pattern * Parsetree.expression * Parsetree.expression option
+
+  let collectIfExpressions expr =
+    let rec collect acc expr = match expr.pexp_desc with
+    | Pexp_ifthenelse (ifExpr, thenExpr, Some elseExpr) ->
+      collect ((If(ifExpr), thenExpr)::acc) elseExpr
+    | Pexp_ifthenelse (ifExpr, thenExpr, (None as elseExpr)) ->
+      let ifs = List.rev ((If(ifExpr), thenExpr)::acc) in
+      (ifs, elseExpr)
+        | Pexp_match (condition, [{
+      pc_lhs = pattern;
+      pc_guard = guard;
+      pc_rhs = thenExpr;
+    }; {
+      pc_rhs = {pexp_desc = Pexp_construct ({txt = Longident.Lident "()"}, _)}
+    }]) when isIfLetExpr expr ->
+      let ifs = List.rev ((IfLet(pattern, condition, guard), thenExpr)::acc) in
+      (ifs, None)
+    | Pexp_match (condition, [{
+      pc_lhs = pattern;
+      pc_guard = guard;
+      pc_rhs = thenExpr;
+    }; {
+      pc_rhs = elseExpr;
+    }]) when isIfLetExpr expr ->
+      collect ((IfLet(pattern, condition, guard), thenExpr)::acc) elseExpr
+    | _ ->
+      (List.rev acc, Some expr)
+    in
+    collect [] expr
+
   let rec hasTernaryAttribute attrs =
     match attrs with
     | [] -> false
@@ -318,6 +352,12 @@ open Parsetree
       | _ -> true
     ) attrs
 
+  let filterIfLetAttributes attrs =
+    List.filter (fun attr -> match attr with
+      |({Location.txt="ns.iflet"},_) -> false
+      | _ -> true
+    ) attrs
+
   let isJsxExpression expr =
     let rec loop attrs =
       match attrs with
@@ -371,13 +411,13 @@ open Parsetree
 
   let filterPrinteableAttributes attrs =
     List.filter (fun attr -> match attr with
-      | ({Location.txt="bs" | "ns.ternary"}, _) -> false
+      | ({Location.txt="bs" | "ns.ternary" | "ns.iflet"}, _) -> false
       | _ -> true
     ) attrs
 
   let partitionPrinteableAttributes attrs =
     List.partition (fun attr -> match attr with
-      | ({Location.txt="bs" | "ns.ternary"}, _) -> false
+      | ({Location.txt="bs" | "ns.ternary" | "ns.iflet"}, _) -> false
       | _ -> true
     ) attrs
 
@@ -513,4 +553,4 @@ open Parsetree
         {ppat_desc = Ppat_var {txt="__x"}},
         {pexp_desc = Pexp_apply _}
       ) -> true
-    | _ -> false
+    | _ -> false

src/napkin_parsetree_viewer.mli

@@ -13,12 +13,16 @@ val functorType: Parsetree.module_type ->
 (* filters @bs out of the provided attributes *)
 val processUncurriedAttribute: Parsetree.attributes -> bool * Parsetree.attributes
 
+type ifConditionKind =
+  | If of Parsetree.expression
+  | IfLet of Parsetree.pattern * Parsetree.expression * Parsetree.expression option
+
 (* if ... else if ... else ... is represented as nested expressions: if ... else { if ... }
 * The purpose of this function is to flatten nested ifs into one sequence.
 * Basically compute: ([if, else if, else if, else if], else) *)
 val collectIfExpressions:
  Parsetree.expression ->
-   (Parsetree.expression * Parsetree.expression) list * Parsetree.expression option
+   (ifConditionKind * Parsetree.expression) list * Parsetree.expression option
 
 val collectListExpressions:
  Parsetree.expression -> (Parsetree.expression list * Parsetree.expression option)
@@ -62,13 +66,15 @@ val hasAttributes: Parsetree.attributes -> bool
 
 val isArrayAccess: Parsetree.expression -> bool
 val isTernaryExpr: Parsetree.expression -> bool
+val isIfLetExpr: Parsetree.expression -> bool
 
 val collectTernaryParts: Parsetree.expression -> ((Parsetree.expression * Parsetree.expression) list * Parsetree.expression)
 
 val parametersShouldHug:
  funParamKind list -> bool
 
 val filterTernaryAttributes: Parsetree.attributes -> Parsetree.attributes
+val filterIfLetAttributes: Parsetree.attributes -> Parsetree.attributes
 
 val isJsxExpression: Parsetree.expression -> bool
 val hasJsxAttribute: Parsetree.attributes -> bool
@@ -90,7 +96,7 @@ val modExprApply : Parsetree.module_expr -> (
  * Example: given a ptyp_arrow type, what are its arguments and what is the
  * returnType? *)
 
- 
+
 val modExprFunctor : Parsetree.module_expr -> (
  (Parsetree.attributes * string Asttypes.loc * Parsetree.module_type option) list *
  Parsetree.module_expr
@@ -130,4 +136,4 @@ val classifyJsImport: Parsetree.value_description -> jsImportScope
 val rewriteUnderscoreApply: Parsetree.expression -> Parsetree.expression
 
 (* (__x) => f(a, __x, c) -----> f(a, _, c)  *)
-val isUnderscoreApplySugar: Parsetree.expression -> bool
+val isUnderscoreApplySugar: Parsetree.expression -> bool