[nongnu] elpa/haskell-tng-mode f221f95 173/385: introduce types and constraints to the grammar

[ELPA Syncer]

branch: elpa/haskell-tng-mode
commit f221f95e59fc1eaa439c93ec29de98e54e57c556
Author: Tseen She <ts33n.sh3@gmail.com>
Commit: Tseen She <ts33n.sh3@gmail.com>

    introduce types and constraints to the grammar
---
 haskell-tng-smie.el                   | 40 +++++++++++++++++++++++------------
 test/src/grammar.hs.sexps             |  2 +-
 test/src/indentation.hs.append.indent |  4 ++--
 test/src/indentation.hs.insert.indent | 16 +++++++-------
 test/src/indentation.hs.reindent      | 18 ++++++++--------
 test/src/indentation.hs.sexps         | 26 +++++++++++------------
 test/src/layout.hs.sexps              |  8 +++----
 7 files changed, 64 insertions(+), 50 deletions(-)

diff --git a/haskell-tng-smie.el b/haskell-tng-smie.el
index 91aaa65..fbbf7fb 100644
--- a/haskell-tng-smie.el
+++ b/haskell-tng-smie.el
@@ -24,6 +24,7 @@
 ;;
 ;;; Code:
 
+(require 'dash)
 (require 'smie)
 
 (require 'haskell-tng-font-lock)
@@ -51,7 +52,7 @@
 ;; with a more complete grammar has been shown to be less than satisfactory,
 ;; therefore there is no reason to do more than is needed.
 (defvar haskell-tng-smie:grammar
-  ;; see docs for `smie-prec2->grammar'
+  ;; see docs for `smie-bnf->prec2'
   (smie-prec2->grammar
    (smie-bnf->prec2
     '((id)
@@ -87,12 +88,18 @@
        ("\\case" blk) ;; LambdaCase
        )
       (blk
+       (id "::" type)
        ("{" blk "}")
        (blk ";" blk)
        (id "=" id)
        (id "<-" id)
-       (id "->" id)
+       (id "->" id) ;; TODO lexer could disambiguate cases
        )
+
+      (type
+       (type "=>" type)
+       (type "->" type))
+
       (lambdas
        ("\\" id))
 
@@ -101,8 +108,10 @@
       )
 
     ;; operator precedences
-    '((assoc "|")
-      (assoc ";" ",")
+    '((assoc ";" ",")
+      (assoc "|")
+      (assoc "=>")
+      (assoc "->")
       )
 
     )))
@@ -160,10 +169,11 @@ information, to aid in the creation of new rules."
 
        ;; TODO insert the predicted token... code completion!
        ('empty-line-token
-        (let* ((parents (save-excursion
-                         (haskell-tng-smie:ancestors 2)))
-               (parent (car parents))
-               (grand (cadr parents))
+        (let* ((ancestors (save-excursion
+                         (haskell-tng-smie:ancestors 3)))
+               (parent (car ancestors))
+               (grand (cadr ancestors))
+               (great (caddr ancestors))
                (prev (save-excursion
                        (car (smie-indent-backward-token))))
                (psexp (save-excursion
@@ -175,15 +185,15 @@ information, to aid in the creation of new rules."
 
           (when haskell-tng-smie:debug
             (with-current-buffer haskell-tng-smie:debug
-              (insert (format " ^^: %S\n  ^: %S\n -1: %S\n -(: %S\n +1: %S\n"
-                              grand parent prev psexp next))))
+              (insert (format "^^^: %S\n ^^: %S\n  ^: %S\n -1: %S\n -(: %S\n 
+1: %S\n"
+                              great grand parent prev psexp next))))
 
           (cond
            ((or
              (equal next ",")
+             (equal grand ",")
              (member parent '("[" "(" ","))
-             (and (equal parent "{")
-                  (equal grand "=")))
+             (-is-infix-p '("{" "=") ancestors))
             ",")
 
            ((or (equal parent "|")
@@ -255,7 +265,11 @@ information, to aid in the creation of new rules."
           (smie-rule-separator method)))
        ((and (or "[" "(" "{") (guard (smie-rule-hanging-p)))
         (smie-rule-parent))
-       ("," (smie-rule-separator method))
+       ("," (if (smie-rule-parent-p "::")
+                ;; types plus record syntax confuse smie-rule-separator. This
+                ;; heuristic works in most cases, but is not robust.
+                (smie-rule-parent -2)
+              (smie-rule-separator method)))
        ((guard (smie-rule-parent-p "SYMID"))
         (smie-rule-parent))
        ))
diff --git a/test/src/grammar.hs.sexps b/test/src/grammar.hs.sexps
index b3cd0f7..43b724c 100644
--- a/test/src/grammar.hs.sexps
+++ b/test/src/grammar.hs.sexps
@@ -1,7 +1,7 @@
 -- | Tests for grammar rules i.e. sexps, not indentation
 ((module ((Foo).(Bar)) (where)
 
-((calc) (::) (Int) -> (Int)
+((calc) :: (Int) -> (Int)
 ((calc) (a) = (if (a) < ((10)
          (then) (a) + (a) * (a) + ((a)
          (else) ((a) + (a)) * ((a) + (a))))))
diff --git a/test/src/indentation.hs.append.indent 
b/test/src/indentation.hs.append.indent
index cb53038..9bcf547 100644
--- a/test/src/indentation.hs.append.indent
+++ b/test/src/indentation.hs.append.indent
@@ -285,9 +285,9 @@ v      1
 
 v      1
 types5 :: (Monad m, MonadReader Foo m) =>
-v
+1         v
           (?log :: HasLogger m) =>
-v         1
+1         v
           a -> b -> c
 v         1
 
diff --git a/test/src/indentation.hs.insert.indent 
b/test/src/indentation.hs.insert.indent
index 3e14b25..c9deb1b 100644
--- a/test/src/indentation.hs.insert.indent
+++ b/test/src/indentation.hs.insert.indent
@@ -251,7 +251,7 @@ v
 
 v
 types2 ::
-2    1 v
+v    1
      a
 2 1  v
   -> b
@@ -261,11 +261,11 @@ v 1  2
 
 v 1  2
 types3 ::
-2    1 v
+v    1
      Monad m
-2 1  v
+3 1  2     v
   => a
-1 v  2
+2 1  v
   -> b
 2 1  v
   -> c
@@ -273,11 +273,11 @@ v 1  2
 
 v 1  2
 types4 :: Monad m
-1      v
+2      1        v
        => (?log :: HasLogger m)
-1      v
+2      1  v
        => a
-1      v
+2      1  v
        -> b
 2      1  v
        -> c
@@ -285,7 +285,7 @@ v      1
 
 v      1
 types5 :: (Monad m, MonadReader Foo m) =>
-2      v  1
+1         v
           (?log :: HasLogger m) =>
 1         v
           a -> b -> c
diff --git a/test/src/indentation.hs.reindent b/test/src/indentation.hs.reindent
index 0e14fdf..24f513e 100644
--- a/test/src/indentation.hs.reindent
+++ b/test/src/indentation.hs.reindent
@@ -252,41 +252,41 @@ v
 
 v    1
 types2 ::
-2 1    v
+v 1
      a
 v 1  2
   -> b
-v 1  2
+1 v  2
   -> c
 v 1  2
 
 v 2  1
 types3 ::
-2 1    v
+v 1
      Monad m
 2 1  v
   => a
-v 1  2
+1 v  2
   -> b
-v 1  2
+1 v  2
   -> c
 v 1  2
 
 v 2  3 1
 types4 :: Monad m
-1      v
+2      1  v
        => (?log :: HasLogger m)
 1      v
        => a
-v      1
+1      v
        -> b
-v      1
+1      v
        -> c
 v      1
 
 v      2  1
 types5 :: (Monad m, MonadReader Foo m) =>
-2      v  1
+1         v
           (?log :: HasLogger m) =>
 1         v
           a -> b -> c
\ No newline at end of file
diff --git a/test/src/indentation.hs.sexps b/test/src/indentation.hs.sexps
index d0c9771..2d8db03 100644
--- a/test/src/indentation.hs.sexps
+++ b/test/src/indentation.hs.sexps
@@ -78,13 +78,13 @@
             | (Vibble) (Int)
 
 (data (Record1) = (Record1) ({
-  (fieldA) (::) (String)
-, (fieldB) (::) (String)
+  (fieldA) :: (String)
+, (fieldB) :: (String)
 }))
 
 (data (Record2) = (Record2)
-  ({ (fieldA) (::) (String)
-  , (fieldB) (::) (String)
+  ({ (fieldA) :: (String)
+  , (fieldB) :: (String)
   }))
 
 (data (Record3) = ((Record3) (String) (Text)
@@ -122,26 +122,26 @@
 ((tuples3) = ( (foo) ,
             (bar) ))
 
-((types1) (::) (a) -> (b) -> (c))
+((types1) :: (a) -> (b) -> (c))
 
-((types2) (::)
+((types2) ::
      (a)
   -> (b)
   -> (c))
 
-((types3) (::)
+((types3) ::
      (Monad) (m)
-  (=>) (a)
+  => (a)
   -> (b)
   -> (c))
 
-((types4) (::) (Monad) (m)
-       (=>) ((?log) (::) (HasLogger) (m))
-       (=>) (a)
+((types4) :: (Monad) (m)
+       => ((?log) :: (HasLogger) (m))
+       => (a)
        -> (b)
        -> (c))
 
-((types5) (::) ((Monad) (m), (MonadReader) (Foo) (m)) (=>)
-          ((?log) (::) (HasLogger) (m)) (=>)
+((types5) :: ((Monad) (m), (MonadReader) (Foo) (m)) =>
+          ((?log) :: (HasLogger) (m)) =>
           (a) -> (b) -> (c))))))))))))))
 )))
\ No newline at end of file
diff --git a/test/src/layout.hs.sexps b/test/src/layout.hs.sexps
index 44af28c..6cccb1f 100644
--- a/test/src/layout.hs.sexps
+++ b/test/src/layout.hs.sexps
@@ -3,18 +3,18 @@
 ((data (Stack) (a) = (Empty)
              | (MkStack) (a) ((Stack) (a))
 
-((push) (::) (a) -> (Stack) (a) -> (Stack) (a))
+((push) :: (a) -> (Stack) (a) -> (Stack) (a))
 ((push) (x) (s) = (MkStack) (x) (s))
 
-((size) (::) (Stack) (a) -> (Int))
+((size) :: (Stack) (a) -> (Int))
 ((size) (s) = (length) ((stkToLst) (s)))  (where)
            (((stkToLst)  (Empty)         = ([])
            ((stkToLst) ((MkStack) (x) (s))  = (x):(xs)) (where) ((xs) = 
(stkToLst) (s)
 
-)))(pop) (::) (Stack) (a) -> ((a), (Stack) (a))
+)))(pop) :: (Stack) (a) -> ((a), (Stack) (a))
 ((pop) ((MkStack) (x) (s))
   = ((x), ((case (s) (of) ((r -> (i) (r) (where) (i (x) = x))))))) -- pop 
Empty is an error
 
-((top) (::) (Stack) (a) -> (a))
+((top) :: (Stack) (a) -> (a))
 ((top) ((MkStack) (x) (s)) = (x)))                     -- top Empty is an error
 )))
\ No newline at end of file