From b5e5bc25a1c7c239c821a783c9aa9b3d2d4ca76a Mon Sep 17 00:00:00 2001
From: Kirill Andreev <hindmost.one@gmail.com>
Date: Mon, 20 Jul 2020 01:04:01 +0400
Subject: [PATCH] [WIP] Conversion to descent-based parser

---
 src/test/contracts/annotation.ligo          |    2 +-
 src/test/contracts/arithmetic.ligo          |    2 +
 src/test/contracts/coase.ligo               |   11 +-
 src/test/contracts/deep_access.ligo         |    2 +
 src/test/contracts/double_michelson_or.ligo |   11 +-
 src/test/contracts/entrypoints.ligo         |    2 +
 src/test/contracts/failwith.ligo            |    4 +-
 src/test/contracts/heap.ligo                |    5 +-
 src/test/contracts/list.ligo                |    2 +
 src/test/contracts/loop.ligo                |   12 +
 src/test/contracts/loop_bugs.ligo           |    2 +-
 src/test/contracts/match.ligo               |    1 +
 src/test/contracts/multisig.ligo            |    5 +-
 src/test/contracts/namespaces.ligo          |    2 +
 src/test/contracts/set_arithmetic.ligo      |    7 +
 tools/lsp/pascaligo/grammar.js              |  260 ++--
 tools/lsp/squirrel/app/Main.hs              |  389 +++---
 tools/lsp/squirrel/examples/sanity.ligo     |    1 -
 tools/lsp/squirrel/package.yaml             |    8 +-
 tools/lsp/squirrel/src/AST/Find.hs          |  116 +-
 tools/lsp/squirrel/src/AST/Parser.hs        | 1194 +++++--------------
 tools/lsp/squirrel/src/AST/Scope.hs         |  515 ++++----
 tools/lsp/squirrel/src/AST/Types.hs         |  141 ++-
 tools/lsp/squirrel/src/Comment.hs           |    3 +-
 tools/lsp/squirrel/src/Debouncer.hs         |    2 +-
 tools/lsp/squirrel/src/Error.hs             |   58 -
 tools/lsp/squirrel/src/Lattice.hs           |   26 -
 tools/lsp/squirrel/src/ParseTree.hs         |  177 ++-
 tools/lsp/squirrel/src/Parser.hs            |  556 +++------
 tools/lsp/squirrel/src/Pretty.hs            |  142 ---
 tools/lsp/squirrel/src/Product.hs           |   40 +-
 tools/lsp/squirrel/src/Range.hs             |   23 +-
 tools/lsp/squirrel/src/Tree.hs              |  242 ----
 tools/lsp/squirrel/stack.yaml               |    4 +-
 tools/lsp/squirrel/stack.yaml.lock          |   17 +-
 35 files changed, 1395 insertions(+), 2589 deletions(-)
 delete mode 100644 tools/lsp/squirrel/examples/sanity.ligo
 delete mode 100644 tools/lsp/squirrel/src/Error.hs
 delete mode 100644 tools/lsp/squirrel/src/Lattice.hs
 delete mode 100644 tools/lsp/squirrel/src/Pretty.hs
 delete mode 100644 tools/lsp/squirrel/src/Tree.hs

diff --git a/src/test/contracts/annotation.ligo b/src/test/contracts/annotation.ligo
index aaff23336..d7677241d 100644
--- a/src/test/contracts/annotation.ligo
+++ b/src/test/contracts/annotation.ligo
@@ -1,6 +1,6 @@
 (* Test that a string is cast to an address given a type annotation *)
 
-const lst : list (int) = list []
+const lst : list (int) = list [1;2;3]
 
 const my_address : address =
   ("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx" : address)
diff --git a/src/test/contracts/arithmetic.ligo b/src/test/contracts/arithmetic.ligo
index 24fe96767..7ce287b31 100644
--- a/src/test/contracts/arithmetic.ligo
+++ b/src/test/contracts/arithmetic.ligo
@@ -1,3 +1,5 @@
+// this is a
+// function!!1
 function mod_op   (const n : int) : nat is n mod 42
 function plus_op  (const n : int) : int is n + 42
 function minus_op (const n : int) : int is n - 42
diff --git a/src/test/contracts/coase.ligo b/src/test/contracts/coase.ligo
index 5897b8686..b3906caf7 100644
--- a/src/test/contracts/coase.ligo
+++ b/src/test/contracts/coase.ligo
@@ -123,7 +123,16 @@ function buy_single (const action : action_buy_single;
 
 function main (const action : parameter; const s : storage) : return is
   case action of
-    Buy_single (bs)      -> buy_single (bs, s)
   | Sell_single (as)     -> sell_single (as, s)
   | Transfer_single (at) -> transfer_single (at, s)
+  | None     -> (failwith (""))
+  | Some (x) -> skip
+  | Buy_single (bs)      -> buy_single (bs, s)
+  | Ex -> Ex(Ex)
   end
+
+type parameter is
+  Buy_single      of action_buy_single
+| Sell_single     of action_sell_single
+| Transfer_single of action_transfer_single
+
diff --git a/src/test/contracts/deep_access.ligo b/src/test/contracts/deep_access.ligo
index 4c4159111..406900a50 100644
--- a/src/test/contracts/deep_access.ligo
+++ b/src/test/contracts/deep_access.ligo
@@ -30,3 +30,5 @@ function nested_record (var nee : nested_record_t) : string is
            Some (s) -> s
          | None -> (failwith ("Should not happen.") : string)
          end
+
+const tuple : int * (int * (int * int)) = (0,(1,(2,3)))
\ No newline at end of file
diff --git a/src/test/contracts/double_michelson_or.ligo b/src/test/contracts/double_michelson_or.ligo
index 3250ec37d..59a0d1911 100644
--- a/src/test/contracts/double_michelson_or.ligo
+++ b/src/test/contracts/double_michelson_or.ligo
@@ -1,11 +1,12 @@
-type storage is michelson_or (int,"foo",string,"bar")
-type foobar is michelson_or (int,"baz",int,"fooo")
 
-type return is list (operation) * storage 
+type return is list (operation) * storage
 
 function main (const action : unit; const store : storage) : return is
-block { 
+block {
   const foo : storage = (M_right ("one") : storage);
   const bar : foobar = (M_right (1) : foobar)
 } with
- ((nil : list (operation)), (foo : storage))
\ No newline at end of file
+ ((nil : list (operation)), (foo : storage))
+
+type storage is michelson_or (int,"foo",string,"bar")
+type foobar is michelson_pair (int,"baz",int,"fooo")
diff --git a/src/test/contracts/entrypoints.ligo b/src/test/contracts/entrypoints.ligo
index 8775e7314..6882e1d7e 100644
--- a/src/test/contracts/entrypoints.ligo
+++ b/src/test/contracts/entrypoints.ligo
@@ -16,3 +16,5 @@ function cbo (const a : address; const s : storage) : return is
       | None -> (failwith ("cbo: Entrypoint not found.") : contract (unit))
       end
   } with (list [Tezos.transaction (unit, 0tez, c)], s)
+
+const x : option (int) = 1
\ No newline at end of file
diff --git a/src/test/contracts/failwith.ligo b/src/test/contracts/failwith.ligo
index 48293b7e3..296be7fa2 100644
--- a/src/test/contracts/failwith.ligo
+++ b/src/test/contracts/failwith.ligo
@@ -39,5 +39,7 @@ function foobar (const i : int) : int is
       end
 
 function failer (const p : int) : int is block {
-  if p = 1 then failwith (42) else skip
+  if p = 1 then failwith (42) else {
+   skip
+  }
 } with p
diff --git a/src/test/contracts/heap.ligo b/src/test/contracts/heap.ligo
index 64667a600..5ca22f5c6 100644
--- a/src/test/contracts/heap.ligo
+++ b/src/test/contracts/heap.ligo
@@ -99,5 +99,6 @@ function pop (const h : heap) : heap * heap_elt * nat is
             h[left] := tmp
           } else skip
         } else skip
-    }
-   } with (h, result, c)
+    };
+    while False block { skip; }
+  } with (h, result, c)
diff --git a/src/test/contracts/list.ligo b/src/test/contracts/list.ligo
index ae01f1559..8e60e9dfd 100644
--- a/src/test/contracts/list.ligo
+++ b/src/test/contracts/list.ligo
@@ -31,3 +31,5 @@ function map_op (const s : list (int)) : list (int) is
   block {
     function increment (const i : int) : int is i+1
   } with List.map (increment, s)
+
+const fb2 : foobar = 144 # fb
diff --git a/src/test/contracts/loop.ligo b/src/test/contracts/loop.ligo
index 2f4e6b554..701eb1ead 100644
--- a/src/test/contracts/loop.ligo
+++ b/src/test/contracts/loop.ligo
@@ -195,3 +195,15 @@ function inner_capture_in_conditional_block (var nee : unit) : bool * int is
       count := count + 1
     }
   } with (ret, count)
+
+const m : unit = set [1; 2; 3]
+const m : unit = map [1 -> 1; 2 -> 2; 3 -> 3]
+
+function for_sum_step (var n : nat) : int is
+  block {
+    var acc : int := 0;
+    for i := 1 to int (2n*n) step 2 block {
+      acc := acc + i
+    }
+  } with acc
+
diff --git a/src/test/contracts/loop_bugs.ligo b/src/test/contracts/loop_bugs.ligo
index 55b443352..321cc7b08 100644
--- a/src/test/contracts/loop_bugs.ligo
+++ b/src/test/contracts/loop_bugs.ligo
@@ -16,5 +16,5 @@ function shadowing_assigned_in_body (var nee : unit) : string is block {
     var st : string := "ta";
     st := st ^ x;
   }
-} with st
+} with st ^ 1
 (* should be "toto" ??? *)
diff --git a/src/test/contracts/match.ligo b/src/test/contracts/match.ligo
index d4fbae47c..a3a985b86 100644
--- a/src/test/contracts/match.ligo
+++ b/src/test/contracts/match.ligo
@@ -34,4 +34,5 @@ function match_expr_list (const l : list (int)) : int is
   case l of
     nil -> -1
   | hd # tl -> hd
+  | list [1; 2; foo] -> foo
   end
diff --git a/src/test/contracts/multisig.ligo b/src/test/contracts/multisig.ligo
index 19c8fc3c4..a65220d93 100644
--- a/src/test/contracts/multisig.ligo
+++ b/src/test/contracts/multisig.ligo
@@ -63,4 +63,7 @@ function check_message (const param : check_message_pt;
 } with (message (unit), s)
 
 function main (const param : parameter; const s : storage) : return is
-  case param of CheckMessage (p) -> check_message (p,s) end
+  case param of
+  | CheckMessage (p) -> check_message (p,s)
+  | a # b -> b
+  end
diff --git a/src/test/contracts/namespaces.ligo b/src/test/contracts/namespaces.ligo
index 2070d1d94..28fe32ca4 100644
--- a/src/test/contracts/namespaces.ligo
+++ b/src/test/contracts/namespaces.ligo
@@ -8,3 +8,5 @@ const cards : cards = record [cards = cards]
 const cards : cards = cards with record [cards = cards]
 
 const cards : cards = cards.cards
+
+const cards : cards = cards with record [cards.foo.0.bar = cards]
diff --git a/src/test/contracts/set_arithmetic.ligo b/src/test/contracts/set_arithmetic.ligo
index 2c801abbe..372151e7a 100644
--- a/src/test/contracts/set_arithmetic.ligo
+++ b/src/test/contracts/set_arithmetic.ligo
@@ -25,3 +25,10 @@ function patch_op_deep (var s : set (string) * nat) : set (string) * nat is
 
 function mem_op (const s : set (string)) : bool is
   set_mem ("foobar", s)
+
+function patch_op_deep (var s : set (string) * nat) : set (string) * nat is
+  block {
+    patch s.0 with set ["foobar"];
+    remove "foobar" from set s.0
+  } with s
+
diff --git a/tools/lsp/pascaligo/grammar.js b/tools/lsp/pascaligo/grammar.js
index 3fe3a1f12..ed174dd45 100644
--- a/tools/lsp/pascaligo/grammar.js
+++ b/tools/lsp/pascaligo/grammar.js
@@ -56,7 +56,7 @@ module.exports = grammar({
   extras: $ => [$.ocaml_comment, $.comment, /\s/],
 
   rules: {
-    contract: $ => sepBy(optional(';'), field("declaration", $._declaration)),
+    Start: $ => sepBy(optional(';'), field("declaration", $._declaration)),
 
     _declaration: $ =>
       choice(
@@ -80,30 +80,31 @@ module.exports = grammar({
         field("typeValue", $._type_expr),
       ),
 
-    type_expr : $ => $._type_expr,
-
     _type_expr: $ =>
       choice(
-        $.fun_type,
+        $._fun_type,
         $.sum_type,
         $.record_type,
       ),
 
-    fun_type: $ =>
+    _fun_type: $ =>
       choice(
+        $.fun_type,
+        $.cartesian
+      ),
+
+    fun_type: $ =>
+      seq(
         field("domain", $.cartesian),
-        seq(
-          field("domain", $.cartesian),
-          '->',
-          field("codomain", $.fun_type),
-        ),
+        '->',
+        field("codomain", $._fun_type),
       ),
 
     cartesian: $ =>
       sepBy1('*',
         choice(
           field("element", $._core_type),
-          par(field("element", $.type_expr)),
+          par(field("element", $._type_expr)),
         ),
       ),
 
@@ -112,17 +113,47 @@ module.exports = grammar({
         $.TypeName,
         $.invokeBinary,
         $.invokeUnary,
+        $.michelsonTypeOr,
+        $.michelsonTypeAnd,
+      ),
+
+    michelsonTypeOr: $ =>
+      seq(
+       "michelson_or",
+       "(",
+       field("left_type", $._type_expr),
+       ",",
+       field("left_type_name", $.String),
+       ",",
+       field("right_type", $._type_expr),
+       ",",
+       field("right_type_name", $.String),
+       ")",
+      ),
+
+    michelsonTypeAnd: $ =>
+      seq(
+       "michelson_pair",
+       "(",
+       field("left_type", $._type_expr),
+       ",",
+       field("left_type_name", $.String),
+       ",",
+       field("right_type", $._type_expr),
+       ",",
+       field("right_type_name", $.String),
+       ")",
       ),
 
     invokeBinary: $ =>
       seq(
-        field("typeConstr", choice('map', 'big_map', $.TypeName)),
+        field("typeConstr", choice('map', 'big_map')),
         field("arguments", $.type_tuple),
       ),
 
     invokeUnary: $ =>
       seq(
-        field("typeConstr", choice('list', 'set')),
+        field("typeConstr", choice('list', 'set', 'option', 'contract')),
         par(field("arguments", $._type_expr)),
       ),
 
@@ -145,7 +176,7 @@ module.exports = grammar({
         seq(
           field("constructor", $.constr),
           'of',
-          field("arguments", $.fun_type)
+          field("arguments", $._fun_type)
         ),
       ),
 
@@ -185,17 +216,20 @@ module.exports = grammar({
           ':',
           field("type", $._type_expr),
           'is',
-          field("body", $.let_expr),
+          field("body", $._let_expr),
         ),
       ),
 
-    let_expr: $ =>
+    _let_expr: $ =>
       choice(
-        seq(
-          field("locals", $.block),
-          'with',
-          field("body", $._expr),
-        ),
+        $.let_expr,
+        $._expr,
+      ),
+
+    let_expr: $ =>
+      seq(
+        field("locals", $.block),
+        'with',
         field("body", $._expr),
       ),
 
@@ -203,15 +237,15 @@ module.exports = grammar({
 
     param_decl: $ =>
       seq(
-        field("access", $.access),
+        field("access", $._access),
         field("name", $.Name),
         ':',
         field("type", $._param_type),
       ),
 
-    access: $ => choice('var', 'const'),
+    _access: $ => choice('var', 'const'),
 
-    _param_type: $ => $.fun_type,
+    _param_type: $ => $._fun_type,
 
     _statement: $ =>
       choice(
@@ -252,7 +286,7 @@ module.exports = grammar({
         $.conditional,
         $.case_instr,
         $.assignment,
-        $.loop,
+        $._loop,
         $._proc_call,
         $.skip,
         $.record_patch,
@@ -268,7 +302,7 @@ module.exports = grammar({
         field("key", $._expr),
         'from',
         'set',
-        field("container", $.path),
+        field("container", $._path),
       ),
 
     map_remove: $ =>
@@ -277,13 +311,13 @@ module.exports = grammar({
         field("key", $._expr),
         'from',
         'map',
-        field("container", $.path),
+        field("container", $._path),
       ),
 
     set_patch: $ =>
       seq(
         'patch',
-        field("container", $.path),
+        field("container", $._path),
         'with',
         ne_injection('set', field("key", $._expr)),
       ),
@@ -291,7 +325,7 @@ module.exports = grammar({
     map_patch: $ =>
       seq(
         'patch',
-        field("container", $.path),
+        field("container", $._path),
         'with',
         ne_injection('map', field("binding", $.binding)),
       ),
@@ -306,7 +340,7 @@ module.exports = grammar({
     record_patch: $ =>
       seq(
         'patch',
-        field("container", $.path),
+        field("container", $._path),
         'with',
         ne_injection('record', field("binding", $.field_assignment)),
       ),
@@ -319,13 +353,13 @@ module.exports = grammar({
         'if',
         field("selector", $._expr),
         'then',
-        field("then", $.if_clause),
+        field("then", $._if_clause),
         optional(';'),
         'else',
-        field("else", $.if_clause),
+        field("else", $._if_clause),
       ),
 
-    if_clause: $ =>
+    _if_clause: $ =>
       choice(
         $._instruction,
         $.clause_block,
@@ -375,9 +409,9 @@ module.exports = grammar({
 
     case_clause_instr: $ =>
       seq(
-        field("pattern", $.pattern),
+        field("pattern", $._pattern),
         '->',
-        field("body", $.if_clause),
+        field("body", $._if_clause),
       ),
 
     assignment: $ =>
@@ -388,9 +422,9 @@ module.exports = grammar({
       ),
 
     _rhs: $ => $._expr,
-    _lhs: $ => choice($.path, $.map_lookup),
+    _lhs: $ => choice($._path, $.map_lookup),
 
-    loop: $ => choice($.while_loop, $.for_loop),
+    _loop: $ => choice($.while_loop, $._for_loop),
 
     while_loop: $ =>
       seq(
@@ -399,29 +433,39 @@ module.exports = grammar({
         field("body", $.block),
       ),
 
-    for_loop: $ =>
+    _for_loop: $ =>
       choice(
-        seq(
-          'for',
-          field("name", $.Name),
-          ':=',
-          field("begin", $._rhs),
-          'to',
-          field("end", $._expr),
-          field("body", $.block),
-        ),
-        seq(
-          'for',
-          field("key", $.Name),
-          optional(seq('->', field("value", $.Name))),
-          'in',
-          field("kind", $.collection),
-          field("collection", $._expr),
-          field("body", $.block),
-        ),
+        $.for_cycle,
+        $.for_box,
       ),
 
-    collection: $ => choice('map', 'set', 'list'),
+    for_cycle: $ =>
+      seq(
+        'for',
+        field("name", $.Name),
+        ':=',
+        field("begin", $._rhs),
+        'to',
+        field("end", $._expr),
+        optional(seq(
+          "step",
+          field("step", $._expr),
+        )),
+        field("body", $.block),
+      ),
+
+    for_box: $ =>
+      seq(
+        'for',
+        field("key", $.Name),
+        optional(seq('->', field("value", $.Name))),
+        'in',
+        field("kind", $._collection),
+        field("collection", $._expr),
+        field("body", $.block),
+      ),
+
+    _collection: $ => choice('map', 'set', 'list'),
 
     interactive_expr: $ => $._expr,
 
@@ -429,7 +473,7 @@ module.exports = grammar({
       choice(
         $.case_expr,
         $.cond_expr,
-        $.op_expr,
+        $._op_expr,
         $.fun_expr,
       ),
 
@@ -456,7 +500,7 @@ module.exports = grammar({
 
     case_clause_expr: $ =>
       seq(
-        field("pattern", $.pattern),
+        field("pattern", $._pattern),
         '->',
         field("body", $._expr),
       ),
@@ -472,20 +516,27 @@ module.exports = grammar({
         field("else", $._expr),
       ),
 
-    op_expr: $ =>
+    _op_expr: $ =>
       choice(
-        field("the", $._core_expr),
-        prec.left (0, seq(field("arg1", $.op_expr),    field("op", 'or'),         field("arg2", $.op_expr))),
-        prec.left (1, seq(field("arg1", $.op_expr),    field("op", 'and'),        field("arg2", $.op_expr))),
-        prec.right(2, seq(field("arg1", $._core_expr), field("op", 'contains'),   field("arg2", $.op_expr))),
-        prec.left (3, seq(field("arg1", $.op_expr),    field("op", $.comparison), field("arg2", $.op_expr))),
-        prec.right(4, seq(field("arg1", $.op_expr),    field("op", '^'),          field("arg2", $.op_expr))),
-        prec.right(5, seq(field("arg1", $.op_expr),    field("op", '#'),          field("arg2", $.op_expr))),
-        prec.left (6, seq(field("arg1", $.op_expr),    field("op", $.adder),      field("arg2", $.op_expr))),
-        prec.left (7, seq(field("arg1", $.op_expr),    field("op", $.multiplier), field("arg2", $.op_expr))),
-        prec.right(8, seq(field("negate", $.negate), field("arg", $._core_expr))),
+        $._core_expr,
+        $.binop,
+        $.unop,
       ),
 
+    binop: $ =>
+      choice(
+        prec.left (0, seq(field("arg1", $._op_expr),    field("op", 'or'),         field("arg2", $._op_expr))),
+        prec.left (1, seq(field("arg1", $._op_expr),    field("op", 'and'),        field("arg2", $._op_expr))),
+        prec.right(2, seq(field("arg1", $._core_expr), field("op", 'contains'),   field("arg2", $._op_expr))),
+        prec.left (3, seq(field("arg1", $._op_expr),    field("op", $.comparison), field("arg2", $._op_expr))),
+        prec.right(4, seq(field("arg1", $._op_expr),    field("op", '^'),          field("arg2", $._op_expr))),
+        prec.right(5, seq(field("arg1", $._op_expr),    field("op", '#'),          field("arg2", $._op_expr))),
+        prec.left (6, seq(field("arg1", $._op_expr),    field("op", $.adder),      field("arg2", $._op_expr))),
+        prec.left (7, seq(field("arg1", $._op_expr),    field("op", $.multiplier), field("arg2", $._op_expr))),
+      ),
+
+    unop: $ => prec.right(8, seq(field("negate", $.negate), field("arg", $._core_expr))),
+
     comparison: $ => choice('<', '<=', '>', '>=', '=', '=/='),
     adder:      $ => choice('-', '+'),
     multiplier: $ => choice('/', '*', 'mod'),
@@ -505,23 +556,27 @@ module.exports = grammar({
         $.Unit,
         $.annot_expr,
         $.tuple_expr,
-        $.list_expr,
+        $._list_expr,
         $.None,
         $._fun_call_or_par_or_projection,
         $._map_expr,
         $.set_expr,
         $.record_expr,
         $.update_record,
-        $.constr_call,
+        $._constr_use,
         $.Some_call,
       ),
 
+    _constr_use: $ =>
+      choice(
+        $.constr_call,
+        $.constr
+      ),
+
     constr_call: $ =>
       seq(
         field("constr", $.constr),
-        optional(
-          field("arguments", $.arguments)
-        ),
+        field("arguments", $.arguments)
       ),
 
     Some_call: $ =>
@@ -535,22 +590,23 @@ module.exports = grammar({
         $.par_call,
         $.projection_call,
         $.fun_call,
+        $._projection,
       ),
 
     par_call: $ =>
       prec.right(1, seq(
         par(field("f", $._expr)),
-        optional(field("arguments", $.arguments))
+        field("arguments", $.arguments),
       )),
 
-    projection_call: $ => seq(
+    projection_call: $ => prec(1, seq(
       field("f", $._projection),
-      optional(field("arguments", $.arguments)),
-    ),
+      field("arguments", $.arguments),
+    )),
 
     annot_expr: $ =>
       par(seq(
-        field("subject", $.op_expr),
+        field("subject", $._op_expr),
         ':',
         field("type", $._type_expr)
       )),
@@ -569,13 +625,13 @@ module.exports = grammar({
 
     map_lookup: $ =>
       seq(
-        field("container", $.path),
+        field("container", $._path),
         brackets(field("index", $._expr)),
       ),
 
-    path: $ => choice($.Name, $._projection),
+    _path: $ => choice($.Name, $._projection),
 
-    fpath: $ => choice($.FieldName, $._projection),
+    _fpath: $ => choice($.FieldName, $._projection),
 
     module_field: $ =>
       seq(
@@ -606,7 +662,7 @@ module.exports = grammar({
     data_projection: $ => seq(
       field("struct", $.Name),
       '.',
-      sepBy1('.', field("index", $.selection)),
+      sepBy1('.', field("index", $._selection)),
     ),
 
     module_projection: $ =>
@@ -615,10 +671,10 @@ module.exports = grammar({
         '.',
         field("index", $.Name),
         '.',
-        sepBy1('.', field("index", $.selection)),
+        sepBy1('.', field("index", $._selection)),
       ),
 
-    selection: $ => choice($.FieldName, $.Int),
+    _selection: $ => choice($.FieldName, $.Int),
 
     record_expr: $ =>
       choice(
@@ -637,7 +693,7 @@ module.exports = grammar({
 
     update_record: $ =>
       seq(
-        field("record", $.path),
+        field("record", $._path),
         'with',
         ne_injection('record', field("assignment", $.field_path_assignment)),
       ),
@@ -651,7 +707,7 @@ module.exports = grammar({
 
     field_path_assignment: $ =>
       seq(
-        field("lhs", $.fpath),
+        field("lhs", $._fpath),
         '=',
         field("_rhs", $._expr),
       ),
@@ -665,14 +721,14 @@ module.exports = grammar({
     tuple_expr: $ => par(sepBy1(',', field("element",  $._expr))),
     arguments:  $ => par(sepBy(',',  field("argument", $._expr))),
 
-    list_expr: $ => choice($._list_injection, 'nil'),
+    _list_expr: $ => choice($.list_injection, 'nil'),
 
-    _list_injection: $ => injection('list', field("element", $._expr)),
+    list_injection: $ => injection('list', field("element", $._expr)),
 
-    pattern: $ =>
+    _pattern: $ =>
       choice(
-        $._cons_pattern,
-        field("the", $._core_pattern),
+        $.cons_pattern,
+        $._core_pattern,
       ),
 
     _core_pattern: $ =>
@@ -682,26 +738,28 @@ module.exports = grammar({
         $.Int,
         $.Nat,
         $.String,
-        $.list_pattern,
+        $._list_pattern,
         $.tuple_pattern,
         $._constr_pattern,
       ),
 
-    list_pattern: $ =>
+    _list_pattern: $ =>
       choice(
-        injection("list", field("element", $.pattern)),
+        $.list_pattern,
         'nil',
       ),
 
-    _cons_pattern: $ =>
+    list_pattern: $ => injection("list", field("element", $._pattern)),
+
+    cons_pattern: $ =>
       seq(
         field("head", $._core_pattern),
         '#',
-        field("tail", $.pattern),
+        field("tail", $._pattern),
       ),
 
     tuple_pattern: $ =>
-      par(sepBy1(',', field("element", $.pattern))),
+      par(sepBy1(',', field("element", $._pattern))),
 
     _constr_pattern: $ => choice(
       $.Unit,
@@ -715,7 +773,7 @@ module.exports = grammar({
     Some_pattern: $ =>
       seq(
         field("constr", 'Some'),
-        par(field("arg", $.pattern)),
+        par(field("arg", $._pattern)),
       ),
 
     user_constr_pattern: $ =>
@@ -744,7 +802,7 @@ module.exports = grammar({
 
     include: $ => seq('#include', field("filename", $.String)),
 
-    String:       $ => /\"(\\.|[^"])*\"/,
+    String:       $ => choice(/\"(\\.|[^"])*\"/, /{\|(\\.|[^\|])*\|}/),
     Int:          $ => /-?([1-9][0-9_]*|0)/,
     Nat:          $ => /([1-9][0-9_]*|0)n/,
     Tez:          $ => /([1-9][0-9_]*|0)(\.[0-9_]+)?(tz|tez|mutez)/,
diff --git a/tools/lsp/squirrel/app/Main.hs b/tools/lsp/squirrel/app/Main.hs
index 876fb155b..4124f380f 100644
--- a/tools/lsp/squirrel/app/Main.hs
+++ b/tools/lsp/squirrel/app/Main.hs
@@ -6,7 +6,7 @@ import           Control.Lens
 import           Control.Monad
 
 import           Data.Default
--- import           Data.Foldable
+import           Data.Foldable
 import qualified Data.Text                             as Text
 import           Data.Text                                     (Text)
 import           Data.String                                   (fromString)
@@ -30,232 +30,233 @@ import           Range
 import           Product
 import           AST                                           hiding (def)
 import qualified AST.Find                              as Find
-import           Error
+-- import           Error
 
 main :: IO ()
 main = do
-  -- for_ [1.. 100] \_ -> do
-  --   print =<< runParser contract example
-  errCode <- mainLoop
-  exit errCode
+  return ()
+  for_ [1.. 100] \_ -> do
+    print . length . show =<< sample' "../../../src/test/contracts/loop.ligo"
+  -- errCode <- mainLoop
+  -- exit errCode
 
-mainLoop :: IO Int
-mainLoop = do
-    chan <- atomically newTChan :: IO (TChan FromClientMessage)
+-- mainLoop :: IO Int
+-- mainLoop = do
+--     chan <- atomically newTChan :: IO (TChan FromClientMessage)
 
-    let
-      callbacks = Core.InitializeCallbacks
-        { Core.onInitialConfiguration = const $ Right ()
-        , Core.onConfigurationChange = const $ Right ()
-        , Core.onStartup = \lFuns -> do
-            _ <- forkIO $ eventLoop lFuns chan
-            return Nothing
-        }
+--     let
+--       callbacks = Core.InitializeCallbacks
+--         { Core.onInitialConfiguration = const $ Right ()
+--         , Core.onConfigurationChange = const $ Right ()
+--         , Core.onStartup = \lFuns -> do
+--             _ <- forkIO $ eventLoop lFuns chan
+--             return Nothing
+--         }
 
-    Core.setupLogger (Just "log.txt") [] L.INFO
-    CTRL.run callbacks (lspHandlers chan) lspOptions (Just "log.txt")
-  `catches`
-    [ Handler \(e :: SomeException) -> do
-        print e
-        return 1
-    ]
+--     Core.setupLogger (Just "log.txt") [] L.INFO
+--     CTRL.run callbacks (lspHandlers chan) lspOptions (Just "log.txt")
+--   `catches`
+--     [ Handler \(e :: SomeException) -> do
+--         print e
+--         return 1
+--     ]
 
-syncOptions :: J.TextDocumentSyncOptions
-syncOptions = J.TextDocumentSyncOptions
-  { J._openClose         = Just True
-  , J._change            = Just J.TdSyncIncremental
-  , J._willSave          = Just False
-  , J._willSaveWaitUntil = Just False
-  , J._save              = Just $ J.SaveOptions $ Just False
-  }
+-- syncOptions :: J.TextDocumentSyncOptions
+-- syncOptions = J.TextDocumentSyncOptions
+--   { J._openClose         = Just True
+--   , J._change            = Just J.TdSyncIncremental
+--   , J._willSave          = Just False
+--   , J._willSaveWaitUntil = Just False
+--   , J._save              = Just $ J.SaveOptions $ Just False
+--   }
 
-lspOptions :: Core.Options
-lspOptions = def
-  { Core.textDocumentSync       = Just syncOptions
-  , Core.executeCommandCommands = Just ["lsp-hello-command"]
-  }
+-- lspOptions :: Core.Options
+-- lspOptions = def
+--   { Core.textDocumentSync       = Just syncOptions
+--   , Core.executeCommandCommands = Just ["lsp-hello-command"]
+--   }
 
-lspHandlers :: TChan FromClientMessage -> Core.Handlers
-lspHandlers rin = def
-  { Core.initializedHandler                       = Just $ passHandler rin NotInitialized
-  , Core.definitionHandler                        = Just $ passHandler rin ReqDefinition
-  , Core.referencesHandler                        = Just $ passHandler rin ReqFindReferences
-  , Core.didOpenTextDocumentNotificationHandler   = Just $ passHandler rin NotDidOpenTextDocument
-  , Core.didSaveTextDocumentNotificationHandler   = Just $ passHandler rin NotDidSaveTextDocument
-  , Core.didChangeTextDocumentNotificationHandler = Just $ passHandler rin NotDidChangeTextDocument
-  , Core.didCloseTextDocumentNotificationHandler  = Just $ passHandler rin NotDidCloseTextDocument
-  , Core.cancelNotificationHandler                = Just $ passHandler rin NotCancelRequestFromClient
-  , Core.responseHandler                          = Just $ responseHandlerCb rin
-  , Core.codeActionHandler                        = Just $ passHandler rin ReqCodeAction
-  , Core.executeCommandHandler                    = Just $ passHandler rin ReqExecuteCommand
-  }
+-- lspHandlers :: TChan FromClientMessage -> Core.Handlers
+-- lspHandlers rin = def
+--   { Core.initializedHandler                       = Just $ passHandler rin NotInitialized
+--   , Core.definitionHandler                        = Just $ passHandler rin ReqDefinition
+--   , Core.referencesHandler                        = Just $ passHandler rin ReqFindReferences
+--   , Core.didOpenTextDocumentNotificationHandler   = Just $ passHandler rin NotDidOpenTextDocument
+--   , Core.didSaveTextDocumentNotificationHandler   = Just $ passHandler rin NotDidSaveTextDocument
+--   , Core.didChangeTextDocumentNotificationHandler = Just $ passHandler rin NotDidChangeTextDocument
+--   , Core.didCloseTextDocumentNotificationHandler  = Just $ passHandler rin NotDidCloseTextDocument
+--   , Core.cancelNotificationHandler                = Just $ passHandler rin NotCancelRequestFromClient
+--   , Core.responseHandler                          = Just $ responseHandlerCb rin
+--   , Core.codeActionHandler                        = Just $ passHandler rin ReqCodeAction
+--   , Core.executeCommandHandler                    = Just $ passHandler rin ReqExecuteCommand
+--   }
 
-passHandler :: TChan FromClientMessage -> (a -> FromClientMessage) -> Core.Handler a
-passHandler rin c notification = do
-  atomically $ writeTChan rin (c notification)
+-- passHandler :: TChan FromClientMessage -> (a -> FromClientMessage) -> Core.Handler a
+-- passHandler rin c notification = do
+--   atomically $ writeTChan rin (c notification)
 
-responseHandlerCb :: TChan FromClientMessage -> Core.Handler J.BareResponseMessage
-responseHandlerCb _rin resp = do
-  U.logs $ "******** got ResponseMessage, ignoring:" ++ show resp
+-- responseHandlerCb :: TChan FromClientMessage -> Core.Handler J.BareResponseMessage
+-- responseHandlerCb _rin resp = do
+--   U.logs $ "******** got ResponseMessage, ignoring:" ++ show resp
 
-send :: Core.LspFuncs () -> FromServerMessage -> IO ()
-send = Core.sendFunc
+-- send :: Core.LspFuncs () -> FromServerMessage -> IO ()
+-- send = Core.sendFunc
 
-nextID :: Core.LspFuncs () -> IO J.LspId
-nextID = Core.getNextReqId
+-- nextID :: Core.LspFuncs () -> IO J.LspId
+-- nextID = Core.getNextReqId
 
-eventLoop :: Core.LspFuncs () -> TChan FromClientMessage -> IO ()
-eventLoop funs chan = do
-  forever do
-    msg <- atomically (readTChan chan)
+-- eventLoop :: Core.LspFuncs () -> TChan FromClientMessage -> IO ()
+-- eventLoop funs chan = do
+--   forever do
+--     msg <- atomically (readTChan chan)
 
-    U.logs [i|Client: ${msg}|]
+--     U.logs [i|Client: ${msg}|]
 
-    case msg of
-      RspFromClient {} -> do
-        return ()
+--     case msg of
+--       RspFromClient {} -> do
+--         return ()
 
-      NotInitialized _notif -> do
-        let
-          registration = J.Registration
-            "lsp-haskell-registered"
-            J.WorkspaceExecuteCommand
-            Nothing
-          registrations = J.RegistrationParams $ J.List [registration]
+--       NotInitialized _notif -> do
+--         let
+--           registration = J.Registration
+--             "lsp-haskell-registered"
+--             J.WorkspaceExecuteCommand
+--             Nothing
+--           registrations = J.RegistrationParams $ J.List [registration]
 
-        rid <- nextID funs
-        send funs
-          $ ReqRegisterCapability
-          $ fmServerRegisterCapabilityRequest rid registrations
+--         rid <- nextID funs
+--         send funs
+--           $ ReqRegisterCapability
+--           $ fmServerRegisterCapabilityRequest rid registrations
 
-      NotDidOpenTextDocument notif -> do
-        let
-          doc = notif
-            ^.J.params
-             .J.textDocument
-             .J.uri
+--       NotDidOpenTextDocument notif -> do
+--         let
+--           doc = notif
+--             ^.J.params
+--              .J.textDocument
+--              .J.uri
 
-          ver = notif
-            ^.J.params
-             .J.textDocument
-             .J.version
+--           ver = notif
+--             ^.J.params
+--              .J.textDocument
+--              .J.version
 
-        collectErrors funs
-          (J.toNormalizedUri doc)
-          (J.uriToFilePath doc)
-          (Just ver)
+--         collectErrors funs
+--           (J.toNormalizedUri doc)
+--           (J.uriToFilePath doc)
+--           (Just ver)
 
-      NotDidChangeTextDocument notif -> do
-        let
-          doc = notif
-            ^.J.params
-             .J.textDocument
-             .J.uri
+--       NotDidChangeTextDocument notif -> do
+--         let
+--           doc = notif
+--             ^.J.params
+--              .J.textDocument
+--              .J.uri
 
-        collectErrors funs
-          (J.toNormalizedUri doc)
-          (J.uriToFilePath doc)
-          (Just 0)
+--         collectErrors funs
+--           (J.toNormalizedUri doc)
+--           (J.uriToFilePath doc)
+--           (Just 0)
 
-      ReqDefinition req -> do
-        stopDyingAlready funs req do
-          let uri = req^.J.params.J.textDocument.J.uri
-          let pos = posToRange $ req^.J.params.J.position
-          tree <- loadByURI uri
-          case Find.definitionOf pos tree of
-            Just defPos -> do
-              respondWith funs req RspDefinition $ J.MultiLoc [J.Location uri $ rangeToLoc defPos]
-            Nothing -> do
-              respondWith funs req RspDefinition $ J.MultiLoc []
+--       ReqDefinition req -> do
+--         stopDyingAlready funs req do
+--           let uri = req^.J.params.J.textDocument.J.uri
+--           let pos = posToRange $ req^.J.params.J.position
+--           tree <- loadByVFS funs uri
+--           case Find.definitionOf pos tree of
+--             Just defPos -> do
+--               respondWith funs req RspDefinition $ J.MultiLoc [J.Location uri $ rangeToLoc defPos]
+--             Nothing -> do
+--               respondWith funs req RspDefinition $ J.MultiLoc []
 
-      ReqFindReferences req -> do
-        stopDyingAlready funs req do
-          let uri = req^.J.params.J.textDocument.J.uri
-          let pos = posToRange $ req^.J.params.J.position
-          tree <- loadFromVFS funs uri
-          case Find.referencesOf pos tree of
-            Just refs -> do
-              let locations = J.Location uri . rangeToLoc <$> refs
-              respondWith funs req RspFindReferences $ J.List locations
-            Nothing -> do
-              respondWith funs req RspFindReferences $ J.List []
+--       ReqFindReferences req -> do
+--         stopDyingAlready funs req do
+--           let uri = req^.J.params.J.textDocument.J.uri
+--           let pos = posToRange $ req^.J.params.J.position
+--           tree <- loadFromVFS funs uri
+--           case Find.referencesOf pos tree of
+--             Just refs -> do
+--               let locations = J.Location uri . rangeToLoc <$> refs
+--               respondWith funs req RspFindReferences $ J.List locations
+--             Nothing -> do
+--               respondWith funs req RspFindReferences $ J.List []
 
-      _ -> U.logs "unknown msg"
+--       _ -> U.logs "unknown msg"
 
-respondWith
-  :: Core.LspFuncs ()
-  -> J.RequestMessage J.ClientMethod req rsp
-  -> (J.ResponseMessage rsp -> FromServerMessage)
-  -> rsp
-  -> IO ()
-respondWith funs req wrap rsp = Core.sendFunc funs $ wrap $ Core.makeResponseMessage req rsp
+-- respondWith
+--   :: Core.LspFuncs ()
+--   -> J.RequestMessage J.ClientMethod req rsp
+--   -> (J.ResponseMessage rsp -> FromServerMessage)
+--   -> rsp
+--   -> IO ()
+-- respondWith funs req wrap rsp = Core.sendFunc funs $ wrap $ Core.makeResponseMessage req rsp
 
-stopDyingAlready :: Core.LspFuncs () -> J.RequestMessage m a b -> IO () -> IO ()
-stopDyingAlready funs req = flip catch \(e :: SomeException) -> do
-  Core.sendErrorResponseS (Core.sendFunc funs) (req^.J.id.to J.responseId) J.InternalError
-    $ fromString
-    $ "this happened: " ++ show e
+-- stopDyingAlready :: Core.LspFuncs () -> J.RequestMessage m a b -> IO () -> IO ()
+-- stopDyingAlready funs req = flip catch \(e :: SomeException) -> do
+--   Core.sendErrorResponseS (Core.sendFunc funs) (req^.J.id.to J.responseId) J.InternalError
+--     $ fromString
+--     $ "this happened: " ++ show e
 
-posToRange :: J.Position -> Range
-posToRange (J.Position l c) = Range (l + 1, c + 1, 0) (l + 1, c + 1, 0) ""
+-- posToRange :: J.Position -> Range
+-- posToRange (J.Position l c) = Range (l + 1, c + 1, 0) (l + 1, c + 1, 0) ""
 
-rangeToLoc :: Range -> J.Range
-rangeToLoc (Range (a, b, _) (c, d, _) _) =
-  J.Range
-    (J.Position (a - 1) (b - 1))
-    (J.Position (c - 1) (d - 1))
+-- rangeToLoc :: Range -> J.Range
+-- rangeToLoc (Range (a, b, _) (c, d, _) _) =
+--   J.Range
+--     (J.Position (a - 1) (b - 1))
+--     (J.Position (c - 1) (d - 1))
 
-loadFromVFS
-  :: Core.LspFuncs ()
-  -> J.Uri
-  -> IO (Pascal (Product [[ScopedDecl], Maybe Category, Range, [Text]]))
-loadFromVFS funs uri = do
-  Just vf <- Core.getVirtualFileFunc funs $ J.toNormalizedUri uri
-  let txt = virtualFileText vf
-  let Just fin = J.uriToFilePath uri
-  (tree, _) <- runParser contract (Text fin txt)
-  return $ addLocalScopes tree
+-- loadFromVFS
+--   :: Core.LspFuncs ()
+--   -> J.Uri
+--   -> IO (Pascal (Product [[ScopedDecl], Maybe Category, Range, [Text]]))
+-- loadFromVFS funs uri = do
+--   Just vf <- Core.getVirtualFileFunc funs $ J.toNormalizedUri uri
+--   let txt = virtualFileText vf
+--   let Just fin = J.uriToFilePath uri
+--   (tree, _) <- runParser contract (Text fin txt)
+--   return $ addLocalScopes tree
 
-loadByURI
-  :: J.Uri
-  -> IO (Pascal (Product [[ScopedDecl], Maybe Category, Range, [Text]]))
-loadByURI uri = do
-  case J.uriToFilePath uri of
-    Just fin -> do
-      (tree, _) <- runParser contract (Path fin)
-      return $ addLocalScopes tree
-    Nothing -> do
-      error $ "uriToFilePath " ++ show uri ++ " has failed. We all are doomed."
+-- loadByURI
+--   :: J.Uri
+--   -> IO (Pascal (Product [[ScopedDecl], Maybe Category, Range, [Text]]))
+-- loadByURI uri = do
+--   case J.uriToFilePath uri of
+--     Just fin -> do
+--       (tree, _) <- runParser contract (Path fin)
+--       return $ addLocalScopes tree
+--     Nothing -> do
+--       error $ "uriToFilePath " ++ show uri ++ " has failed. We all are doomed."
 
-collectErrors
-  :: Core.LspFuncs ()
-  -> J.NormalizedUri
-  -> Maybe FilePath
-  -> Maybe Int
-  -> IO ()
-collectErrors funs uri path version = do
-  case path of
-    Just fin -> do
-      (tree, errs) <- runParser contract (Path fin)
-      Core.publishDiagnosticsFunc funs 100 uri version
-        $ partitionBySource
-        $ map errorToDiag (errs <> errors tree)
+-- collectErrors
+--   :: Core.LspFuncs ()
+--   -> J.NormalizedUri
+--   -> Maybe FilePath
+--   -> Maybe Int
+--   -> IO ()
+-- collectErrors funs uri path version = do
+--   case path of
+--     Just fin -> do
+--       (tree, errs) <- runParser contract (Path fin)
+--       Core.publishDiagnosticsFunc funs 100 uri version
+--         $ partitionBySource
+--         $ map errorToDiag (errs <> errors tree)
 
-    Nothing -> error "TODO: implement URI file loading"
+--     Nothing -> error "TODO: implement URI file loading"
 
-errorToDiag :: Error ASTInfo -> J.Diagnostic
-errorToDiag (Expected what _ (getRange -> (Range (sl, sc, _) (el, ec, _) _))) =
-  J.Diagnostic
-    (J.Range begin end)
-    (Just J.DsError)
-    Nothing
-    (Just "ligo-lsp")
-    (Text.pack [i|Expected #{what}|])
-    (Just $ J.List[])
-  where
-    begin = J.Position (sl - 1) (sc - 1)
-    end   = J.Position (el - 1) (ec - 1)
+-- errorToDiag :: Error ASTInfo -> J.Diagnostic
+-- errorToDiag (Expected what _ (getRange -> (Range (sl, sc, _) (el, ec, _) _))) =
+--   J.Diagnostic
+--     (J.Range begin end)
+--     (Just J.DsError)
+--     Nothing
+--     (Just "ligo-lsp")
+--     (Text.pack [i|Expected #{what}|])
+--     (Just $ J.List[])
+--   where
+--     begin = J.Position (sl - 1) (sc - 1)
+--     end   = J.Position (el - 1) (ec - 1)
 
-exit :: Int -> IO ()
-exit 0 = exitSuccess
-exit n = exitWith (ExitFailure n)
+-- exit :: Int -> IO ()
+-- exit 0 = exitSuccess
+-- exit n = exitWith (ExitFailure n)
diff --git a/tools/lsp/squirrel/examples/sanity.ligo b/tools/lsp/squirrel/examples/sanity.ligo
deleted file mode 100644
index 7336d60fd..000000000
--- a/tools/lsp/squirrel/examples/sanity.ligo
+++ /dev/null
@@ -1 +0,0 @@
-function foo (var x : int) is 1
\ No newline at end of file
diff --git a/tools/lsp/squirrel/package.yaml b/tools/lsp/squirrel/package.yaml
index e24f8777e..6ff6e9187 100644
--- a/tools/lsp/squirrel/package.yaml
+++ b/tools/lsp/squirrel/package.yaml
@@ -5,13 +5,16 @@ dependencies:
   - bytestring
   - containers
   - data-default
+  - duplo
   - exceptions
   - fastsum
   - filepath
   - ghc-prim
+  - interpolate
   - mtl
   - pretty
   - text
+  - transformers
   - tree-sitter
 
 default-extensions:
@@ -21,6 +24,7 @@ default-extensions:
   - BlockArguments
   - ConstraintKinds
   - DataKinds
+  - DeriveAnyClass
   - DeriveFoldable
   - DeriveFunctor
   - DeriveTraversable
@@ -46,7 +50,7 @@ default-extensions:
   - UndecidableInstances
   - ViewPatterns
 
-ghc-options: -freverse-errors -Wall -threaded
+ghc-options: -freverse-errors -Wall
 
 library:
   source-dirs:
@@ -72,3 +76,5 @@ executables:
 
     source-dirs:
       - app/
+
+    ghc-options: -threaded
diff --git a/tools/lsp/squirrel/src/AST/Find.hs b/tools/lsp/squirrel/src/AST/Find.hs
index f1b8544a4..8c2139999 100644
--- a/tools/lsp/squirrel/src/AST/Find.hs
+++ b/tools/lsp/squirrel/src/AST/Find.hs
@@ -1,70 +1,70 @@
 
 module AST.Find where
 
-import Control.Monad
+-- import Control.Monad
 
-import AST.Types
-import AST.Scope
-import AST.Parser
+-- import AST.Types
+-- import AST.Scope
+-- import AST.Parser
 
-import Tree
-import Range
-import Pretty
-import Product
+-- import Tree
+-- import Range
+-- import Pretty
+-- import Product
 
-import Data.Text (Text)
--- import Debug.Trace
+-- import Data.Text (Text)
+-- -- import Debug.Trace
 
-type CanSearch xs =
-  ( Contains [ScopedDecl] xs
-  , Contains Range xs
-  , Contains (Maybe Category) xs
-  , Contains [Text] xs
-  , Pretty (Product xs)
-  )
+-- type CanSearch xs =
+--   ( Contains [ScopedDecl] xs
+--   , Contains Range xs
+--   , Contains (Maybe Category) xs
+--   , Contains [Text] xs
+--   , Pretty (Product xs)
+--   )
 
-findScopedDecl
-  :: CanSearch xs
-  => Range
-  -> Pascal (Product xs)
-  -> Maybe ScopedDecl
-findScopedDecl pos tree = do
-  pt <- lookupTree pos tree
-  let info = infoOf pt
-  let fullEnv = getElem info
-  do
-    categ <- getElem info
-    let filtered = filter (ofCategory categ) fullEnv
-    lookupEnv (ppToText $ void pt) filtered
+-- findScopedDecl
+--   :: CanSearch xs
+--   => Range
+--   -> Pascal (Product xs)
+--   -> Maybe ScopedDecl
+-- findScopedDecl pos tree = do
+--   pt <- lookupTree pos tree
+--   let info = infoOf pt
+--   let fullEnv = getElem info
+--   do
+--     categ <- getElem info
+--     let filtered = filter (ofCategory categ) fullEnv
+--     lookupEnv (ppToText $ void pt) filtered
 
-definitionOf
-  :: CanSearch xs
-  => Range
-  -> Pascal (Product xs)
-  -> Maybe Range
-definitionOf pos tree =
-  _sdOrigin <$> findScopedDecl pos tree
+-- definitionOf
+--   :: CanSearch xs
+--   => Range
+--   -> Pascal (Product xs)
+--   -> Maybe Range
+-- definitionOf pos tree =
+--   _sdOrigin <$> findScopedDecl pos tree
 
-typeOf
-  :: CanSearch xs
-  => Range
-  -> Pascal (Product xs)
-  -> Maybe (Either (Pascal ()) Kind)
-typeOf pos tree =
-  _sdType =<< findScopedDecl pos tree
+-- typeOf
+--   :: CanSearch xs
+--   => Range
+--   -> Pascal (Product xs)
+--   -> Maybe (Either (Pascal ()) Kind)
+-- typeOf pos tree =
+--   _sdType =<< findScopedDecl pos tree
 
-implementationOf
-  :: CanSearch xs
-  => Range
-  -> Pascal (Product xs)
-  -> Maybe Range
-implementationOf pos tree =
-  _sdBody =<< findScopedDecl pos tree
+-- implementationOf
+--   :: CanSearch xs
+--   => Range
+--   -> Pascal (Product xs)
+--   -> Maybe Range
+-- implementationOf pos tree =
+--   _sdBody =<< findScopedDecl pos tree
 
-referencesOf
-  :: CanSearch xs
-  => Range
-  -> Pascal (Product xs)
-  -> Maybe [Range]
-referencesOf pos tree =
-  _sdRefs <$> findScopedDecl pos tree
+-- referencesOf
+--   :: CanSearch xs
+--   => Range
+--   -> Pascal (Product xs)
+--   -> Maybe [Range]
+-- referencesOf pos tree =
+--   _sdRefs <$> findScopedDecl pos tree
diff --git a/tools/lsp/squirrel/src/AST/Parser.hs b/tools/lsp/squirrel/src/AST/Parser.hs
index 69010137b..1cfe326bd 100644
--- a/tools/lsp/squirrel/src/AST/Parser.hs
+++ b/tools/lsp/squirrel/src/AST/Parser.hs
@@ -2,925 +2,305 @@
 {- | Parser for a contract.
 -}
 
-module AST.Parser (example, contract, sample) where
+module AST.Parser
+  -- (example, contract, sample)
+  where
 
+import Control.Arrow
+
+import Data.Maybe (isJust)
 import Data.Text (Text)
 import qualified Data.Text as Text
 import Data.Sum (Element)
 
 import AST.Types
 
-import Parser
+import Duplo.Error
+import Duplo.Tree
+import Duplo.Pretty
+
 import Range
 import Product
-import Tree hiding (skip)
+import Parser
+import ParseTree
 
-import Pretty
 import Debug.Trace
 
-ranged
-  :: ( Functor f
-     , Element f fs
-     )
-  => Parser (f (Tree fs ASTInfo))
-  -> Parser    (Tree fs ASTInfo)
-ranged p = do
-  r <- getInfo
-  a <- p
-  return $ mk r a
-
--- | The entrypoint.
-contract :: Parser (Pascal ASTInfo)
-contract =
-    pure contract'
-      <*> getInfo
-      <*> subtree "contract" do
-            many do
-              inside "declaration:" do
-                declaration
-
-  where
-    contract'
-      :: ASTInfo
-      -> [Pascal ASTInfo]
-      -> Pascal ASTInfo
-    contract' r = foldr (contract'' $ getElem r) (mk r ContractEnd)
-
-    contract''
-      :: Range
-      -> Pascal ASTInfo
-      -> Pascal ASTInfo
-      -> Pascal ASTInfo
-    contract'' r x xs = mk (Cons r' rest) $ ContractCons x xs
-      where
-        r' = Range start end f
-        Range _ end f = r
-        Cons (Range start _ _) rest = infoOf x
-
-name :: Parser (Pascal ASTInfo)
-name = ranged do pure Name <*> token "Name"
-
-typeName :: Parser (Pascal ASTInfo)
-typeName = ranged do pure TypeName <*> token "TypeName"
-
-fieldName :: Parser (Pascal ASTInfo)
-fieldName = ranged do pure FieldName <*> token "FieldName"
-
-capitalName :: Parser (Pascal ASTInfo)
-capitalName = ranged do pure Name <*> token "Name_Capital"
-
-declaration :: Parser (Pascal ASTInfo)
-declaration
-  =   do ranged do pure ValueDecl <*> binding
-  <|> do ranged do pure ValueDecl <*> vardecl
-  <|> do ranged do pure ValueDecl <*> constdecl
-  <|> do ranged do pure Action    <*> attributes
-  <|> do typedecl
-  <|> do include
-
-include :: Parser (Pascal ASTInfo)
-include = do
-  subtree "include" do
-    inside "filename" do
-      ranged do
-        f <- token "String"
-        t <- restart contract (init $ tail $ Text.unpack f)
-        return $ Include f t
-
-typedecl :: Parser (Pascal ASTInfo)
-typedecl = do
-  subtree "type_decl" do
-    ranged do
-      pure TypeDecl
-        <*> inside "typeName:"  typeName
-        <*> inside "typeValue:" newtype_
-
-vardecl :: Parser (Pascal ASTInfo)
-vardecl = do
-  subtree "var_decl" do
-    ranged do
-      pure Var
-        <*> inside "name"  name
-        <*> inside "type"  type_
-        <*> inside "value" expr
-
-constdecl :: Parser (Pascal ASTInfo)
-constdecl = do
-  subtree "const_decl" do
-    ranged do
-      pure Const
-        <*> inside "name" name
-        <*> inside "type" type_
-        <*> inside "value" expr
-
-binding :: Parser (Pascal ASTInfo)
-binding = do
-  inside ":fun_decl" do
-    ranged do
-      pure Function
-        <*> recursive
-        <*> inside "name:"  name
-        <*> inside "parameters:parameters" do
-              many do
-                inside "parameter" paramDecl
-        <*> inside "type:" type_
-        <*> inside "body:" letExpr
-
-recursive :: Parser Bool
-recursive = do
-  mr <- optional do
-    inside "recursive" do
-      token "recursive"
-
-  return $ maybe False (== "recursive") mr
-
-expr :: Parser (Pascal ASTInfo)
-expr = stubbed "expr" do
-  select
-    [ -- Wait, isn't it `qname`? TODO: replace.
-      ranged do
-        pure Ident <*> do
-          ranged do
-            pure QualifiedName
-              <*> name
-              <*> pure []
-    , opCall
-    , fun_call
-    , record_expr
-    , int_literal
-    , tez_literal
-    , par_call
-    , method_call
-    , if_expr
-    , assign
-    , list_expr
-    , has_type
-    , string_literal
-    , attributes
-    , tuple_expr
-    , moduleQualified
-    , big_map_expr
-    , map_expr
-    , map_remove
-    , indexing
-    , constr_call
-    , nat_literal
-    , nullary_ctor
-    , bytes_literal
-    , case_expr
-    , skip
-    , case_action
-    , clause_block
-    , loop
-    , seq_expr
-    , lambda_expr
-    , set_expr
-    , map_patch
-    , record_update
-    , set_patch
-    , set_remove
-    ]
-
-set_remove :: Parser (Pascal ASTInfo)
-set_remove = do
-  subtree "set_remove" do
-    ranged do
-      pure SetRemove
-        <*> inside "key" expr
-        <*> inside "container" do
-          inside ":path" do
-            qname <|> projection
-
-set_patch :: Parser (Pascal ASTInfo)
-set_patch = do
-  subtree "set_patch" do
-    ranged do
-      pure SetPatch
-        <*> inside "container:path" (qname <|> projection)
-        <*> many do inside "key" expr
-
-record_update :: Parser (Pascal ASTInfo)
-record_update = do
-  subtree "update_record" do
-    ranged do
-      pure RecordUpd
-        <*> inside "record:path" do qname <|> projection
-        <*> many do inside "assignment" field_path_assignment
-
-field_path_assignment :: Parser (Pascal ASTInfo)
-field_path_assignment = do
-  subtree "field_path_assignment" do
-    ranged do
-      pure FieldAssignment
-        <*> inside "lhs:fpath" do fqname <|> projection
-        <*> inside "_rhs" expr
-
-map_patch :: Parser (Pascal ASTInfo)
-map_patch = do
-  subtree "map_patch" do
-    ranged do
-      pure MapPatch
-        <*> inside "container:path" (qname <|> projection)
-        <*> many do inside "binding" map_binding
-
-set_expr :: Parser (Pascal ASTInfo)
-set_expr = do
-  subtree "set_expr" do
-    ranged do
-      pure List <*> many do
-        inside "element" expr
-
-lambda_expr :: Parser (Pascal ASTInfo)
-lambda_expr = do
-  subtree "fun_expr" do
-    ranged do
-      pure Lambda
-        <*> inside "parameters:parameters" do
-              many do inside "parameter" paramDecl
-        <*> inside "type" newtype_
-        <*> inside "body" expr
-
-seq_expr :: Parser (Pascal ASTInfo)
-seq_expr = do
-  subtree "block" do
-    ranged do
-      pure Seq <*> many do
-        inside "statement" do
-          declaration <|> statement
-
-loop :: Parser (Pascal ASTInfo)
-loop = do
-  subtree "loop" do
-    for_loop <|> while_loop <|> for_container
-
-for_container :: Parser (Pascal ASTInfo)
-for_container = do
-  subtree "for_loop" do
-    ranged do
-      pure ForBox
-        <*> inside "key" name
-        <*> optional do inside "value" name
-        <*> inside "kind" anything
-        <*> inside "collection" expr
-        <*> inside "body" (expr <|> seq_expr)
-
-while_loop :: Parser (Pascal ASTInfo)
-while_loop = do
-  subtree "while_loop" do
-    ranged do
-      pure WhileLoop
-        <*> inside "breaker" expr
-        <*> inside "body"    expr
-
-for_loop :: Parser (Pascal ASTInfo)
-for_loop = do
-  subtree "for_loop" do
-    ranged do
-      pure ForLoop
-        <*> inside "name"  name
-        <*> inside "begin" expr
-        <*> inside "end"   expr
-        <*> inside "body"  expr
-
-clause_block :: Parser (Pascal ASTInfo)
-clause_block = do
-    subtree "clause_block" do
-      inside "block:block" do
-        ranged do
-          pure Seq <*> many do
-            inside "statement" (declaration <|> statement)
-  <|> do
-    subtree "clause_block" do
-      ranged do
-        pure Seq <*> many do
-          inside "statement" (declaration <|> statement)
-
-skip :: Parser (Pascal ASTInfo)
-skip = do
-  ranged do
-    pure Skip
-      <* token "skip"
-
-case_action :: Parser (Pascal ASTInfo)
-case_action = do
-  subtree "case_instr" do
-    ranged do
-      pure Case
-        <*> inside "subject" expr
-        <*> many do
-              inside "case" alt_action
-
-alt_action :: Parser (Pascal ASTInfo)
-alt_action = do
-  subtree "case_clause_instr" do
-    ranged do
-      pure Alt
-        <*> inside "pattern"        pattern
-        <*> inside "body:if_clause" expr
-
-case_expr :: Parser (Pascal ASTInfo)
-case_expr = do
-  subtree "case_expr" do
-    ranged do
-      pure Case
-        <*> inside "subject" expr
-        <*> many do
-              inside "case" alt
-
-alt :: Parser (Pascal ASTInfo)
-alt = do
-  subtree "case_clause_expr" do
-    ranged do
-      pure Alt
-        <*> inside "pattern" pattern
-        <*> inside "body"    expr
-
-pattern :: Parser (Pascal ASTInfo)
-pattern = do
-  subtree "pattern" $ do
-      inside "the" core_pattern
-    <|>
-      do ranged do
-           pure IsCons
-             <*> inside "head" core_pattern
-             <*> inside "tail" pattern
-
-core_pattern :: Parser (Pascal ASTInfo)
-core_pattern
-  =   constr_pattern
-  <|> string_pattern
-  <|> int_pattern
-  <|> nat_pattern
-  <|> tuple_pattern
-  <|> list_pattern
-  <|> some_pattern
-  <|> var_pattern
-
-var_pattern :: Parser (Pascal ASTInfo)
-var_pattern =
-  ranged do
-    pure IsVar <*> name
-
-some_pattern :: Parser (Pascal ASTInfo)
-some_pattern = do
-  subtree "Some_pattern" do
-    ranged do
-      pure IsConstr
-        <*> inside "constr" do
-              ranged do
-                pure Name <*> token "Some"
-
-        <*> do Just <$> inside "arg" pattern
-
-string_pattern :: Parser (Pascal ASTInfo)
-string_pattern =
-  ranged do
-    pure IsConstant <*> do
-      ranged do
-        pure String <*> token "String"
-
-nat_pattern :: Parser (Pascal ASTInfo)
-nat_pattern =
-  ranged do
-      pure IsConstant <*> do
-        ranged do
-          pure Nat <*> token "Nat"
-
-int_pattern :: Parser (Pascal ASTInfo)
-int_pattern =
-  ranged do
-    pure IsConstant <*> do
-      ranged do
-        pure Int <*> token "Int"
-
-constr_pattern :: Parser (Pascal ASTInfo)
-constr_pattern =
-    do
-      subtree "user_constr_pattern" do
-        ranged do
-          pure IsConstr
-            <*> inside "constr:constr" capitalName
-            <*> optional do
-                  inside "arguments" tuple_pattern
-  <|>
-    do
-      ranged do
-        pure IsConstr
-          <*> ranged do
-                pure Name <*> do
-                  true <|> false <|> none <|> unit
-          <*> pure Nothing
-
-tuple_pattern :: Parser (Pascal ASTInfo)
-tuple_pattern = do
-  subtree "tuple_pattern" do
-    ranged do
-      pure IsTuple <*> many do
-        inside "element" pattern
-
-list_pattern :: Parser (Pascal ASTInfo)
-list_pattern = do
-  subtree "list_pattern" do
-    ranged do
-      pure IsList <*> many do
-        inside "element" pattern
-
-nullary_ctor :: Parser (Pascal ASTInfo)
-nullary_ctor = do
-  ranged do
-    pure Ident <*> do
-      ranged do
-        pure QualifiedName
-          <*> ranged do
-                pure Name <*> do
-                   true <|> false <|> none <|> unit
-          <*> pure []
-
-true, false, none, unit :: Parser Text
-true  = token "True"
-false = token "False"
-none  = token "None"
-unit  = token "Unit"
-
-nat_literal :: Parser (Pascal ASTInfo)
-nat_literal = do
-  ranged do
-    pure Constant <*> do
-      ranged do
-        pure Nat <*> token "Nat"
-
-bytes_literal :: Parser (Pascal ASTInfo)
-bytes_literal = do
-  ranged do
-    pure Constant <*> do
-      ranged do
-        pure Bytes <*> token "Bytes"
-
-constr_call :: Parser (Pascal ASTInfo)
-constr_call = do
-  some_call <|> user_constr_call
-  where
-    some_call = do
-      subtree "Some_call" do
-        ranged do
-          pure Apply
-            <*> ranged do
-                  pure Ident <*> inside "constr" qname'
-            <*> inside "arguments:arguments" do
-              many do inside "argument" expr
-
-    user_constr_call = do
-      subtree "constr_call" do
-        ranged do
-          pure Apply
-            <*> inside "constr:constr" do
-                  ranged do
-                    pure Ident <*> do
-                      ranged do
-                        pure QualifiedName
-                          <*> capitalName
-                          <*> pure []
-            <*> inside "arguments:arguments" do
-                  many do
-                    inside "argument" expr
-
-indexing :: Parser (Pascal ASTInfo)
-indexing = do
-  subtree "map_lookup" do
-    ranged do
-      pure Indexing
-        <*> inside "container:path" do
-              qname <|> projection
-        <*> inside "index" expr
-
-map_remove :: Parser (Pascal ASTInfo)
-map_remove = do
-  subtree "map_remove" do
-    ranged do
-      pure MapRemove
-        <*> inside "key" expr
-        <*> inside "container" do
-          inside ":path" do
-            qname <|> projection
-
-big_map_expr :: Parser (Pascal ASTInfo)
-big_map_expr = do
-  subtree "big_map_injection" do
-    ranged do
-      pure BigMap <*> many do
-        inside "binding" do
-          map_binding
-
-map_expr :: Parser (Pascal ASTInfo)
-map_expr = do
-  subtree "map_injection" do
-    ranged do
-      pure Map <*> many do
-        inside "binding" do
-          map_binding
-
-map_binding :: Parser (Pascal ASTInfo)
-map_binding = do
-  subtree "binding" do
-    ranged do
-      pure MapBinding
-        <*> inside "key"   expr
-        <*> inside "value" expr
-
-moduleQualified :: Parser (Pascal ASTInfo)
-moduleQualified = do
-  subtree "module_field" do
-    ranged do
-      pure Ident <*> do
-        ranged do
-          pure QualifiedName
-            <*> inside "module" capitalName
-            <*> do pure <$> ranged do
-                    pure At <*> inside "method" do name <|> name'
-
-tuple_expr :: Parser (Pascal ASTInfo)
-tuple_expr = do
-  subtree "tuple_expr" do
-    ranged do
-      pure Tuple <*> many do
-        inside "element" expr
-
-attributes :: Parser (Pascal ASTInfo)
-attributes = do
-  subtree "attr_decl" do
-    ranged do
-      pure Attrs <*> many do
-        inside "attribute" do
-          token "String"
-
-string_literal :: Parser (Pascal ASTInfo)
-string_literal = do
-  ranged do
-    pure Constant <*> do
-      ranged do
-        pure String <*> do
-          token "String"
-
-has_type :: Parser (Pascal ASTInfo)
-has_type = do
-  subtree "annot_expr" do
-    ranged do
-      pure Annot
-        <*> inside "subject" expr
-        <*> inside "type"    type_
-
-list_expr :: Parser (Pascal ASTInfo)
-list_expr = do
-  subtree "list_expr" do
-    ranged do
-      pure List <*> many do
-        inside "element" expr
-
-qname :: Parser (Pascal ASTInfo)
-qname = do
-  ranged do
-    pure QualifiedName
-      <*> name
-      <*> pure []
-
-fqname :: Parser (Pascal ASTInfo)
-fqname = do
-  ranged do
-    pure QualifiedName
-      <*> fieldName
-      <*> pure []
-
-qname' :: Parser (Pascal ASTInfo)
-qname' = do
-  ranged do
-    pure QualifiedName
-      <*> name'
-      <*> pure []
-
-assign :: Parser (Pascal ASTInfo)
-assign = do
-  subtree "assignment" do
-    ranged do
-      pure Assign
-        <*> inside "LHS" lhs
-        <*> inside "RHS" expr
-
-lhs :: Parser (Pascal ASTInfo)
-lhs =
-  ranged do
-    pure LHS
-      <*> inside "container:path" do
-            qname <|> projection
-      <*> pure Nothing
-  <|>
-  ranged do
-    pure LHS
-      <*> subtree "path" do
-            qname <|> projection
-      <*> pure Nothing
-  <|>
-  subtree "map_lookup" do
-    ranged do
-      pure LHS
-        <*> inside "container:path" do
-              qname <|> projection
-        <*> inside "index" do
-              Just <$> expr
-
-
-tez_literal :: Parser (Pascal ASTInfo)
-tez_literal = do
-  ranged do
-    pure Constant <*> do
-      ranged do
-        pure Tez <*> token "Tez"
-
-if_expr :: Parser (Pascal ASTInfo)
-if_expr = do
-    subtree "conditional" do
-      ranged do
-        pure If
-          <*> inside "selector"       expr
-          <*> inside "then:if_clause" expr
-          <*> inside "else:if_clause" expr
-  <|> do
-    subtree "cond_expr" do
-      ranged do
-        pure If
-          <*> inside "selector"       expr
-          <*> inside "then" expr
-          <*> inside "else" expr
-
-method_call :: Parser (Pascal ASTInfo)
-method_call = do
-  subtree "projection_call" do
-    ranged do
-      pure apply'
-        <*> getInfo
-        <*> inside "f" projection
-        <*> optional do inside "arguments" arguments
-  where
-    apply' i f (Just xs) = Apply (mk i $ Ident f) xs
-    apply' _ f _         = Ident f
-
-projection :: Parser (Pascal ASTInfo)
-projection = do
-  subtree "data_projection" do
-    ranged do
-      pure QualifiedName
-        <*> inside "struct" name
-        <*> many selection
-
-selection :: Parser (Pascal ASTInfo)
-selection = do
-    inside "index:selection"
-      $   ranged do pure At <*> fieldName
-      <|> ranged do pure Ix <*> token "Int"
-  <|>
-    inside "index" do
-      ranged do pure Ix <*> token "Int"
-
-par_call :: Parser (Pascal ASTInfo)
-par_call = do
-  subtree "par_call" do
-    pure apply'
-      <*> getInfo
-      <*> inside "f" expr
-      <*> optional do inside "arguments" arguments
-  where
-    apply'
-      :: ASTInfo
-      -> Pascal ASTInfo
-      -> Maybe [Pascal ASTInfo]
-      -> Pascal ASTInfo
-    apply' i f (Just xs) = mk i $ Apply f xs
-    apply' _ f  _        = f
-
-int_literal :: Parser (Pascal ASTInfo)
-int_literal = do
-  ranged do
-    pure Constant
-      <*> ranged do
-        pure Int <*> token "Int"
-
-record_expr :: Parser (Pascal ASTInfo)
-record_expr = do
-  subtree "record_expr" do
-    ranged do
-      pure Record <*> many do
-        inside "assignment:field_assignment" do
-          ranged do
-            pure Assignment
-              <*> inside "name" fieldName
-              <*> inside "_rhs" expr
-
-fun_call :: Parser (Pascal ASTInfo)
-fun_call = do
-  subtree "fun_call" do
-    ranged do
-      pure Apply
-        <*> inside "f" function_id
-        <*> inside "arguments" arguments
-
-arguments :: Parser [Pascal ASTInfo]
-arguments =
-  subtree "arguments" do
-    many do inside "argument" expr
-
-function_id :: Parser (Pascal ASTInfo)
-function_id = ranged do
-  pure Ident <*> select
-    [ qname
-    , do
-        subtree "module_field" do
-          ranged do
-            pure QualifiedName
-              <*> inside "module" capitalName
-              <*> do pure <$> ranged do
-                      pure At <*> inside "method" do name <|> name'
-    ]
-
-opCall :: Parser (Pascal ASTInfo)
-opCall = do
-  subtree "op_expr"
-    $   do inside "the" expr
-    <|> ranged do
-          pure BinOp
-            <*> inside "arg1" expr
-            <*> inside "op"   anything
-            <*> inside "arg2" expr
-    <|> ranged do
-          pure UnOp
-            <*> inside "negate" anything
-            <*> inside "arg"    expr
-
-letExpr :: Parser (Pascal ASTInfo)
-letExpr = do
-  subtree "let_expr" do
-    pure let'
-      <*> getInfo
-      <*> optional do
-        inside "locals:block" do
-          many do
-            inside "statement" do
-              declaration <|> statement
-      <*> inside "body"expr
-  where
-    let'
-      :: ASTInfo
-      -> (Maybe [Pascal ASTInfo])
-      -> Pascal ASTInfo
-      -> Pascal ASTInfo
-    let' r decls body = case decls of
-      Just them -> foldr (let'' $ getElem r) body them
-      Nothing   -> body
-
-    let''
-      :: Range
-      -> Pascal ASTInfo
-      -> Pascal ASTInfo
-      -> Pascal ASTInfo
-    let'' r decl b =
-        mk (Cons r' rest) $ Let decl b
-      where
-        r' = Range start end f
-        Range _ end f = r
-        Cons (Range start _ _) rest = infoOf decl
-
-statement :: Parser (Pascal ASTInfo)
-statement = ranged do pure Action <*> expr
-
-paramDecl :: Parser (Pascal ASTInfo)
-paramDecl = do
-  subtree "param_decl" do
-    ranged do
-      pure Decl
-        <*> inside "access" do
-              ranged do
-                access' =<< anything
-        <*> inside "name" name
-        <*> inside "type" type_
-  where
-    access' "var"   = pure Mutable
-    access' "const" = pure Immutable
-    access' _       = die  "`var` or `const`"
-
-newtype_ :: Parser (Pascal ASTInfo)
-newtype_ = select
-  [ record_type
-  , type_
-  , sum_type
-  ]
-
-sum_type :: Parser (Pascal ASTInfo)
-sum_type = do
-  subtree "sum_type" do
-    ranged do
-      pure TSum <*> many do
-        inside "variant" variant
-
-variant :: Parser (Pascal ASTInfo)
-variant = do
-  subtree "variant" do
-    ranged do
-      pure Variant
-        <*> inside "constructor:constr" capitalName
-        <*> optional do inside "arguments" type_
-
-record_type :: Parser (Pascal ASTInfo)
-record_type = do
-  subtree "record_type" do
-    ranged do
-      pure TRecord <*> many do
-        inside "field" do
-          field_decl
-
-field_decl :: Parser (Pascal ASTInfo)
-field_decl = do
-  subtree "field_decl" do
-    ranged do
-      pure TField
-        <*> inside "fieldName" fieldName
-        <*> inside "fieldType" newtype_
-
-type_ :: Parser (Pascal ASTInfo)
-type_ =
-    fun_type
-  where
-    fun_type :: Parser (Pascal ASTInfo)
-    fun_type = do
-      inside ":fun_type" do
-        pure tarrow
-          <*> getInfo
-          <*>             inside "domain"  cartesian
-          <*> optional do inside "codomain" fun_type
-
-      where
-        tarrow i domain codomain =
-          case codomain of
-            Just co -> mk i $ TArrow domain co
-            Nothing -> domain
-
-    cartesian = do
-      inside ":cartesian" do
-        ranged do
-          pure TProduct <*> some do
-            inside "element" do
-              core_type
-
-    core_type = do
-      select
-        [ ranged do pure TVar <*> typeName
-        , subtree "invokeBinary" do
-            ranged do
-              pure TApply
-                <*> inside "typeConstr" name'
-                <*> inside "arguments"  typeTuple
-        , subtree "invokeUnary" do
-            ranged do
-              pure TApply
-                <*> inside "typeConstr" name'
-                <*> do pure <$> inside "arguments" type_
-
-        , subtree "type_expr" newtype_
-        ]
-
-name' :: Parser (Pascal ASTInfo)
-name' = do
-  ranged do pure Name <*> anything
-
-typeTuple :: Parser [Pascal ASTInfo]
-typeTuple = do
-  subtree "type_tuple" do
-    many do inside "element" type_
-
-sample :: IO (Pascal ASTInfo)
-sample = runParser' contract (Path example)
-
-example :: FilePath
--- example = "../../../src/test/contracts/application.ligo"
--- example = "../../../src/test/contracts/address.ligo"
--- example = "../../../src/test/contracts/amount.ligo"
--- example = "../../../src/test/contracts/annotation.ligo"
 -- example = "../../../src/test/contracts/arithmetic.ligo"
--- example = "../../../src/test/contracts/assign.ligo"
+-- example = "../../../src/test/contracts/address.ligo"
+-- example = "../../../src/test/contracts/annotation.ligo"
+-- example = "../../../src/test/contracts/amount.ligo"
 -- example = "../../../src/test/contracts/attributes.ligo"
--- example = "../../../src/test/contracts/bad_timestamp.ligo"
--- example = "../../../src/test/contracts/bad_type_operator.ligo"
--- example = "../../../src/test/contracts/balance_constant.ligo"
--- example = "../../../src/test/contracts/big_map.ligo"
--- example = "../../../src/test/contracts/bitwise_arithmetic.ligo"
--- example = "../../../src/test/contracts/blockless.ligo"
--- example = "../../../src/test/contracts/boolean_operators.ligo"
--- example = "../../../src/test/contracts/bytes_arithmetic.ligo"
--- example = "../../../src/test/contracts/bytes_unpack.ligo"
--- example = "../../../src/test/contracts/chain_id.ligo"
--- example = "../../../src/test/contracts/coase.ligo"
--- example = "../../../src/test/contracts/failwith.ligo"
--- example = "../../../src/test/contracts/loop.ligo"
--- example = "../../../src/test/contracts/redeclaration.ligo"
--- example = "../../../src/test/contracts/includer.ligo"
--- example = "../../../src/test/contracts/namespaces.ligo"
--- example = "../../../src/test/contracts/blocks.ligo"
-example = "../../../src/test/contracts/negative/fail1.ligo"
 -- example = "../../../src/test/contracts/application.ligo"
+-- example = "../../../src/test/contracts/assign.ligo"
+-- example = "../../../src/test/contracts/big_map.ligo"
+-- example = "../../../src/test/contracts/blockless.ligo"
+-- example = "../../../src/test/contracts/bad_timestamp.ligo"
+-- example = "../../../src/test/contracts/boolean_operators.ligo"
+-- example = "../../../src/test/contracts/bitwise_arithmetic.ligo"
+-- example = "../../../src/test/contracts/bad_type_operator.ligo"
+-- example = "../../../src/test/contracts/blocks.ligo"
+-- example = "../../../src/test/contracts/bytes_unpack.ligo"
+-- example = "../../../src/test/contracts/balance_constant.ligo"
+-- example = "../../../src/test/contracts/blockless.ligo"
+-- example = "../../../src/test/contracts/bytes_arithmetic.ligo"
+-- example = "../../../src/test/contracts/chain_id.ligo"
+example = "../../../src/test/contracts/closure-3.ligo"
+
+sample' :: FilePath -> IO Doc
+sample' f
+  =   toParseTree (Path f)
+  >>= runParserM . recognise
+  >>= return . pp . fst
+
+source' :: FilePath -> IO ()
+source' f
+  =   toParseTree (Path f)
+  >>= print . pp
+
+sample :: IO ()
+sample
+  =   toParseTree (Path example)
+  >>= runParserM . recognise
+  >>= print . pp . fst
+
+source :: IO ()
+source
+  =   toParseTree (Path example)
+  >>= print . pp
+
+recognise :: RawTree -> ParserM (LIGO Info)
+recognise = descent (error . show . pp) $ map usingScope
+  [ -- Contract
+    Descent
+    [ boilerplate \case
+        "Start" -> RawContract <$> fields "declaration"
+        _ -> fallthrough
+    ]
+
+    -- Expr
+  , Descent
+    [ boilerplate \case
+        "let_expr"          -> Let       <$> field  "locals"    <*> field "body"
+        "fun_call"          -> Apply     <$> field  "f"         <*> field "arguments"
+        "par_call"          -> Apply     <$> field  "f"         <*> field "arguments"
+        "projection_call"   -> Apply     <$> field  "f"         <*> field "arguments"
+        "Some_call"         -> Apply     <$> field  "constr"    <*> field "arguments"
+        "constr_call"       -> Apply     <$> field  "constr"    <*> field "arguments"
+        "arguments"         -> Tuple     <$> fields "argument"
+        "unop"              -> UnOp      <$> field  "negate"    <*> field "arg"
+        "binop"             -> BinOp     <$> field  "arg1"      <*> field "op"   <*> field "arg2"
+        "block"             -> Seq       <$> fields "statement"
+        "clause_block"      -> Seq       <$> fields "statement"
+        "list_expr"         -> List      <$> fields "element"
+        "annot_expr"        -> Annot     <$> field  "subject"   <*> field "type"
+        "conditional"       -> If        <$> field  "selector"  <*> field "then" <*> field "else"
+        "cond_expr"         -> If        <$> field  "selector"  <*> field "then" <*> field "else"
+        "assignment"        -> Assign    <$> field  "LHS"       <*> field "RHS"
+        "attr_decl"         -> Attrs     <$> fields "attribute"
+        "record_expr"       -> Record    <$> fields "assignment"
+        "big_map_injection" -> BigMap    <$> fields "binding"
+        "map_remove"        -> MapRemove <$> field  "key"       <*> field "container"
+        "tuple_expr"        -> Tuple     <$> fields "element"
+        "skip"              -> return Skip
+        "case_expr"         -> Case      <$> field  "subject"    <*> fields   "case"
+        "case_instr"        -> Case      <$> field  "subject"    <*> fields   "case"
+        "fun_expr"          -> Lambda    <$> field  "parameters" <*> field    "type"  <*> field "body"
+        "for_cycle"         -> ForLoop   <$> field  "name"       <*> field    "begin" <*> field "end" <*> fieldOpt "step" <*> field "body"
+        "for_box"           -> ForBox    <$> field  "key"        <*> fieldOpt "value" <*> field "kind"  <*> field "collection" <*> field "body"
+        "while_loop"        -> WhileLoop <$> field  "breaker"    <*> field    "body"
+        "map_injection"     -> Map       <$> fields "binding"
+        "list_injection"    -> List      <$> fields "element"
+        "set_expr"          -> Set       <$> fields "element"
+        "map_patch"         -> MapPatch  <$> field  "container"  <*> fields "binding"
+        "set_patch"         -> SetPatch  <$> field  "container"  <*> fields "key"
+        "set_remove"        -> SetRemove <$> field  "key"        <*> field  "container"
+        "map_remove"        -> SetRemove <$> field  "key"        <*> field  "container"
+        "update_record"     -> RecordUpd <$> field  "record"     <*> fields "assignment"
+        _                   -> fallthrough
+    ]
+
+    -- Pattern
+  , Descent
+    [ boilerplate \case
+        "user_constr_pattern" -> IsConstr <$> field  "constr" <*> fieldOpt "arguments"
+        "tuple_pattern"       -> IsTuple  <$> fields "element"
+        "nil"                 -> return $ IsList []
+        "list_pattern"        -> IsList   <$> fields "element"
+        "cons_pattern"        -> IsCons   <$> field  "head"   <*> field "tail"
+        _                     -> fallthrough
+    ]
+
+    -- Alt
+  , Descent
+    [ boilerplate \case
+        "case_clause_expr"  -> Alt <$> field "pattern" <*> field  "body"
+        "case_clause_instr" -> Alt <$> field "pattern" <*> field  "body"
+        _                   -> fallthrough
+    ]
+
+    -- FieldAssignment
+  , Descent
+    [ boilerplate \case
+        "field_assignment"      -> FieldAssignment <$> field "name" <*> field "_rhs"
+        "field_path_assignment" -> FieldAssignment <$> field "lhs"  <*> field "_rhs"
+        _                  -> fallthrough
+    ]
+
+    -- MapBinding
+  , Descent
+    [ boilerplate \case
+        "binding" -> MapBinding <$> field "key" <*> field "value"
+        _         -> fallthrough
+    ]
+
+  , Descent
+    [ boilerplate' \case
+        ("negate",     op) -> return $ Op op
+        ("adder",      op) -> return $ Op op
+        ("multiplier", op) -> return $ Op op
+        ("comparison", op) -> return $ Op op
+        ("^",          _)  -> return $ Op "^"
+        ("#",          _)  -> return $ Op "#"
+        _                  -> fallthrough
+    ]
+
+  , Descent
+    [ boilerplate \case
+        "data_projection" -> QualifiedName <$> field "struct"    <*> fields "index"
+        "map_lookup"      -> QualifiedName <$> field "container" <*> fields "index"
+        "module_field"    -> QualifiedName <$> field "module"    <*> fields "method"
+        _                 -> fallthrough
+    ]
+
+    -- Literal
+  , Descent
+    [ boilerplate' \case
+        ("Int",    i) -> return $ Int i
+        ("Nat",    i) -> return $ Nat i
+        ("Bytes",  i) -> return $ Bytes i
+        ("String", i) -> return $ String i
+        ("Tez",    i) -> return $ Tez i
+        _             -> fallthrough
+    ]
+
+    -- Declaration
+  , Descent
+    [ boilerplate \case
+        "fun_decl"   -> Function <$> (isJust <$> fieldOpt "recursive") <*> field "name" <*> field "parameters" <*> field "type" <*> field "body"
+        "const_decl" -> Const    <$>             field    "name"       <*> field "type" <*> field "value"
+        "var_decl"   -> Var      <$>             field    "name"       <*> field "type" <*> field "value"
+        "type_decl"  -> TypeDecl <$>             field    "typeName"   <*> field "typeValue"
+        "include"    -> Include  <$>             field    "filename"
+        _            -> fallthrough
+    ]
+
+    -- Parameters
+  , Descent
+    [ boilerplate \case
+        "parameters" -> Parameters <$> fields "parameter"
+        _            -> fallthrough
+    ]
+
+    -- VarDecl
+  , Descent
+    [ boilerplate \case
+        "param_decl" -> Decl <$> field "access" <*> field "name" <*> field "type"
+        _            -> fallthrough
+    ]
+
+    -- Mutable
+  , Descent
+    [ boilerplate \case
+        "const" -> return Immutable
+        "var"   -> return Mutable
+        _       -> fallthrough
+    ]
+
+    -- Name
+  , Descent
+    [ boilerplate' \case
+        ("Name", n) -> return $ Name n
+        ("and", _)  -> return $ Name "and"
+        ("or", _)   -> return $ Name "or"
+        _           -> fallthrough
+    ]
+
+    -- Type
+  , Descent
+    [ boilerplate \case
+        "fun_type"         -> TArrow   <$> field  "domain"     <*> field "codomain"
+        "cartesian"        -> TProduct <$> fields "element"
+        "invokeBinary"     -> TApply   <$> field  "typeConstr" <*> field "arguments"
+        "invokeUnary"      -> TApply   <$> field  "typeConstr" <*> field "arguments"
+        "type_tuple"       -> TTuple   <$> fields "element"
+        "record_type"      -> TRecord  <$> fields "field"
+        "sum_type"         -> TSum     <$> fields "variant"
+        "michelsonTypeOr"  -> TOr      <$> field "left_type" <*> field "left_type_name" <*> field "right_type" <*> field "right_type_name"
+        "michelsonTypeAnd" -> TAnd     <$> field "left_type" <*> field "left_type_name" <*> field "right_type" <*> field "right_type_name"
+        _                 -> fallthrough
+    ]
+
+    -- Variant
+  , Descent
+    [ boilerplate \case
+        "variant" -> Variant <$> field "constructor" <*> fieldOpt "arguments"
+        _         -> fallthrough
+    ]
+
+    -- TField
+  , Descent
+    [ boilerplate \case
+        "field_decl" -> TField <$> field "fieldName" <*> field "fieldType"
+        _            -> fallthrough
+    ]
+
+    -- TypeName
+  , Descent
+    [ boilerplate' \case
+        ("TypeName", name) -> return $ TypeName name
+        ("list",     _)    -> return $ TypeName "list"
+        ("big_map",  _)    -> return $ TypeName "big_map"
+        ("map",      _)    -> return $ TypeName "map"
+        ("set",      _)    -> return $ TypeName "set"
+        ("option",   _)    -> return $ TypeName "option"
+        ("contract", _)    -> return $ TypeName "contract"
+        _                  -> fallthrough
+    ]
+
+    -- Ctor
+  , Descent
+    [ boilerplate' \case
+        ("Name_Capital", name) -> return $ Ctor name
+        ("Some", _)            -> return $ Ctor "Some"
+        ("Some_pattern", _)    -> return $ Ctor "Some"
+        ("None", _)            -> return $ Ctor "None"
+        ("True", _)            -> return $ Ctor "True"
+        ("False", _)           -> return $ Ctor "False"
+        ("Unit", _)            -> return $ Ctor "Unit"
+        ("constr", n)          -> return $ Ctor n
+        _                      -> fallthrough
+    ]
+
+    -- FieldName
+  , Descent
+    [ boilerplate' \case
+        ("FieldName", name) -> return $ FieldName name
+        _                   -> fallthrough
+    ]
+
+    -- Err
+  , Descent
+    [ \(r :> _, ParseTree _ _ text) -> do
+        withComments do
+          return $ Just (r :> N :> Nil, Err text)
+    ]
+
+  , Descent
+    [ \case
+        (r :> _, ParseTree "ERROR" _ text) -> do
+          return $ Just ([] :> r :> Y :> Nil, Err text)
+
+        _ -> return Nothing
+    ]
+  ]
diff --git a/tools/lsp/squirrel/src/AST/Scope.hs b/tools/lsp/squirrel/src/AST/Scope.hs
index f62d79f3a..c75989c8d 100644
--- a/tools/lsp/squirrel/src/AST/Scope.hs
+++ b/tools/lsp/squirrel/src/AST/Scope.hs
@@ -23,318 +23,319 @@ import           Data.Maybe          (listToMaybe)
 import           Data.Sum            (Element, Apply, Sum)
 import           Data.Text           (Text)
 
+import           Duplo.Lattice
+import           Duplo.Pretty
+import           Duplo.Tree
+
 -- import           AST.Parser
 import           AST.Types
 -- import           Comment
-import           Lattice
 -- import           Parser
-import           Pretty
 import           Product
 import           Range
-import           Tree
 
 -- import           Debug.Trace
 
-type CollectM = State (Product [FullEnv, [Range]])
+-- type CollectM = State (Product [FullEnv, [Range]])
 
-type FullEnv = Product ["vars" := Env, "types" := Env]
-type Env     = Map Range [ScopedDecl]
+-- type FullEnv = Product ["vars" := Env, "types" := Env]
+-- type Env     = Map Range [ScopedDecl]
 
-data Category = Variable | Type
+-- data Category = Variable | Type
 
--- | The type/value declaration.
-data ScopedDecl = ScopedDecl
-  { _sdName    :: Pascal ()
-  , _sdOrigin  :: Range
-  , _sdBody    :: Maybe Range
-  , _sdType    :: Maybe (Either (Pascal ()) Kind)
-  , _sdRefs    :: [Range]
-  }
-  deriving Show via PP ScopedDecl
+-- -- | The type/value declaration.
+-- data ScopedDecl = ScopedDecl
+--   { _sdName    :: Pascal ()
+--   , _sdOrigin  :: Range
+--   , _sdBody    :: Maybe Range
+--   , _sdType    :: Maybe (Either (Pascal ()) Kind)
+--   , _sdRefs    :: [Range]
+--   }
+--   deriving Show via PP ScopedDecl
 
--- | The kind.
-data Kind = Star
-  deriving Show via PP Kind
+-- -- | The kind.
+-- data Kind = Star
+--   deriving Show via PP Kind
 
-emptyEnv :: FullEnv
-emptyEnv
-  = Cons (Tag Map.empty)
-  $ Cons (Tag Map.empty)
-    Nil
+-- emptyEnv :: FullEnv
+-- emptyEnv
+--   = Cons (Tag Map.empty)
+--   $ Cons (Tag Map.empty)
+--     Nil
 
-with :: Category -> FullEnv -> (Env -> Env) -> FullEnv
-with Variable env f = modTag @"vars"  f env
-with Type     env f = modTag @"types" f env
+-- with :: Category -> FullEnv -> (Env -> Env) -> FullEnv
+-- with Variable env f = modTag @"vars"  f env
+-- with Type     env f = modTag @"types" f env
 
-ofCategory :: Category -> ScopedDecl -> Bool
-ofCategory Variable ScopedDecl { _sdType = Just (Right Star) } = False
-ofCategory Variable _                                          = True
-ofCategory Type     ScopedDecl { _sdType = Just (Right Star) } = True
-ofCategory _        _                                          = False
+-- ofCategory :: Category -> ScopedDecl -> Bool
+-- ofCategory Variable ScopedDecl { _sdType = Just (Right Star) } = False
+-- ofCategory Variable _                                          = True
+-- ofCategory Type     ScopedDecl { _sdType = Just (Right Star) } = True
+-- ofCategory _        _                                          = False
 
--- | Calculate scopes and attach to all tree points declarations that are
---   visible there.
---
-addLocalScopes
-  :: Contains Range xs
-  => Pascal (Product xs)
-  -> Pascal (Product ([ScopedDecl] : Maybe Category : xs))
-addLocalScopes tree =
-    fmap (\xs -> Cons (fullEnvAt envWithREfs (getRange xs)) xs) tree1
-  where
-    tree1       = addNameCategories tree
-    envWithREfs = getEnvTree tree
+-- -- | Calculate scopes and attach to all tree points declarations that are
+-- --   visible there.
+-- --
+-- addLocalScopes
+--   :: Contains Range xs
+--   => Pascal (Product xs)
+--   -> Pascal (Product ([ScopedDecl] : Maybe Category : xs))
+-- addLocalScopes tree =
+--     fmap (\xs -> Cons (fullEnvAt envWithREfs (getRange xs)) xs) tree1
+--   where
+--     tree1       = addNameCategories tree
+--     envWithREfs = getEnvTree tree
 
-addNameCategories
-  :: Contains Range xs
-  => Pascal (Product xs)
-  -> Pascal (Product (Maybe Category : xs))
-addNameCategories tree = flip evalState emptyEnv do
-  traverseMany
-    [ Visit \r (Name t) -> do
-        modify $ getRange r `addRef` (Variable, t)
-        return $ (Cons (Just Variable) r, Name t)
+-- addNameCategories
+--   :: Contains Range xs
+--   => Pascal (Product xs)
+--   -> Pascal (Product (Maybe Category : xs))
+-- addNameCategories tree = flip evalState emptyEnv do
+--   traverseMany
+--     [ Visit \r (Name t) -> do
+--         modify $ getRange r `addRef` (Variable, t)
+--         return $ (Cons (Just Variable) r, Name t)
 
-    , Visit \r (TypeName t) -> do
-        modify $ getRange r `addRef` (Type, t)
-        return $ (Cons (Just Type) r, TypeName t)
-    ]
-    (Cons Nothing)
-    tree
+--     , Visit \r (TypeName t) -> do
+--         modify $ getRange r `addRef` (Type, t)
+--         return $ (Cons (Just Type) r, TypeName t)
+--     ]
+--     (Cons Nothing)
+--     tree
 
-getEnvTree
-  :: ( UpdateOver CollectM (Sum fs) (Tree fs b)
-     , Apply Foldable fs
-     , Apply Functor fs
-     , Apply Traversable fs
-     , HasRange b
-     , Element Name fs
-     , Element TypeName fs
-     )
-  => Tree fs b
-  -> FullEnv
-getEnvTree tree = envWithREfs
-  where
-    envWithREfs = flip execState env do
-      traverseMany
-        [ Visit \r (Name t) -> do
-            modify $ getRange r `addRef` (Variable, t)
-            return $ (r, Name t)
+-- getEnvTree
+--   :: ( Scoped CollectM (Sum fs) (Tree fs b)
+--      , Apply Foldable fs
+--      , Apply Functor fs
+--      , Apply Traversable fs
+--      , HasRange b
+--      , Element Name fs
+--      , Element TypeName fs
+--      )
+--   => Tree fs b
+--   -> FullEnv
+-- getEnvTree tree = envWithREfs
+--   where
+--     envWithREfs = flip execState env do
+--       traverseMany
+--         [ Visit \r (Name t) -> do
+--             modify $ getRange r `addRef` (Variable, t)
+--             return $ (r, Name t)
 
-        , Visit \r (TypeName t) -> do
-            modify $ getRange r `addRef` (Type, t)
-            return $ (r, TypeName t)
-        ]
-        id
-        tree
+--         , Visit \r (TypeName t) -> do
+--             modify $ getRange r `addRef` (Type, t)
+--             return $ (r, TypeName t)
+--         ]
+--         id
+--         tree
 
-    env
-      = execCollectM
-      $ traverseTree pure tree
+--     env
+--       = execCollectM
+--       $ traverseTree pure tree
 
-fullEnvAt :: FullEnv -> Range -> [ScopedDecl]
-fullEnvAt fe r = envAt (getTag @"types" fe) r <> envAt (getTag @"vars" fe) r
+-- fullEnvAt :: FullEnv -> Range -> [ScopedDecl]
+-- fullEnvAt fe r = envAt (getTag @"types" fe) r <> envAt (getTag @"vars" fe) r
 
-envAt :: Env -> Range -> [ScopedDecl]
-envAt env pos =
-    Map.elems scopes
-  where
-    ranges = List.sortBy partOrder $ filter isCovering $ Map.keys env
-    scopes = Map.unions $ (map.foldMap) toScopeMap $ map (env Map.!) ranges
+-- envAt :: Env -> Range -> [ScopedDecl]
+-- envAt env pos =
+--     Map.elems scopes
+--   where
+--     ranges = List.sortBy partOrder $ filter isCovering $ Map.keys env
+--     scopes = Map.unions $ (map.foldMap) toScopeMap $ map (env Map.!) ranges
 
-    isCovering = (pos <?)
-    toScopeMap sd@ScopedDecl {_sdName} = Map.singleton (ppToText _sdName) sd
+--     isCovering = (pos <?)
+--     toScopeMap sd@ScopedDecl {_sdName} = Map.singleton (ppToText _sdName) sd
 
-addRef :: Range -> (Category, Text) -> FullEnv -> FullEnv
-addRef r (categ, n) env =
-  with categ env \slice ->
-    Map.union
-      (go slice $ range slice)
-      slice
-  where
-    go slice (r' : rest) =
-      let decls = slice Map.! r'
-      in
-        case updateOnly n r addRefToDecl decls of
-          (True,  decls') -> Map.singleton r' decls'
-          (False, decls') -> Map.insert    r' decls' (go slice rest)
-    go _ [] = Map.empty
+-- addRef :: Range -> (Category, Text) -> FullEnv -> FullEnv
+-- addRef r (categ, n) env =
+--   with categ env \slice ->
+--     Map.union
+--       (go slice $ range slice)
+--       slice
+--   where
+--     go slice (r' : rest) =
+--       let decls = slice Map.! r'
+--       in
+--         case updateOnly n r addRefToDecl decls of
+--           (True,  decls') -> Map.singleton r' decls'
+--           (False, decls') -> Map.insert    r' decls' (go slice rest)
+--     go _ [] = Map.empty
 
-    range slice
-      = List.sortBy partOrder
-      $ filter (r <?)
-      $ Map.keys slice
+--     range slice
+--       = List.sortBy partOrder
+--       $ filter (r <?)
+--       $ Map.keys slice
 
-    addRefToDecl sd = sd
-      { _sdRefs = r : _sdRefs sd
-      }
+--     addRefToDecl sd = sd
+--       { _sdRefs = r : _sdRefs sd
+--       }
 
-updateOnly
-  :: Text
-  -> Range
-  -> (ScopedDecl -> ScopedDecl)
-  -> [ScopedDecl]
-  -> (Bool, [ScopedDecl])
-updateOnly name r f = go
-  where
-    go = \case
-      d : ds
-        | ppToText (_sdName d) == name ->
-          if r == _sdOrigin d
-          then         (True,   d : ds)
-          else         (True, f d : ds)
-        | otherwise -> second (d :) (go ds)
+-- updateOnly
+--   :: Text
+--   -> Range
+--   -> (ScopedDecl -> ScopedDecl)
+--   -> [ScopedDecl]
+--   -> (Bool, [ScopedDecl])
+-- updateOnly name r f = go
+--   where
+--     go = \case
+--       d : ds
+--         | ppToText (_sdName d) == name ->
+--           if r == _sdOrigin d
+--           then         (True,   d : ds)
+--           else         (True, f d : ds)
+--         | otherwise -> second (d :) (go ds)
 
-      [] -> (False, [])
+--       [] -> (False, [])
 
-enter :: Range -> CollectM ()
-enter r = do
-  modify $ modElem (r :)
+-- enter :: Range -> CollectM ()
+-- enter r = do
+--   modify $ modElem (r :)
 
-define :: Category -> ScopedDecl -> CollectM ()
-define categ sd = do
-  r <- gets (head . getElem @[Range])
-  modify
-    $ modElem @FullEnv \env ->
-        with categ env
-        $ Map.insertWith (++) r [sd]
+-- define :: Category -> ScopedDecl -> CollectM ()
+-- define categ sd = do
+--   r <- gets (head . getElem @[Range])
+--   modify
+--     $ modElem @FullEnv \env ->
+--         with categ env
+--         $ Map.insertWith (++) r [sd]
 
-leave :: CollectM ()
-leave = modify $ modElem @[Range] tail
+-- leave :: CollectM ()
+-- leave = modify $ modElem @[Range] tail
 
--- | Run the computation with scope starting from empty scope.
-execCollectM :: CollectM a -> FullEnv
-execCollectM action = getElem $ execState action $ Cons emptyEnv (Cons [] Nil)
+-- -- | Run the computation with scope starting from empty scope.
+-- execCollectM :: CollectM a -> FullEnv
+-- execCollectM action = getElem $ execState action $ Cons emptyEnv (Cons [] Nil)
 
-instance {-# OVERLAPS #-} Pretty FullEnv where
-  pp = block . map aux . Map.toList . mergeFE
-    where
-      aux (r, fe) =
-        pp r `indent` block fe
+-- instance {-# OVERLAPS #-} Pretty FullEnv where
+--   pp = block . map aux . Map.toList . mergeFE
+--     where
+--       aux (r, fe) =
+--         pp r `indent` block fe
 
-      mergeFE fe = getTag @"vars" @Env fe <> getTag @"types" fe
+--       mergeFE fe = getTag @"vars" @Env fe <> getTag @"types" fe
 
-instance Pretty ScopedDecl where
-  pp (ScopedDecl n o _ t refs) = color 3 (pp n) <+> pp o <+> ":" <+> color 4 (maybe "?" (either pp pp) t) <+> "=" <+> pp refs
+-- instance Pretty ScopedDecl where
+--   pp (ScopedDecl n o _ t refs) = color 3 (pp n) <+> pp o <+> ":" <+> color 4 (maybe "?" (either pp pp) t) <+> "=" <+> pp refs
 
-instance Pretty Kind where
-  pp _ = "TYPE"
+-- instance Pretty Kind where
+--   pp _ = "TYPE"
 
-instance Pretty Category where
-  pp Variable = "Variable"
-  pp Type     = "Type"
+-- instance Pretty Category where
+--   pp Variable = "Variable"
+--   pp Type     = "Type"
 
--- | Search for a name inside a local scope.
-lookupEnv :: Text -> [ScopedDecl] -> Maybe ScopedDecl
-lookupEnv name = listToMaybe . filter ((name ==) . ppToText . _sdName)
+-- -- | Search for a name inside a local scope.
+-- lookupEnv :: Text -> [ScopedDecl] -> Maybe ScopedDecl
+-- lookupEnv name = listToMaybe . filter ((name ==) . ppToText . _sdName)
 
--- | Add a type declaration to the current scope.
-defType :: HasRange a => Pascal a -> Kind -> Pascal a -> CollectM ()
-defType name kind body = do
-  define Type
-    $ ScopedDecl
-      (void name)
-      (getRange $ infoOf name)
-      (Just $ getRange $ infoOf body)
-      (Just (Right kind))
-      []
+-- -- | Add a type declaration to the current scope.
+-- defType :: HasRange a => Pascal a -> Kind -> Pascal a -> CollectM ()
+-- defType name kind body = do
+--   define Type
+--     $ ScopedDecl
+--       (void name)
+--       (getRange $ infoOf name)
+--       (Just $ getRange $ infoOf body)
+--       (Just (Right kind))
+--       []
 
--- observe :: Pretty i => Pretty res => Text -> i -> res -> res
--- observe msg i res
---   = traceShow (pp msg, "INPUT", pp i)
---   $ traceShow (pp msg, "OUTPUT", pp res)
---   $ res
+-- -- observe :: Pretty i => Pretty res => Text -> i -> res -> res
+-- -- observe msg i res
+-- --   = traceShow (pp msg, "INPUT", pp i)
+-- --   $ traceShow (pp msg, "OUTPUT", pp res)
+-- --   $ res
 
--- | Add a value declaration to the current scope.
-def
-  :: HasRange a
-  => Pascal a
-  -> Maybe (Pascal a)
-  -> Maybe (Pascal a)
-  -> CollectM ()
-def name ty body = do
-  define Variable
-    $ ScopedDecl
-      (void name)
-      (getRange $ infoOf name)
-      ((getRange . infoOf) <$> body)
-      ((Left . void) <$> ty)
-      []
+-- -- | Add a value declaration to the current scope.
+-- def
+--   :: HasRange a
+--   => Pascal a
+--   -> Maybe (Pascal a)
+--   -> Maybe (Pascal a)
+--   -> CollectM ()
+-- def name ty body = do
+--   define Variable
+--     $ ScopedDecl
+--       (void name)
+--       (getRange $ infoOf name)
+--       ((getRange . infoOf) <$> body)
+--       ((Left . void) <$> ty)
+--       []
 
-instance UpdateOver CollectM Contract (Pascal a) where
-  before r _ = enter r
-  after  _ _ = skip
+-- instance UpdateOver CollectM Contract (Pascal a) where
+--   before r _ = enter r
+--   after  _ _ = skip
 
-instance HasRange a => UpdateOver CollectM Declaration (Pascal a) where
-  before _ = \case
-    TypeDecl ty body -> defType ty Star body
-    _ -> skip
+-- instance HasRange a => UpdateOver CollectM Declaration (Pascal a) where
+--   before _ = \case
+--     TypeDecl ty body -> defType ty Star body
+--     _ -> skip
 
-instance HasRange a => UpdateOver CollectM Binding (Pascal a) where
-  before r = \case
-    Function recur name _args ty body -> do
-      when recur do
-        def name (Just ty) (Just body)
-      enter r
+-- instance HasRange a => UpdateOver CollectM Binding (Pascal a) where
+--   before r = \case
+--     Function recur name _args ty body -> do
+--       when recur do
+--         def name (Just ty) (Just body)
+--       enter r
 
-    _ -> enter r
+--     _ -> enter r
 
-  after _ = \case
-    Irrefutable name    body -> do leave; def name  Nothing  (Just body)
-    Var         name ty body -> do leave; def name (Just ty) (Just body)
-    Const       name ty body -> do leave; def name (Just ty) (Just body)
-    Function recur name _args ty body -> do
-      leave
-      unless recur do
-        def name (Just ty) (Just body)
+--   after _ = \case
+--     Irrefutable name    body -> do leave; def name  Nothing  (Just body)
+--     Var         name ty body -> do leave; def name (Just ty) (Just body)
+--     Const       name ty body -> do leave; def name (Just ty) (Just body)
+--     Function recur name _args ty body -> do
+--       leave
+--       unless recur do
+--         def name (Just ty) (Just body)
 
-instance HasRange a => UpdateOver CollectM VarDecl (Pascal a) where
-  after _ (Decl _ name ty) = def name (Just ty) Nothing
+-- instance HasRange a => UpdateOver CollectM VarDecl (Pascal a) where
+--   after _ (Decl _ name ty) = def name (Just ty) Nothing
 
-instance UpdateOver CollectM Mutable (Pascal a)
-instance UpdateOver CollectM Type    (Pascal a)
-instance UpdateOver CollectM Variant (Pascal a)
-instance UpdateOver CollectM TField  (Pascal a)
+-- instance UpdateOver CollectM Mutable (Pascal a)
+-- instance UpdateOver CollectM Type    (Pascal a)
+-- instance UpdateOver CollectM Variant (Pascal a)
+-- instance UpdateOver CollectM TField  (Pascal a)
 
-instance HasRange a => UpdateOver CollectM Expr (Pascal a) where
-  before r = \case
-    Let    {} -> enter r
-    Lambda {} -> enter r
-    ForLoop k _ _ _ -> do
-      enter r
-      def k Nothing Nothing
+-- instance HasRange a => UpdateOver CollectM Expr (Pascal a) where
+--   before r = \case
+--     Let    {} -> enter r
+--     Lambda {} -> enter r
+--     ForLoop k _ _ _ -> do
+--       enter r
+--       def k Nothing Nothing
 
-    ForBox k mv _ _ _ -> do
-      enter r
-      def k Nothing Nothing
-      maybe skip (\v -> def v Nothing Nothing) mv
+--     ForBox k mv _ _ _ -> do
+--       enter r
+--       def k Nothing Nothing
+--       maybe skip (\v -> def v Nothing Nothing) mv
 
-    _ -> skip
+--     _ -> skip
 
-  after _ = \case
-    Let     {} -> leave
-    Lambda  {} -> leave
-    ForLoop {} -> leave
-    ForBox  {} -> leave
-    _ -> skip
+--   after _ = \case
+--     Let     {} -> leave
+--     Lambda  {} -> leave
+--     ForLoop {} -> leave
+--     ForBox  {} -> leave
+--     _ -> skip
 
-instance HasRange a => UpdateOver CollectM Alt (Pascal a) where
-  before r _ = enter r
-  after  _ _ = leave
+-- instance HasRange a => UpdateOver CollectM Alt (Pascal a) where
+--   before r _ = enter r
+--   after  _ _ = leave
 
-instance UpdateOver CollectM LHS             (Pascal a)
-instance UpdateOver CollectM MapBinding      (Pascal a)
-instance UpdateOver CollectM Assignment      (Pascal a)
-instance UpdateOver CollectM FieldAssignment (Pascal a)
-instance UpdateOver CollectM Constant        (Pascal a)
+-- instance UpdateOver CollectM LHS             (Pascal a)
+-- instance UpdateOver CollectM MapBinding      (Pascal a)
+-- instance UpdateOver CollectM Assignment      (Pascal a)
+-- instance UpdateOver CollectM FieldAssignment (Pascal a)
+-- instance UpdateOver CollectM Constant        (Pascal a)
 
-instance HasRange a => UpdateOver CollectM Pattern (Pascal a) where
-  before _ = \case
-    IsVar n -> def n Nothing Nothing
-    _       -> skip
+-- instance HasRange a => UpdateOver CollectM Pattern (Pascal a) where
+--   before _ = \case
+--     IsVar n -> def n Nothing Nothing
+--     _       -> skip
 
-instance UpdateOver CollectM QualifiedName (Pascal a)
-instance UpdateOver CollectM Path          (Pascal a)
-instance UpdateOver CollectM Name          (Pascal a)
-instance UpdateOver CollectM TypeName      (Pascal a)
-instance UpdateOver CollectM FieldName     (Pascal a)
+-- instance UpdateOver CollectM QualifiedName (Pascal a)
+-- instance UpdateOver CollectM Path          (Pascal a)
+-- instance UpdateOver CollectM Name          (Pascal a)
+-- instance UpdateOver CollectM TypeName      (Pascal a)
+-- instance UpdateOver CollectM FieldName     (Pascal a)
diff --git a/tools/lsp/squirrel/src/AST/Types.hs b/tools/lsp/squirrel/src/AST/Types.hs
index f016b51f2..8d05be0e9 100644
--- a/tools/lsp/squirrel/src/AST/Types.hs
+++ b/tools/lsp/squirrel/src/AST/Types.hs
@@ -7,9 +7,11 @@
 module AST.Types where
 
 import Data.Text (Text)
+import qualified Data.Text as Text
 
-import Pretty
-import Tree
+import Duplo.Pretty
+import Duplo.Tree
+import Duplo.Error
 
 -- import Debug.Trace
 
@@ -17,34 +19,57 @@ import Tree
 --
 --   TODO: Rename; add stuff if CamlLIGO/ReasonLIGO needs something.
 --
-type Pascal = Tree
+type LIGO = Tree RawLigoList
+
+type RawLigoList =
   [ Name, Path, QualifiedName, Pattern, Constant, FieldAssignment, Assignment
   , MapBinding, LHS, Alt, Expr, TField, Variant, Type, Mutable, VarDecl, Binding
-  , Declaration, Contract, TypeName, FieldName
+  , RawContract, TypeName, FieldName, Language
+  , Err Text, Parameters, Ctor
   ]
 
+data Undefined it
+  = Undefined Text
+  deriving (Show) via PP (Undefined it)
+  deriving stock (Functor, Foldable, Traversable)
+
+data Language it
+  = Language Lang it
+  deriving (Show) via PP (Language it)
+  deriving stock (Functor, Foldable, Traversable)
+
+data Lang
+  = Pascal
+  | Caml
+  | Reason
+  -- deriving (Show) via PP Lang
+
 data Contract it
   = ContractEnd
   | ContractCons it it -- ^ Declaration
   deriving (Show) via PP (Contract it)
   deriving stock (Functor, Foldable, Traversable)
 
-data Declaration it
-  = ValueDecl it     -- ^ Binding
-  | TypeDecl  it it  -- ^ Name Type
-  | Action    it     -- ^ Expr
-  | Include   Text it
-  deriving (Show) via PP (Declaration it)
+data RawContract it
+  = RawContract [it] -- ^ Declaration
+  deriving (Show) via PP (RawContract it)
   deriving stock (Functor, Foldable, Traversable)
 
 data Binding it
   = Irrefutable  it it               -- ^ (Pattern) (Expr)
-  | Function     Bool it [it] it it  -- ^ (Name) [VarDecl] (Type) (Expr)
+  | Function     Bool it it it it    -- ^ (Name) Parameters (Type) (Expr)
   | Var          it it it            -- ^ (Name) (Type) (Expr)
   | Const        it it it            -- ^ (Name) (Type) (Expr)
+  | TypeDecl     it it               -- ^ Name Type
+  | Include      it
   deriving (Show) via PP (Binding it)
   deriving stock (Functor, Foldable, Traversable)
 
+data Parameters it
+  = Parameters [it]
+  deriving (Show) via PP (Parameters it)
+  deriving stock (Functor, Foldable, Traversable)
+
 data VarDecl it
   = Decl         it it it  -- ^ (Mutable) (Name) (Type)
   deriving (Show) via PP (VarDecl it)
@@ -63,7 +88,10 @@ data Type it
   | TVar      it       -- ^ (Name)
   | TSum      [it]     -- ^ [Variant]
   | TProduct  [it]     -- ^ [Type]
-  | TApply    it [it]  -- (Name) [Type]
+  | TApply    it it  -- (Name) [Type]
+  | TTuple    [it]
+  | TOr       it it it it
+  | TAnd      it it it it
   deriving (Show) via PP (Type it)
   deriving stock (Functor, Foldable, Traversable)
 
@@ -79,12 +107,13 @@ data TField it
 
 -- | TODO: break onto smaller types? Literals -> Constant; mapOps; mmove Annots to Decls.
 data Expr it
-  = Let       it it -- Declaration (Expr)
-  | Apply     it [it] -- (Expr) [Expr]
+  = Let       it it   -- Declaration Expr
+  | Apply     it it -- (Expr) [Expr]
   | Constant  it -- (Constant)
   | Ident     it -- (QualifiedName)
-  | BinOp     it Text it -- (Expr) Text (Expr)
-  | UnOp      Text it -- (Expr)
+  | BinOp     it it it -- (Expr) Text (Expr)
+  | UnOp      it it -- (Expr)
+  | Op        Text
   | Record    [it] -- [Assignment]
   | If        it it it -- (Expr) (Expr) (Expr)
   | Assign    it it -- (LHS) (Expr)
@@ -92,7 +121,7 @@ data Expr it
   | Set       [it] -- [Expr]
   | Tuple     [it] -- [Expr]
   | Annot     it it -- (Expr) (Type)
-  | Attrs     [Text]
+  | Attrs     [it]
   | BigMap    [it] -- [MapBinding]
   | Map       [it] -- [MapBinding]
   | MapRemove it it -- (Expr) (QualifiedName)
@@ -100,11 +129,11 @@ data Expr it
   | Indexing  it it -- (QualifiedName) (Expr)
   | Case      it [it]                  -- (Expr) [Alt]
   | Skip
-  | ForLoop   it it it it              -- (Name) (Expr) (Expr) (Expr)
+  | ForLoop   it it it (Maybe it) it              -- (Name) (Expr) (Expr) (Expr)
   | WhileLoop it it                    -- (Expr) (Expr)
   | Seq       [it]                     -- [Declaration]
-  | Lambda    [it] it it               -- [VarDecl] (Type) (Expr)
-  | ForBox    it (Maybe it) Text it it -- (Name) (Maybe (Name)) Text (Expr) (Expr)
+  | Lambda    it it it               -- [VarDecl] (Type) (Expr)
+  | ForBox    it (Maybe it) it it it -- (Name) (Maybe (Name)) Text (Expr) (Expr)
   | MapPatch  it [it] -- (QualifiedName) [MapBinding]
   | SetPatch  it [it] -- (QualifiedName) [Expr]
   | RecordUpd it [it] -- (QualifiedName) [FieldAssignment]
@@ -159,7 +188,7 @@ data Pattern it
 
 data QualifiedName it
   = QualifiedName
-    { qnSource :: it -- Name
+    { qnSource ::  it -- Name
     , qnPath   :: [it] -- [Path]
     }
   deriving (Show) via PP (QualifiedName it)
@@ -181,43 +210,55 @@ newtype TypeName it = TypeName Text
   deriving (Show) via PP (TypeName it)
   deriving stock   (Functor, Foldable, Traversable)
 
+newtype Ctor it = Ctor Text
+  deriving (Show) via PP (Ctor it)
+  deriving stock   (Functor, Foldable, Traversable)
+
 newtype FieldName it = FieldName Text
   deriving (Show) via PP (TypeName it)
   deriving stock   (Functor, Foldable, Traversable)
 
+instance Pretty1 Language where
+  pp1 = \case
+    Language _ p -> p
+
+instance Pretty1 Undefined where
+  pp1 = \case
+    Undefined mess -> "{{{" <.> pp (Text.take 20 mess) <.> "}}}"
+
 instance Pretty1 Contract where
   pp1 = \case
     ContractEnd -> "(* end *)"
     ContractCons x xs -> x $$ " " $$ xs
 
-instance Pretty1 Declaration where
+instance Pretty1 RawContract where
   pp1 = \case
-    ValueDecl binding -> binding
-    TypeDecl  n ty    -> "type" <+> n <+> "=" `indent` ty
-    Action    e       -> e
-
-    Include   f t     ->
-      "(* module" <+> pp f <+> "*)"
-        `indent` pp t
-        `above` "(* end" <+> pp f <+> "*)"
+    RawContract xs -> "(* begin *)" `indent` sparseBlock xs `above` "(* end *)"
 
 instance Pretty1 Binding where
   pp1 = \case
-    Irrefutable  pat expr -> "irref" <+> pat <+> "=" `indent` expr
-    Function     isRec name params ty body ->
+    Irrefutable  pat  expr     -> "irref" <+> pat  <+> "=" `indent` expr
+    TypeDecl     n    ty       -> "type"  <+> n    <+> "=" `indent` ty
+    Var          name ty value -> "var"   <+> name <+> ":" <+> ty <+> ":=" `indent` value
+    Const        name ty body  -> "const" <+> name <+> ":" <+> ty <+>  "=" `indent` body
+    Include      fname         -> "#include" <+> fname
+
+    Function isRec name params ty body ->
       (
         (
           (   (if isRec then "recursive" else empty)
           <+> "function"
           <+> name
           )
-          `indent` tuple params
+          `indent` params
         )
-        `indent` (":" <+> ty <+> "is")
+        `indent` (":" <+> ty `above` "is")
       )
       `indent` body
-    Var   name ty value -> "var"   <+> name <+> ":" <+> ty <+> ":=" `indent` value
-    Const name ty body  -> "const" <+> name <+> ":" <+> ty <+>  "=" `indent` body
+
+instance Pretty1 Parameters where
+  pp1 = \case
+    Parameters them -> tuple them
 
 instance Pretty1 VarDecl where
   pp1 = \case
@@ -235,7 +276,10 @@ instance Pretty1 Type where
     TVar      name      -> name
     TSum      variants  -> block variants
     TProduct  elements  -> train " *" elements
-    TApply    f xs      -> f <> tuple xs
+    TApply    f xs      -> f <+> xs
+    TTuple    xs        -> tuple xs
+    TOr       l n r m   -> "michelson_or"   <+> tuple [l, n, r, m]
+    TAnd      l n r m   -> "michelson_pair" <+> tuple [l, n, r, m]
 
 instance Pretty1 Variant where
   pp1 = \case
@@ -244,12 +288,13 @@ instance Pretty1 Variant where
 
 instance Pretty1 Expr where
   pp1 = \case
-    Let       decl body -> "block {" `indent` decl `above` "}" <+> "with" `indent` body
-    Apply     f xs       -> f <+> tuple xs
+    Let       decl body  -> decl `above` "with" `indent` body
+    Apply     f xs       -> f <+> xs
     Constant  constant   -> constant
     Ident     qname      -> qname
     BinOp     l o r      -> parens (l <+> pp o <+> r)
     UnOp        o r      -> parens (pp o <+> r)
+    Op          o        -> pp o
     Record    az         -> "record" <+> list az
     If        b t e      -> fsep ["if" `indent` b, "then" `indent` t, "else" `indent` e]
     Assign    l r        -> l <+> ":=" `indent` r
@@ -262,14 +307,14 @@ instance Pretty1 Expr where
     Map       bs         ->  "map"       <+> list bs
     MapRemove k m        -> "remove" `indent` k `above` "from" <+> "map" `indent` m
     SetRemove k s        -> "remove" `indent` k `above` "from" <+> "set" `indent` s
-    Indexing  a j        -> a <> list [j]
+    Indexing  a j        -> a <.> list [j]
     Case      s az       -> "case" <+> s <+> "of" `indent` block az
     Skip                 -> "skip"
-    ForLoop   j s f b    -> "for" <+> j <+> ":=" <+> s <+> "to" <+> f `indent` b
+    ForLoop   j s f d b  -> "for" <+> j <+> ":=" <+> s <+> "to" <+> f <+> mb ("step" <+>) d `indent` b
     ForBox    k mv t z b -> "for" <+> k <+> mb ("->" <+>) mv <+> "in" <+> pp t <+> z `indent` b
     WhileLoop f b        -> "while" <+> f `indent` b
-    Seq       es         -> "block {" `indent` sparseBlock es `above` "}"
-    Lambda    ps ty b    -> (("function" `indent` tuple ps) `indent` (":" <+> ty)) `indent` b
+    Seq       es         -> "block {" `indent` block es `above` "}"
+    Lambda    ps ty b    -> (("function" `indent` ps) `indent` (":" <+> ty)) `indent` b
     MapPatch  z bs       -> "patch" `indent` z `above` "with" <+> "map" `indent` list bs
     SetPatch  z bs       -> "patch" `indent` z `above` "with" <+> "set" `indent` list bs
     RecordUpd r up       -> r `indent` "with" <+> "record" `indent` list up
@@ -301,7 +346,7 @@ instance Pretty1 Constant where
 
 instance Pretty1 QualifiedName where
   pp1 = \case
-    QualifiedName src path -> src <> sepByDot path
+    QualifiedName src path -> src <.> sepByDot path
 
 instance Pretty1 Pattern where
   pp1 = \case
@@ -326,6 +371,10 @@ instance Pretty1 FieldName where
   pp1 = \case
     FieldName    raw -> pp raw
 
+instance Pretty1 Ctor where
+  pp1 = \case
+    Ctor         raw -> pp raw
+
 instance Pretty1 Path where
   pp1 = \case
     At n -> n
@@ -333,8 +382,8 @@ instance Pretty1 Path where
 
 instance Pretty1 TField where
   pp1 = \case
-    TField      n t -> n <> ":" `indent` t
+    TField      n t -> n <.> ":" `indent` t
 
 instance Pretty1 LHS where
   pp1 = \case
-    LHS    qn mi -> qn <> foldMap brackets mi
+    LHS    qn mi -> qn <.> foldMap brackets mi
diff --git a/tools/lsp/squirrel/src/Comment.hs b/tools/lsp/squirrel/src/Comment.hs
index 2c7c9d863..a87a89a2c 100644
--- a/tools/lsp/squirrel/src/Comment.hs
+++ b/tools/lsp/squirrel/src/Comment.hs
@@ -11,7 +11,8 @@ module Comment
 import qualified Data.Text as Text
 import           Data.Text   (Text)
 
-import Pretty
+import Duplo.Pretty
+
 import Product
 
 -- | Ability to contain comments.
diff --git a/tools/lsp/squirrel/src/Debouncer.hs b/tools/lsp/squirrel/src/Debouncer.hs
index b90f7bacb..00151d510 100644
--- a/tools/lsp/squirrel/src/Debouncer.hs
+++ b/tools/lsp/squirrel/src/Debouncer.hs
@@ -36,4 +36,4 @@ test = debounced \s -> do
   threadDelay 2000000
   unless (odd (length s)) do
     error "even"
-  return (length s)
\ No newline at end of file
+  return (length s)
diff --git a/tools/lsp/squirrel/src/Error.hs b/tools/lsp/squirrel/src/Error.hs
deleted file mode 100644
index 22a8ff38f..000000000
--- a/tools/lsp/squirrel/src/Error.hs
+++ /dev/null
@@ -1,58 +0,0 @@
-
-{- | Parsing Errors and utilities.
--}
-
-module Error
-  ( Error(..)
-  , HasErrors (..)
-  , Stubbed (..)
-  )
-  where
-
-import Control.Monad.Catch
-
-import Data.Text (Text, pack)
-import Data.Typeable
-
-import Pretty
-
--- | Parse Error.
-data Error info
-  = Expected
-    { eMsg   :: Text   -- ^ Description of what was expected.
-    , eWhole :: Text   -- ^ Offending text.
-    , eInfo  :: info   -- ^ Location of the Error.
-    }
-  deriving (Show) via PP (Error info)
-  deriving stock (Eq, Functor, Foldable, Traversable)
-
-instance (Pretty i, Typeable i) => Exception (Error i)
-
-instance Pretty1 Error where
-  pp1 (Expected msg found r) = "░" <> pp msg <> r <> "▒" <> pp found <> "▓"
-
--- | Ability to contain `Error`s.
-class HasErrors h info | h -> info where
-  errors :: h -> [Error info]
-
--- | For types that have a default replacer with an `Error`.
-class Stubbed a i where
-  stub :: Error i -> a
-
-instance Pretty i => Stubbed Text i where
-  stub = pack . show
-
--- | This is bad, but I had to.
---
---   TODO: Find a way to remove this instance.
---         I probably need a wrapper around '[]'.
---
---         Or I need a @fields@ parser combinator.
---
-instance Stubbed [a] i where
-  stub = const []
-
--- | Is `Just` `.` @stubbing@.
-instance Stubbed a i => Stubbed (Maybe a) i where
-  stub = Just . stub
-
diff --git a/tools/lsp/squirrel/src/Lattice.hs b/tools/lsp/squirrel/src/Lattice.hs
deleted file mode 100644
index feff2dc18..000000000
--- a/tools/lsp/squirrel/src/Lattice.hs
+++ /dev/null
@@ -1,26 +0,0 @@
-
-{- | The property the @Tree@ @info@ should abide.
--}
-
-module Lattice
-  ( Lattice(..)
-  , partOrder
-  )
-  where
-
--- | A range should have this property to be used for navigation.
-class Lattice l where
-  (?>) :: l -> l -> Bool
-  (<?) :: l -> l -> Bool
-
-  (?>) = flip (<?)
-  (<?) = flip (?>)
-
-  {-# minimal (?>) | (<?) #-}
-
-partOrder :: Lattice l => l -> l -> Ordering
-partOrder a b | a <? b && b <? a = EQ
-partOrder a b | a <? b           = LT
-partOrder a b |           b <? a = GT
-partOrder _ _                    = error "partOrder: Non-orderable"
-
diff --git a/tools/lsp/squirrel/src/ParseTree.hs b/tools/lsp/squirrel/src/ParseTree.hs
index 98c00dd7f..744e0a8f2 100644
--- a/tools/lsp/squirrel/src/ParseTree.hs
+++ b/tools/lsp/squirrel/src/ParseTree.hs
@@ -10,11 +10,13 @@
 module ParseTree
   ( -- * Tree/Forest
     ParseTree(..)
-  , ParseForest(..)
   , Source(..)
+  , RawTree
+  , RawInfo
 
     -- * Invoke the TreeSitter and get the tree it outputs
   , toParseTree
+  -- , example
   )
   where
 
@@ -27,7 +29,7 @@ import Data.Text (Text)
 import Data.Traversable (for)
 
 import           TreeSitter.Parser
-import           TreeSitter.Tree
+import           TreeSitter.Tree hiding (Tree)
 import           TreeSitter.Language
 import           TreeSitter.Node
 import           Foreign.C.String (peekCString)
@@ -42,12 +44,16 @@ import           Foreign.Storable               ( peek
                                                 )
 import           Control.Monad ((>=>))
 
-import           System.FilePath
+import           System.FilePath                (takeFileName)
 
-import Text.PrettyPrint hiding ((<>))
+import           System.IO.Unsafe (unsafePerformIO)
+
+import Duplo.Pretty
+import Duplo.Tree
 
 import Range
-import Pretty
+import Product
+import Debouncer
 
 foreign import ccall unsafe tree_sitter_PascaLigo :: Ptr Language
 
@@ -62,110 +68,97 @@ srcToBytestring = \case
   Text       _ t -> return $ Text.encodeUtf8 t
   ByteString _ s -> return s
 
+type RawTree = Tree '[ParseTree] RawInfo
+type RawInfo = Product [Range, Text]
+
+instance Modifies RawInfo where
+  ascribe (r :> n :> _) d = color 3 (pp n) <+> pp r `indent` pp d
+
 -- | The tree tree-sitter produces.
-data ParseTree = ParseTree
-  { ptID       :: Int          -- ^ Unique number, for fast comparison.
-  , ptName     :: Text         -- ^ Name of the node.
-  , ptRange    :: Range        -- ^ Range of the node.
-  , ptChildren :: ParseForest  -- ^ Subtrees.
+data ParseTree self = ParseTree
+  { ptName     :: Text         -- ^ Name of the node.
+  , ptChildren :: [self]       -- ^ Subtrees.
   , ptSource   :: ~Text        -- ^ Range of the node.
   }
-  deriving (Show) via PP ParseTree
+  deriving stock (Functor, Foldable, Traversable)
 
--- | The forest we work with.
-data ParseForest = Forest
-  { pfID    :: Int                  -- ^ Unique number for comparison.
-  , pfGrove :: [(Text, ParseTree)]  -- ^ Subtrees.
-  , pfRange :: Range                -- ^ Full range of the forest.
-  }
-  deriving (Show) via PP ParseForest
-
-instance Pretty ParseTree where
-  pp (ParseTree _ n r forest _) =
+instance Pretty1 ParseTree where
+  pp1 (ParseTree n forest _) =
     parens
       ( hang
-        (quotes (text (Text.unpack n)) <+> pp r)
+        (quotes (text (Text.unpack n)))
         2
         (pp forest)
       )
 
-instance Pretty ParseForest where
-  pp = vcat . map ppPair . pfGrove
-    where
-      ppPair (field, tree) =
-        if field == Text.empty
-        then nest 2 $ pp tree
-        else hang (text (Text.unpack field) <> ": ") 2 (pp tree)
-
 -- | Feed file contents into PascaLIGO grammar recogniser.
-toParseTree :: Source -> IO ParseForest
-toParseTree fin = do
-  parser <- ts_parser_new
-  True   <- ts_parser_set_language parser tree_sitter_PascaLigo
-
-  src <- srcToBytestring fin
-
-  idCounter <- newIORef 0
-
-  BS.useAsCStringLen src \(str, len) -> do
-    tree <- ts_parser_parse_string parser nullPtr str len
-    finalTree <- withRootNode tree (peek >=> go src idCounter)
-    return $ Forest 0 [("", finalTree)] (ptRange finalTree)
-
+toParseTree :: Source -> IO RawTree
+toParseTree = unsafePerformIO $ debounced inner
   where
-    nextID :: IORef Int -> IO Int
-    nextID ref = do
-      modifyIORef' ref (+ 1)
-      readIORef ref
+    inner fin = do
+      parser <- ts_parser_new
+      True   <- ts_parser_set_language parser tree_sitter_PascaLigo
 
-    go :: ByteString -> IORef Int -> Node -> IO ParseTree
-    go src idCounter node = do
-      let count = fromIntegral $ nodeChildCount node
-      allocaArray count \children -> do
-        alloca \tsNodePtr -> do
-          poke tsNodePtr $ nodeTSNode node
-          ts_node_copy_child_nodes tsNodePtr children
-          nodes <- for [0.. count - 1] \i -> do
-            peekElemOff children i
+      src <- srcToBytestring fin
 
-          trees <- for nodes \node' -> do
-            tree <- go src idCounter node'
-            field <-
-              if nodeFieldName node' == nullPtr
-              then return ""
-              else peekCString $ nodeFieldName node'
-            return (Text.pack field, tree)
+      idCounter <- newIORef 0
 
-          ty <- peekCString $ nodeType node
+      BS.useAsCStringLen src \(str, len) -> do
+        tree <- ts_parser_parse_string parser nullPtr str len
+        withRootNode tree (peek >=> go src idCounter)
 
-          let
-            start2D  = nodeStartPoint node
-            finish2D = nodeEndPoint   node
-            i = fromIntegral
+      where
+        nextID :: IORef Int -> IO Int
+        nextID ref = do
+          modifyIORef' ref (+ 1)
+          readIORef ref
 
-          treeID <- nextID idCounter
-          fID    <- nextID idCounter
+        go :: ByteString -> IORef Int -> Node -> IO RawTree
+        go src idCounter node = do
+          let count = fromIntegral $ nodeChildCount node
+          allocaArray count \children -> do
+            alloca \tsNodePtr -> do
+              poke tsNodePtr $ nodeTSNode node
+              ts_node_copy_child_nodes tsNodePtr children
+              nodes <- for [0.. count - 1] \i -> do
+                peekElemOff children i
 
-          let
-            range = Range
-              { rStart  =
-                  ( i $ pointRow    start2D + 1
-                  , i $ pointColumn start2D + 1
-                  , i $ nodeStartByte node
-                  )
+              trees <- for nodes \node' -> do
+                (only -> (r :> _, tree :: ParseTree RawTree)) <- go src idCounter node'
+                field <-
+                  if nodeFieldName node' == nullPtr
+                  then return ""
+                  else peekCString $ nodeFieldName node'
+                return $ make (r :> Text.pack field :> Nil, tree)
 
-              , rFinish =
-                  ( i $ pointRow    finish2D + 1
-                  , i $ pointColumn finish2D + 1
-                  , i $ nodeEndByte node
-                  )
-              , rFile = takeFileName $ srcPath fin
-              }
+              ty <- peekCString $ nodeType node
 
-          return $ ParseTree
-            { ptID       = treeID
-            , ptName     = Text.pack ty
-            , ptRange    = range
-            , ptChildren = Forest fID trees range
-            , ptSource   = cutOut range src
-            }
\ No newline at end of file
+              let
+                start2D  = nodeStartPoint node
+                finish2D = nodeEndPoint   node
+                i = fromIntegral
+
+              treeID <- nextID idCounter
+              fID    <- nextID idCounter
+
+              let
+                range = Range
+                  { rStart  =
+                      ( i $ pointRow    start2D + 1
+                      , i $ pointColumn start2D + 1
+                      , i $ nodeStartByte node
+                      )
+
+                  , rFinish =
+                      ( i $ pointRow    finish2D + 1
+                      , i $ pointColumn finish2D + 1
+                      , i $ nodeEndByte node
+                      )
+                  , rFile = takeFileName $ srcPath fin
+                  }
+
+              return $ make (range :> "" :> Nil, ParseTree
+                { ptName     = Text.pack ty
+                , ptChildren = trees
+                , ptSource   = cutOut range src
+                })
diff --git a/tools/lsp/squirrel/src/Parser.hs b/tools/lsp/squirrel/src/Parser.hs
index 6b3140a9d..3cdc055b0 100644
--- a/tools/lsp/squirrel/src/Parser.hs
+++ b/tools/lsp/squirrel/src/Parser.hs
@@ -1,448 +1,158 @@
 
-{- |
-  The thing that can untangle the mess that TreeSitter produces.
+module Parser where
 
-  In presence of serious errors, it /will/ be a mess, anyway.
-
-  The AST you are building must be the @Tree@ in each point.
-
-  I recommend, in your tree-sitter grammar, to add `field("foo", ...)`
-  to each sub-rule, that has `$.` in front of it -  in a rule, that doesn't
-  start with `_` in its name.
-
-  As a general rule of thumb, make each significant part a separate rule,
-  even if it is a keyword. Then, apply previous advice.
-
-  Only make rule start with `_` if it is a pure choice.
-
-  > ('block'
-  >   ...
-  >   a: <a>
-  >   ...
-  >   b: <b>
-  >   ...)
-
-  ->
-
-  > block = do
-  >   subtree "block" do
-  >     ranged do
-  >       pure Block
-  >         <*> inside "a" a
-  >         <*> inside "b" b
--}
-
-module Parser
-  ( -- * Parser type
-    Parser
-  , runParser
-  , runParser'
-  , debugParser
-
-    -- * Combinators
-  , subtree
-  , anything
-  , token
-  , stubbed
-  , getInfo
-  , inside
-  , restart
-
-    -- * Error
-  , die
-
-    -- * Replacement for `Alternative`, because reasons
-  , many
-  , some
-  , (<|>)
-  , optional
-  , select
-
-    -- * Debug
-  , dump
-
-    -- * Comments and ranges
-  , ASTInfo
-  , Source(..)
-  , module ParseTree
-  ) where
-
-import Control.Monad.Writer hiding (Product)
-import Control.Monad.State
+import Control.Arrow
 import Control.Monad.Catch
-import qualified Control.Monad.Reader as MTL
+import Control.Monad.RWS hiding (Product)
+import Control.Monad.Trans.Maybe
 
-import Data.Functor ((<&>))
-import Data.Foldable
+import Data.String.Interpolate (i)
 import Data.Text (Text)
 import qualified Data.Text as Text
-import qualified Data.Set as Set
 
-import System.FilePath
+import Duplo.Tree
+import Duplo.Error
+import Duplo.Pretty
 
 import ParseTree
 import Range
-import Pretty
-import Error
 import Product
 
 import Debug.Trace
 
--- | Parser of tree-sitter-made tree.
---
---   TODO: separate state. Polysemy?
---
-type Parser =
-   WriterT [Error ASTInfo]
-  (StateT  (Product PList)
-   IO)
+{-
+  Comment grabber has 2 buffers: 1 and 2.
 
-type PList = [ParseForest, [Text], FilePath, Set.Set FilePath]
+  1) We collect all comments before the node and append them into buffer 1.
+  2) We collect all comments after the node and put them into buffer 2.
+  3) `grabComments` takes all comments from buffer 1.
+  4) On leaving, move move comments from 2 to 1.
+-}
 
--- | Auto-accumulated information to be put into AST being build.
-type ASTInfo = Product [Range, [Text]]
+runParserM :: ParserM a -> IO (a, [Err Text ()])
+runParserM p = (\(a, _, errs) -> (a, errs)) <$> runRWST p () ([], [])
 
-runParser
-  :: Stubbed a ASTInfo
-  => Parser a
-  -> Source
-  -> IO (a, [Error ASTInfo])
-runParser parser fin = do
-  pforest <- toParseTree fin
+runParserM1 :: [RawTree] -> ParserM1 a -> ParserM (Maybe a)
+runParserM1 cs p = do
+  s <- get
+  (a, s1, w) <- lift $ runRWST (runMaybeT p) cs s
+  tell w
+  put s1
+  return a
 
-  let dir = takeDirectory $ srcPath fin
+type ParserM  =         RWST ()        [Err Text ()] ([Text], [Text]) IO
+type ParserM1 = MaybeT (RWST [RawTree] [Err Text ()] ([Text], [Text]) IO)
 
-  runWriterT parser `evalStateT`
-     Cons pforest
-    (Cons []
-    (Cons dir
-    (Cons Set.empty
-     Nil)))
-    `catch` \(e :: Error ASTInfo) -> do
-      return $ (stub e, [])
+data Failure = Failure String
+  deriving stock (Show)
+  deriving anyclass (Exception)
 
-runParser'
-  :: Stubbed a ASTInfo
-  => Parser a
-  -> Source
-  -> IO a
-runParser' parser fin = fst <$> runParser parser fin
+instance Scoped (Product [Range, Text]) ParserM RawTree ParseTree where
+  enter (_ :> _ :> _) (ParseTree ty cs s) = do
+    let (comms, rest) = allComments cs
+    let (comms1, _)   = allComments $ reverse rest
+    modify $ first  (++ comms)
+    modify $ second (++ reverse comms1)
 
-restart :: Stubbed a ASTInfo => Parser a -> FilePath -> Parser a
-restart p fin = do
-  dir <- get' @FilePath
-  let full = dir </> fin
-  set <- get' @(Set.Set FilePath)
+    let errs = allErrors   cs
+    tell $ fmap Err errs
 
-  if Set.member full set
-  then do
-    fallback "recusive imports"
-  else do
-    (a, errs) <- liftIO do
-      flip runParser (Path full) do
-        put' (Set.insert full set)
-        p
-    tell errs
-    return a
+  leave _ _ = do
+    modify \(x, y) -> (y, [])
 
-get' :: forall x. Contains x PList => Parser x
-get' = gets getElem
-
-gets' :: forall x a. Contains x PList => (x -> a) -> Parser a
-gets' f = gets (f . getElem)
-
-put' :: forall x. Contains x PList => x -> Parser ()
-put' x = modify $ modElem $ const x
-
-mod' :: forall x. Contains x PList => (x -> x) -> Parser ()
-mod' = modify . modElem
-
--- | Generate error originating at current location.
-makeError :: Text -> Parser (Error ASTInfo)
-makeError msg = do
-  rng <- getInfo
-  makeError' msg rng
-
--- | Generate error originating at given location.
-makeError' :: Text -> info -> Parser (Error info)
-makeError' msg i = do
-  src <- gets' pfGrove <&> \case
-    []                     -> ""
-    (,) _ ParseTree { ptSource } : _ -> ptSource
-  return Expected
-    { eMsg   = msg
-    , eWhole = src
-    , eInfo  = i
-    }
-
--- | Pick next tree in a forest or die with msg.
-takeNext :: Text -> Parser ParseTree
-takeNext msg = do
-  gets' pfGrove >>= \case
-    [] -> die msg
-    (_, t) : f -> do
-      if "comment" `Text.isSuffixOf` ptName t
-      then do
-        mod' (ptSource t :)
-        takeNext msg
-      else do
-        mod' \st -> st
-          { pfRange = diffRange (pfRange st) (ptRange t)
-          , pfGrove = f
-          }
-        return t
-
---fields :: Text -> Parser a -> Parser [a]
---fields name parser = do
---  (fs, rest) <- gets $ splitForest name . fst
---  res <- for fs \f -> do
---    put f
---    parser
---
---  put rest
---  return res
---
---splitForest :: Text -> ParseForest -> [ParseForest]
---splitForest name = go . pfGrove
---  where
---    go []             acc fs = (fs, acc)
---    go ((tName, tree) : other) acc fs =
---      if tName == name
---      then go other [] (reverse (tree : acc) : fs)
---      else go other (tree : acc) fs
-
--- | Pick a tree with that /field name/ or die with name as msg.
---
---   Will erase all subtrees with different names on the path!
---
-field :: Text -> Parser a -> Parser a
-field name parser = do
-  gets' pfGrove >>= \case
-    (name', t) : _
-      | name == name' -> do
-        sandbox True t
-
-    grove -> do
-      case lookup name grove of
-        Just tree -> sandbox False tree
-        Nothing   -> die name
-
-  where
-    sandbox firstOne tree@ParseTree {ptID, ptRange} = do
-      st@Forest {pfGrove = grove, pfRange = rng} <- get'
-      let (errs, new_comments, grove') = delete name grove
-      mod' (++ new_comments)
-      put' Forest
-        { pfID    = ptID
-        , pfGrove = [(name, tree)]
-        , pfRange = ptRange
-        }
-
-      res <- parser
-
-      put' st
-        { pfGrove = grove'
-        , pfRange = if firstOne then diffRange rng ptRange else rng
-        }
-
-      put' @[Text] []
-
-      for_ errs (tell . pure . unexpected)
-
-      return res
-
-fallback :: Stubbed a ASTInfo => Text -> Parser a
-fallback msg = pure . stub =<< makeError msg
-
--- | Produce "expected ${X}" error at this point.
-die :: Text -> Parser a
-die msg = throwM =<< makeError msg
-
-die' ::Text -> ASTInfo -> Parser a
-die' msg rng = throwM =<< makeError' msg rng
-
--- | When tree-sitter found something it was unable to process.
-unexpected :: ParseTree -> Error ASTInfo
-unexpected ParseTree { ptSource, ptRange } =
-  Expected "not that" ptSource (Cons ptRange $ Cons [] Nil)
-
--- | If a parser fails, return stub with error originating here.
-stubbed :: Stubbed a ASTInfo => Text -> Parser a -> Parser a
-stubbed msg parser = do
-  parser <|> fallback msg
-
--- | The forest must start with tree of that name. Its subtrees become new
---   forest. Otherwise, it dies with name as msg.
-subtree :: Text -> Parser a -> Parser a
-subtree msg parser = do
-  ParseTree {ptChildren, ptName} <- takeNext msg
-  if ptName == msg
-  then do
-    save <- get' @ParseForest
-    put' ptChildren
-    rest <- gets' pfGrove
-    collectErrors rest
-    parser <* put' save
-  else do
-    die msg
-
--- | Because `ExceptT` requires error to be `Monoid` for `Alternative`.
-(<|>) :: Parser a -> Parser a -> Parser a
-l <|> r = do
-  s <- get' @ParseForest
-  c <- get' @[Text]
-  l `catch` \(_ :: Error ASTInfo) -> do
-    put' s
-    put' c
-    r
-
--- | Custom @foldl1 (<|>)@.
-select :: [Parser a] -> Parser a
-select = foldl1 (<|>)
-
--- | Custom @optionMaybe@.
-optional :: Parser a -> Parser (Maybe a)
-optional p = fmap Just p <|> return Nothing
-
--- | Custom `Alternative.many`.
---
---   TODO: remove, replace with `fields` combinator.
---
-many :: Parser a -> Parser [a]
-many p = many'
-  where
-    many' = some' <|> pure []
-    some' = do
-      x <- p
-      xs <- many'
-      return (x : xs)
-
--- | Custom `Alternative.some`.
---
-some :: Parser a -> Parser [a]
-some p = some'
-  where
-    many' = some' <|> pure []
-    some' = do
-      x <- p
-      xs <- many'
-      return (x : xs)
-
--- | Run parser on given file and pretty-print stuff.
---
-debugParser :: (Show a, Stubbed a ASTInfo) => Parser a -> Source -> IO ()
-debugParser parser fin = do
-  (res, errs) <- runParser parser fin
-  putStrLn "Result:"
-  print res
-  MTL.unless (null errs) do
-    putStrLn ""
-    putStrLn "Errors:"
-    for_ errs (print . nest 2 . pp)
-
--- | Consume next tree if it has the given name. Or die.
-token :: Text -> Parser Text
-token node = do
-  i <- getInfo
-  ParseTree {ptName, ptSource} <- takeNext node
-  if ptName == node
-  then return ptSource
-  else die' node i
-
--- | Consume next tree, return its textual representation.
-anything :: Parser Text
-anything = do
-  tree <- takeNext "anything"
-  return $ ptSource tree
-
--- | Get range of the current tree (or forest) before the parser was run.
-range :: Parser a -> Parser (a, Range)
-range parser =
-  get' >>= \case
-    Forest {pfGrove = [(,) _ ParseTree {ptRange}]} -> do
-      a <- parser
-      return (a, ptRange)
-
-    Forest {pfRange} -> do
-      a <- parser
-      return (a, pfRange)
-
--- | Get current range.
-currentRange :: Parser Range
-currentRange = snd <$> range (return ())
-
--- | Remove all keys until given key is found; remove the latter as well.
---
---   Also returns all ERROR-nodes.
---
---   TODO: rename.
---
---   Notice: this works differently from `Prelude.remove`!
---
-delete :: Text -> [(Text, ParseTree)] -> ([ParseTree], [Text], [(Text, ParseTree)])
-delete _ [] = ([], [], [])
-delete k ((k', v) : rest) =
-  if k == k'
-  then (addIfError v [], addIfComment v [], rest)
-  else (addIfError v vs, addIfComment v cs, remains)
-  where
-    (vs, cs, remains) = delete k rest
-    addIfError v' =
-      if ptName v' == "ERROR"
-      then (:) v'
-      else id
-
-    addIfComment v' =
-      if "comment" `Text.isSuffixOf` ptName v'
-      then (ptSource v' :)
-      else id
-
--- | Report all ERRORs from the list.
-collectErrors :: [(Text, ParseTree)] -> Parser ()
-collectErrors vs =
-  for_ vs \(_, v) -> do
-    MTL.when (ptName v == "ERROR") do
-      tell [unexpected v]
-
--- | Universal accessor.
---
---   Usage:
---
---   > inside "$field:$treename"
---   > inside "$field"
---   > inside ":$treename" -- don't, use "subtree"
---
-inside :: Stubbed a ASTInfo => Text -> Parser a -> Parser a
-inside sig parser = do
-  let (f, st') = Text.breakOn ":" sig
-  let st       = Text.drop 1 st'
-  if Text.null f
-  then do
-    -- The order is important.
-    subtree st do
-      stubbed f do
-        parser
-  else do
-    field f do
-      stubbed f do
-        if Text.null st
-        then do
-          parser
-        else do
-          subtree st do
-            parser
-
--- | Equip given constructor with info.
-getInfo :: Parser ASTInfo
-getInfo = Cons <$> currentRange <*> do Cons <$> grabComments <*> pure Nil
-
--- | Take the accumulated comments, clean the accumulator.
-grabComments :: Parser [Text]
+grabComments :: ParserM [Text]
 grabComments = do
-  comms <- get'
-  mod' @[Text] $ const []
-  return comms
+  ls <- gets fst
+  modify \(x, y) -> ([], y)
+  return ls
 
--- | /Actual/ debug pring.
-dump :: Parser ()
-dump = gets' pfGrove >>= traceShowM
+allComments :: [RawTree] -> ([Text], [RawTree])
+allComments = first (map getBody . filter isComment) . break isMeaningful
+  where
+    isMeaningful :: RawTree -> Bool
+    isMeaningful (extract -> _ :> "" :> _) = False
+    isMeaningful  _                        = True
+
+    isComment :: RawTree -> Bool
+    isComment (gist -> ParseTree ty _ _) = "comment" `Text.isSuffixOf` ty
+
+allErrors :: [RawTree] -> [Text]
+allErrors = map getBody . filter isUnnamedError
+  where
+    isUnnamedError :: RawTree -> Bool
+    isUnnamedError tree = case only tree of
+      (r :> "" :> _, ParseTree "ERROR" _ _) -> True
+      _                                     -> False
+
+getBody (gist -> f) = ptSource f
+
+field :: Text -> ParserM1 RawTree
+field name =
+  fieldOpt name
+    >>= maybe (throwM $ Failure [i|Cannot find field #{name}|]) return
+
+fieldOpt :: Text -> ParserM1 (Maybe RawTree)
+fieldOpt name = ask >>= go
+  where
+    go (tree@(extract -> _ :> n :> _) : rest)
+      | n == name = return (Just tree)
+      | otherwise = go rest
+
+    go [] = return Nothing
+
+fields :: Text -> ParserM1 [RawTree]
+fields name = ask >>= go
+  where
+    go (tree@(extract -> _ :> n :> _) : rest) =
+      (if n == name then ((tree :) <$>) else id)
+        $ go rest
+    go [] = return []
+
+data ShowRange
+  = Y | N
+  deriving stock Eq
+
+type Info    = Product [[Text], Range, ShowRange]
+type PreInfo = Product [Range, ShowRange]
+
+instance Modifies Info where
+  ascribe (comms :> r :> pin :> _) = ascribeRange r pin . ascribeComms comms
+
+ascribeComms comms
+  | null comms = id
+  | otherwise  = \d ->
+      block $ map (pp . Text.init) comms ++ [d]
+
+ascribeRange r Y = (pp r $$)
+ascribeRange _ _ = id
+
+withComments :: ParserM (Maybe (Product xs, a)) -> ParserM (Maybe (Product ([Text] : xs), a))
+withComments act = do
+  comms <- grabComments
+  res   <- act
+  return $ fmap (first (comms :>)) res
+
+boilerplate
+  :: (Text -> ParserM1 (f RawTree))
+  -> (RawInfo, ParseTree RawTree)
+  -> ParserM (Maybe (Info, f RawTree))
+boilerplate f (r :> _, ParseTree ty cs _) = do
+  withComments do
+    mbf <- runParserM1 cs $ f ty
+    return do
+      f <- mbf
+      return $ (r :> N :> Nil, f)
+
+boilerplate'
+  :: ((Text, Text) -> ParserM1 (f RawTree))
+  -> (RawInfo, ParseTree RawTree)
+  -> ParserM (Maybe (Info, f RawTree))
+boilerplate' f (r :> _, ParseTree ty cs src) = do
+  withComments do
+    mbf <- runParserM1 cs $ f (ty, src)
+    return do
+      f <- mbf
+      return $ (r :> N :> Nil, f)
+
+fallthrough :: MonadFail m => m a
+fallthrough = fail ""
diff --git a/tools/lsp/squirrel/src/Pretty.hs b/tools/lsp/squirrel/src/Pretty.hs
deleted file mode 100644
index 6cdfff5ae..000000000
--- a/tools/lsp/squirrel/src/Pretty.hs
+++ /dev/null
@@ -1,142 +0,0 @@
-{- |
-  Pretty printer, a small extension of GHC `pretty` package.
--}
-
-module Pretty
-  ( -- * Output `Text`
-    ppToText
-
-    -- * `Show` instance generator
-  , PP(..)
-
-    -- * Interfaces
-  , Pretty(..)
-  , Pretty1(..)
-
-    -- * Helpers
-  , tuple
-  , list
-  , indent
-  , above
-  , train
-  , block
-  , sepByDot
-  , mb
-  , sparseBlock
-  , color
-
-    -- * Full might of pretty printing
-  , module Text.PrettyPrint
-  )
-  where
-
-import Data.Sum
-
-import qualified Data.Text as Text
-import Data.Text (Text, pack)
-
-import Text.PrettyPrint hiding ((<>))
-
-import Product
-
--- | Pretty-print to `Text`. Through `String`. Yep.
-ppToText :: Pretty a => a -> Text
-ppToText = pack . show . pp
-
--- | With this, one can `data X = ...; derive Show via PP X`
-newtype PP a = PP { unPP :: a }
-
-instance Pretty a => Show (PP a) where
-  show = show . pp . unPP
-
--- | Pretty-printable types.
-class Pretty p where
-  pp :: p -> Doc
-
--- | Pretty-printable `Functors`.
-class Pretty1 p where
-  pp1 :: p Doc -> Doc
-
-instance Pretty1 (Sum '[]) where
-  pp1 = error "Sum.empty"
-
-instance (Pretty1 f, Pretty1 (Sum fs)) => Pretty1 (Sum (f : fs)) where
-  pp1 = either pp1 pp1 . decompose
-
-instance Pretty () where
-  pp _ = "-"
-
-instance (Pretty1 p, Functor p, Pretty a) => Pretty (p a) where
-  pp = pp1 . fmap pp
-
-instance Pretty1 [] where
-  pp1 = list
-
-instance Pretty1 Maybe where
-  pp1 = maybe empty pp
-
-instance {-# OVERLAPS #-} (Pretty a, Pretty b) => Pretty (Either a b) where
-  pp = either pp pp
-
-instance Pretty Int where
-  pp = int
-
--- | Common instance.
-instance Pretty Text where
-  pp = text . Text.unpack
-
--- | Common instance.
-instance Pretty Doc where
-  pp = id
-
--- | Decorate list of stuff as a tuple.
-tuple :: Pretty p => [p] -> Doc
-tuple = parens . train ","
-
--- | Decorate list of stuff as a list.
-list :: Pretty p => [p] -> Doc
-list = brackets . train ";"
-
-infixr 2 `indent`
--- | First argument is a header to an indented second one.
-indent :: Doc -> Doc -> Doc
-indent a b = hang a 2 b
-
-infixr 1 `above`
--- | Horisontal composition.
-above :: Doc -> Doc -> Doc
-above a b = hang a 0 b
-
--- | Pretty print as a sequence with given separator.
-train :: Pretty p => Doc -> [p] -> Doc
-train sep' = fsep . punctuate sep' . map pp
-
--- | Pretty print as a vertical block.
-block :: Pretty p => [p] -> Doc
-block = foldr ($+$) empty . map pp
-
--- | For pretty-printing qualified names.
-sepByDot :: Pretty p => [p] -> Doc
-sepByDot = cat . map (("." <>) . pp)
-
--- | For pretty-printing `Maybe`s.
-mb :: Pretty a => (Doc -> Doc) -> Maybe a -> Doc
-mb f = maybe empty (f . pp)
-
--- | Pretty print as a vertical with elements separated by newline.
-sparseBlock :: Pretty a => [a] -> Doc
-sparseBlock = vcat . punctuate "\n" . map (($$ empty) . pp)
-
-type Color = Int
-
-color :: Color -> Doc -> Doc
-color c d = zeroWidthText begin <> d <> zeroWidthText end
-  where
-    begin = "\x1b[" ++ show (30 + c) ++ "m"
-    end   = "\x1b[0m"
-
-instance Pretty (Product '[]) where
-  pp _ = "{}"
-
-instance (Pretty x, Pretty (Product xs)) => Pretty (Product (x : xs)) where
-  pp (Cons x xs) = pp x <+> "&" <+> pp xs
\ No newline at end of file
diff --git a/tools/lsp/squirrel/src/Product.hs b/tools/lsp/squirrel/src/Product.hs
index 917b03b1d..448a000c4 100644
--- a/tools/lsp/squirrel/src/Product.hs
+++ b/tools/lsp/squirrel/src/Product.hs
@@ -6,11 +6,15 @@ module Product where
 
 import GHC.Types
 
+import Duplo.Pretty
+
 -- | `Product xs` contains elements of each of the types from the `xs` list.
 data Product xs where
-  Cons :: x -> Product xs -> Product (x : xs)
+  (:>) :: x -> Product xs -> Product (x : xs)
   Nil  :: Product '[]
 
+infixr 5 :>
+
 -- | Find/modify the element with a given type.
 --
 --   If you want to have same-types, use newtype wrappers.
@@ -20,12 +24,12 @@ class Contains x xs where
   modElem :: (x -> x) -> Product xs -> Product xs
 
 instance {-# OVERLAPS #-} Contains x (x : xs) where
-  getElem   (Cons x _) = x
-  modElem f (Cons x xs) = Cons (f x) xs
+  getElem   (x :> _) = x
+  modElem f (x :> xs) = f x :> xs
 
 instance Contains x xs => Contains x (y : xs) where
-  getElem   (Cons _ xs) = getElem xs
-  modElem f (Cons x xs) = Cons x (modElem f xs)
+  getElem   (_ :> xs) = getElem xs
+  modElem f (x :> xs) = x :> modElem f xs
 
 -- | Add a name to the type.
 --
@@ -43,4 +47,28 @@ modTag
   .  Contains (s := t) xs
   => (t -> t)
   -> Product xs -> Product xs
-modTag f = modElem @(s := t) (Tag . f . unTag)
\ No newline at end of file
+modTag f = modElem @(s := t) (Tag . f . unTag)
+
+instance Eq (Product '[]) where
+  _ == _ = True
+
+instance (Eq x, Eq (Product xs)) => Eq (Product (x : xs)) where
+  x :> xs == y :> ys = and [x == y, xs == ys]
+
+-- instance Modifies (Product xs) where
+--   ascribe _ = id
+
+class PrettyProd xs where
+  ppProd :: Product xs -> Doc
+
+instance {-# OVERLAPS #-} Pretty x => PrettyProd '[x] where
+  ppProd (x :> Nil) = pp x
+
+instance (Pretty x, PrettyProd xs) => PrettyProd (x : xs) where
+  ppProd (x :> xs) = pp x <.> "," <+> ppProd xs
+
+instance Pretty (Product '[]) where
+  pp Nil = "{}"
+
+instance PrettyProd xs => Pretty (Product xs) where
+  pp = braces . ppProd
\ No newline at end of file
diff --git a/tools/lsp/squirrel/src/Range.hs b/tools/lsp/squirrel/src/Range.hs
index 1f7636fe1..2ad149f96 100644
--- a/tools/lsp/squirrel/src/Range.hs
+++ b/tools/lsp/squirrel/src/Range.hs
@@ -16,8 +16,9 @@ import Data.ByteString (ByteString)
 import Data.Text (Text)
 import Data.Text.Encoding
 
-import Pretty
-import Lattice
+import Duplo.Lattice
+import Duplo.Pretty
+
 import Product
 
 point :: Int -> Int -> Range
@@ -40,11 +41,11 @@ instance Pretty Range where
   pp (Range (ll, lc, _) (rl, rc, _) f) =
     color 2 do
       brackets do
-        text f <> ":"
-          <> int ll <> ":"
-          <> int lc <> "-"
-          <> int rl <> ":"
-          <> int rc
+        text f <.> ":"
+          <.> int ll <.> ":"
+          <.> int lc <.> "-"
+          <.> int rl <.> ":"
+          <.> int rc
 
 -- | Ability to get range out of something.
 class HasRange a where
@@ -65,10 +66,14 @@ cutOut (Range (_, _, s) (_, _, f) _) bs =
       bs
 
 instance Lattice Range where
-  Range (ll1, lc1, _) (ll2, lc2, _) _ <? Range (rl1, rc1, _) (rl2, rc2, _) _ =
+  Range (ll1, lc1, _) (ll2, lc2, _) _
+    `leq` Range (rl1, rc1, _) (rl2, rc2, _) _ =
     (rl1 < ll1 || rl1 == ll1 && rc1 <= lc1) &&
     (rl2 > ll2 || rl2 == ll2 && rc2 >= lc2)
 
 instance Eq Range where
   Range (l, c, _) (r, d, _) f == Range (l1, c1, _) (r1, d1, _) f1 =
-    (l, c, r, d, f) == (l1, c1, r1, d1, f1)
\ No newline at end of file
+    (l, c, r, d, f) == (l1, c1, r1, d1, f1)
+
+instance (Contains Range xs, Eq (Product xs)) => Lattice (Product xs) where
+  a `leq` b = getElem @Range a `leq` getElem @Range b
\ No newline at end of file
diff --git a/tools/lsp/squirrel/src/Tree.hs b/tools/lsp/squirrel/src/Tree.hs
deleted file mode 100644
index 3f1535f45..000000000
--- a/tools/lsp/squirrel/src/Tree.hs
+++ /dev/null
@@ -1,242 +0,0 @@
-
-{- | The carrier type for AST.
-
-     "Untypedness" of the tree is a payoff to ablity to stop and navigate
-     anywhere, not just inside the expression context.
-
-     Is a `Functor` and `Foldable` over its @info@ parameter.
-     Is not `Traversable`, because this will definitely not preserve scope.
-     Use `updateTree` instead of `traverse`/`for`.
--}
-
-module Tree
-  -- ( -- * Tree type
-  --   Tree
-  -- , lookupTree
-  -- , traverseTree
-  -- , mk
-  -- , infoOf
-
-  --   -- * Callbacks on update
-  -- , UpdateOver (..)
-  -- , skip
-  -- )
-  where
-
-import Data.Foldable
--- import Data.List
-import Data.Sum
-import Data.Monoid (First(..), getFirst)
-
-import Lattice
-import Comment
-import Pretty
-import Error
-import Range
-
-import Debug.Trace
-
--- | A tree, where each layer is one of @layers@ `Functor`s.
---
---   Is equipped with @info@.
---
---   Can contain `Error` instead of all the above.
---
-newtype Tree layers info = Tree
-  { unTree :: Either (Error info) (info, Sum layers (Tree layers info))
-  }
-
-dumpTree
-  :: (Apply Functor layers, Apply Foldable layers, HasComments info, Pretty1 (Sum layers), Pretty info)
-  => Tree layers info
-  -> Doc
-dumpTree (Tree tree) =
-  case tree of
-    Left _ -> "ERR"
-    Right (_, ls) ->
-      pp (Tree tree) `indent` block (dumpTree <$> toList ls)
-
-instance Apply Functor layers => Functor (Tree layers) where
-  fmap f = go
-    where
-      go (Tree (Left   err))      = Tree $ Left $ fmap f err
-      go (Tree (Right (a, rest))) = Tree $ Right (f a, fmap go rest)
-
-instance Apply Foldable layers => Foldable (Tree layers) where
-  foldMap f = go
-    where
-      go (Tree (Left   err))      = foldMap f err
-      go (Tree (Right (a, rest))) = f a <> foldMap go rest
-
-instance
-    ( Apply Traversable layers
-    , Apply Foldable    layers
-    , Apply Functor     layers
-    )
-  =>
-    Traversable (Tree layers)
-  where
-    traverse f = go
-      where
-        go (Tree (Left   err))      = (Tree . Left) <$> traverse f err
-        go (Tree (Right (a, rest))) = do
-          a'    <- f a
-          rest' <- (traverse.traverse) f rest
-          return $ Tree $ Right (a', rest')
-
-instance
-    ( Apply Functor layers
-    , HasComments info
-    , Pretty1    (Sum layers)
-    , Pretty      info
-    )
-  =>
-    Show (Tree layers info)
-  where
-    show = show . pp
-
-instance {-# OVERLAPS #-}
-    ( HasComments info
-    , Apply Functor fs
-    , Pretty1    (Sum fs)
-    , Pretty      info
-    )
-  =>
-    Pretty (Tree fs info)
-  where
-    pp = go
-      where
-        go (Tree (Left  err))           = pp err
-        go (Tree (Right (info, fTree))) = c info $ pp fTree
-
--- | Return all subtrees that cover the range, ascending in size.
-lookupTree
-  :: forall fs info
-  .  ( Apply Foldable fs
-     , Apply Functor fs
-     , HasRange info
-    --  , HasComments info
-    --  , Pretty1 (Sum fs)
-    --  , Pretty info
-     )
-  => Range
-  -> Tree fs info
-  -> Maybe (Tree fs info)
-lookupTree target = go
-  where
-    go :: Tree fs info -> Maybe (Tree fs info)
-    go tree = do
-      if target <? getRange (infoOf tree)
-      then getFirst $ foldMap (First . go) (layers tree) <> First (Just tree)
-      else Nothing
-
-    layers :: (Apply Foldable fs) => Tree fs info -> [Tree fs info]
-    layers (Tree (Right (_, ls))) = toList ls
-    layers  _                     = []
-
--- | Traverse the tree over some monad that exports its methods.
---
---   For each tree piece, will call `before` and `after` callbacks.
---
-traverseTree
-  :: ( UpdateOver m (Sum fs) (Tree fs a)
-     , Apply Foldable fs
-     , Apply Functor fs
-     , Apply Traversable fs
-     , HasRange a
-     )
-  => (a -> m b) -> Tree fs a -> m (Tree fs b)
-traverseTree act = go
-  where
-    go (Tree (Right (a, union))) = do
-      b <- act a
-      before (getRange a) union
-      union' <- traverse go union
-      after (getRange a) union
-      return (Tree (Right (b, union')))
-
-    go (Tree (Left err)) = do
-      err' <- traverse act err
-      return (Tree (Left err'))
-
-data Visit fs a b m where
-  Visit
-    :: (Element f fs, Traversable f)
-    => (a -> f (Tree fs a) -> m (b, f (Tree fs a)))
-    -> Visit fs a b m
-
-traverseMany
-  :: ( Apply Functor fs
-     , Apply Foldable fs
-     , Apply Traversable fs
-     , Monad m
-     )
-  => [Visit fs a b m]
-  -> (a -> b)
-  -> Tree fs a
-  -> m (Tree fs b)
-traverseMany visitors orElse = go
-  where
-    go tree = aux visitors
-      where
-        aux (Visit visitor : rest) = do
-          case match tree of
-            Just (r, fa) -> do
-              (r', fa')  <- visitor r fa
-              fa'' <- traverse go fa'
-              return $ mk r' fa''
-            Nothing -> do
-              aux rest
-        aux [] = do
-          case tree of
-            Tree (Right (r, union)) -> do
-              union' <- traverse go union
-              return $ Tree $ Right (orElse r, union')
-            Tree (Left err) -> do
-              return $ Tree $ Left $ fmap orElse err
-
--- | Make a tree out of a layer and an info.
-mk :: (Functor f, Element f fs) => info -> f (Tree fs info) -> Tree fs info
-mk i fx = Tree $ Right (i, inject fx)
-
-match
-  :: (Functor f, Element f fs)
-  => Tree fs info
-  -> Maybe (info, f (Tree fs info))
-match (Tree (Left   _))      = Nothing
-match (Tree (Right (r, it))) = do
-  f <- project it
-  return (r, f)
-
--- | Get info from the tree.
-infoOf :: Tree fs info -> info
-infoOf = either eInfo fst . unTree
-
-instance Stubbed (Tree fs info) info where
-  stub = Tree . Left
-
-instance Apply Foldable fs => HasErrors (Tree fs info) info where
-  errors = go
-    where
-      go (Tree (Left   err))      = pure err
-      go (Tree (Right (_, rest))) = foldMap go rest
-
--- | Update callbacks for a @f a@ while working inside monad @m@.
-class Monad m => UpdateOver m f a where
-  before :: Range -> f a -> m ()
-  after  :: Range -> f a -> m ()
-
-  before _ _ = skip
-  after  _ _ = skip
-
--- | Do nothing.
-skip :: Monad m => m ()
-skip = return ()
-
-instance Monad m => UpdateOver m (Sum '[]) a where
-  before = error "Sum.empty"
-  after  = error "Sum.empty"
-
-instance (UpdateOver m f a, UpdateOver m (Sum fs) a) => UpdateOver m (Sum (f : fs)) a where
-  before r = either (before r) (before r) . decompose
-  after  r = either (after  r) (after  r) . decompose
diff --git a/tools/lsp/squirrel/stack.yaml b/tools/lsp/squirrel/stack.yaml
index 4a32efa94..21fb0e2d2 100644
--- a/tools/lsp/squirrel/stack.yaml
+++ b/tools/lsp/squirrel/stack.yaml
@@ -40,8 +40,8 @@ extra-deps:
   - lingo-0.3.2.0@sha256:80b9ded65f2ddc0272a2872d9c3fc43c37934accae076d3e547dfc6c6b6e16d3,1899
   - semilattices-0.0.0.4@sha256:333707e460923711d1edbdd02ebe1c3957d4e0808eab9886747b52ee3e443639,1909
   - fastsum-0.1.1.1
-  - git: https://github.com/Heimdell/dual-effects.git
-    commit: dc3e8bcd0aa00b9264e86293ec42c0b5835e930c
+  - git: https://github.com/serokell/duplo.git
+    commit: 8fb7a22d0e6ff75ec049c36c6f767ee14e841446
 # - acme-missiles-0.3
 # - git: https://github.com/commercialhaskell/stack.git
 #   commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
diff --git a/tools/lsp/squirrel/stack.yaml.lock b/tools/lsp/squirrel/stack.yaml.lock
index 8b0fa6203..d5c8125d9 100644
--- a/tools/lsp/squirrel/stack.yaml.lock
+++ b/tools/lsp/squirrel/stack.yaml.lock
@@ -40,19 +40,16 @@ packages:
   original:
     hackage: fastsum-0.1.1.1
 - completed:
-    cabal-file:
-      size: 1569
-      sha256: 828a5bc60b97347d491038b435da664ae281a6dab26e9beb261d319c2601c4dc
-    name: eff
+    name: duplo
     version: 0.0.0
-    git: https://github.com/Heimdell/dual-effects.git
+    git: https://github.com/serokell/duplo.git
     pantry-tree:
-      size: 972
-      sha256: 4443705f2fc31929822a3cda4036f9a93950686f4729cd28280253e981828391
-    commit: dc3e8bcd0aa00b9264e86293ec42c0b5835e930c
+      size: 557
+      sha256: b5d8c86a8a26bc2efc0f86314317fa36b5f57c5d44cb889bee58f10782767037
+    commit: 8fb7a22d0e6ff75ec049c36c6f767ee14e841446
   original:
-    git: https://github.com/Heimdell/dual-effects.git
-    commit: dc3e8bcd0aa00b9264e86293ec42c0b5835e930c
+    git: https://github.com/serokell/duplo.git
+    commit: 8fb7a22d0e6ff75ec049c36c6f767ee14e841446
 snapshots:
 - completed:
     size: 493124