Introduce cst-parser for identifier lexing

Fix #146

packages.dhall

@@ -121,6 +121,29 @@ let upstream =
 
 let overrides = { psc-ide = upstream.psc-ide // { version = "b9b1d0320204927cafefcf24b105ec03d0ae256b" } }
 
-let additions = {=}
+let additions = { language-cst-parser =
+    { dependencies =
+      [ "arrays"
+      , "console"
+      , "const"
+      , "debug"
+      , "effect"
+      , "either"
+      , "filterable"
+      , "foldable-traversable"
+      , "free"
+      , "functors"
+      , "maybe"
+      , "numbers"
+      , "psci-support"
+      , "strings"
+      , "transformers"
+      , "tuples"
+      , "typelevel-prelude"
+      ]
+    , repo = "https://github.com/natefaubion/purescript-language-cst-parser.git"
+    , version = "v0.7.1"
+    }
+}
 
 in  upstream // overrides // additions

spago.dhall

@@ -27,6 +27,7 @@ You can edit this file as you like.
   , "foreign-generic"
   , "foreign-object"
   , "integers"
+  , "language-cst-parser"
   , "lists"
   , "maybe"
   , "newtype"

src/IdePurescript/Tokens.purs

@@ -2,48 +2,55 @@ module IdePurescript.Tokens where
 
 import Prelude
 
-import Data.Array.NonEmpty as NEA
-import Data.Either (Either, either)
+import Data.Either (Either)
 import Data.Maybe (Maybe(..))
-import Data.String (Pattern(..), contains, drop, length, take)
-import Data.String.Regex (Regex, match, regex)
+import Data.Newtype (un)
+import Data.String (Pattern(..), contains)
+import Data.String.Regex (Regex, regex)
 import Data.String.Regex.Flags (noFlags)
 import IdePurescript.Regex (test')
+import PureScript.CST.Lexer as CST.Lexer
+import PureScript.CST.TokenStream as TokenStream
+import PureScript.CST.Types (ModuleName(..), Token(..))
 
 type WordRange = { left :: Int, right :: Int }
 
+-- Regexes still used by Completion
+
 modulePart :: String
 modulePart = """((?:[A-Z][A-Za-z0-9]*\.)*(?:[A-Z][A-Za-z0-9]*))"""
 
 identPart :: String
-identPart = """((?:[a-zA-Z_][a-zA-Z0-9_']*)|[:!#$%&*+\./<=>?@\^|~\\-]+)"""
+identPart = """((?:[a-zA-Z_][a-zA-Z0-9_']*)|[:!#$%&*+./<=>?@\^|~\\-]+)"""
 
-modulePrefix :: String
-modulePrefix = "(?:^|[^A-Za-z_.])(?:" <> modulePart <> """\.)"""
 
 moduleRegex :: Either String Regex
 moduleRegex = regex (modulePrefix <> "?" <> identPart <> "?$") noFlags
+  where
+  modulePrefix :: String
+  modulePrefix = "(?:^|[^A-Za-z_.])(?:" <> modulePart <> """\.)"""
+
 
 identifierAtPoint :: String -> Int -> Maybe { word :: String, range :: WordRange, qualifier :: Maybe String }
 identifierAtPoint line column =
-  let beforeRegex = regex """[a-zA-Z_0-9':!#$%&*+/<=>?@^|~\\-]*$""" noFlags
-      afterRegex = regex """^[a-zA-Z_0-9':!#$%&*+/<=>?@^|~\\-]*""" noFlags
-      moduleEndRegex = regex (modulePrefix <> "$") noFlags
-      textBefore = take column line
-      textAfter = drop column line
-      wordRange left right = { left: column - left, right: column + right }
-      match' r t = either (const Nothing) (\r' -> match r' t) r
-  in
-  case match' beforeRegex textBefore, match' afterRegex textAfter of
-    Just ss, Just ss'
-      | Just s <- NEA.head ss
-      , Just s' <- NEA.head ss'  ->
-        let qualifier = case match' moduleEndRegex (take (length textBefore - length s) textBefore) of
-                            Just arr | [ _, mm ] <- NEA.toArray arr -> mm
-                            _ -> Nothing
-        in
-          Just { word : s<>s', range : wordRange (length s) (length s'), qualifier }
-    _, _ -> Nothing
+  go $ TokenStream.step $ CST.Lexer.lex line
+  where
+  go (TokenStream.TokenCons tok@{range: { start: { column: startCol }, end: { column: endCol } }, value } _ str _) =
+    if column < startCol then
+      Nothing
+    else if column > endCol then
+      go $ TokenStream.step str
+    else
+      let range = { left: startCol, right: endCol } -- ish?
+          res mn word = Just { range, word, qualifier: un ModuleName <$> mn }
+      in
+      case value of
+        TokLowerName mn word -> res mn word
+        TokUpperName mn word -> res mn word
+        TokOperator mn word  -> res mn word
+        TokSymbolName mn word -> res mn word
+        _ -> Nothing
+  go _ = Nothing
 
 startsWithCapitalLetter :: String -> Boolean
 startsWithCapitalLetter = test' (regex "^[A-Z]" noFlags)

src/LanguageServer/IdePurescript/Tooltips.purs

@@ -3,69 +3,44 @@ module LanguageServer.IdePurescript.Tooltips where
 import Prelude
 
 import Data.Array (uncons)
-import Data.Array.NonEmpty as NEA
-import Data.Either (either)
 import Data.Maybe (Maybe(..), fromMaybe, isJust)
 import Data.Newtype (un)
 import Data.Nullable (Nullable, toNullable)
-import Data.String (drop, length, take)
-import Data.String.Regex (match, regex)
-import Data.String.Regex.Flags (noFlags)
+import Data.String as String
 import Effect.Aff (Aff)
 import Effect.Class (liftEffect)
 import IdePurescript.Modules (getQualModule, getUnqualActiveModules)
 import IdePurescript.PscIde (getTypeInfo)
-import IdePurescript.Tokens (WordRange, identPart, identifierAtPoint)
+import IdePurescript.Tokens (identifierAtPoint)
 import LanguageServer.DocumentStore (getDocument)
 import LanguageServer.Handlers (TextDocumentPositionParams)
 import LanguageServer.IdePurescript.Types (ServerState(..))
 import LanguageServer.TextDocument (getTextAtRange)
 import LanguageServer.Types (DocumentStore, Hover(Hover), Position(Position), Range(Range), Settings, TextDocumentIdentifier(TextDocumentIdentifier), markupContent)
 import PscIde.Command as C
 
-moduleBeforePart :: String
-moduleBeforePart = """(?:^|[^A-Za-z_.])((?:[A-Z][A-Za-z0-9]*(?:\.(?:[A-Z][A-Za-z0-9]*)?)*)?)"""
-
-moduleAfterPart :: String
-moduleAfterPart = """([A-Za-z0-9]*(?:\.[A-Za-z0-9]*)*)\.""" 
-
-afterPart :: String
-afterPart = moduleAfterPart <> identPart <> "(?:[^A-Za-z_'.]|$)"-- identPart captures 1
-
-moduleAtPoint :: String -> Int -> Maybe { word :: String, range :: WordRange }
-moduleAtPoint line column =
-  let textBefore = take column line
-      textAfter = drop column line
-      beforeRegex = regex (moduleBeforePart <> "$") noFlags
-      afterRegex = regex ("^" <> afterPart) noFlags
-      wordRange left right = { left: column - left, right: column + right }
-      match' r t = either (const Nothing) (\r' -> match r' t) r
-  in
-  case NEA.toArray <$> match' beforeRegex textBefore, NEA.toArray <$> match' afterRegex textAfter of
-    Just [_, Just m1], Just [_, Just m2, _] ->
-      Just { word : m1 <> m2, range : wordRange (length m1) (length m2) }
-    _, _ -> Nothing
-
 getTooltips :: DocumentStore -> Settings -> ServerState -> TextDocumentPositionParams -> Aff (Nullable Hover)
 getTooltips docs _ state ({ textDocument, position }) = do
   doc <- liftEffect $ getDocument docs (_.uri $ un TextDocumentIdentifier textDocument)
   text <- liftEffect $ getTextAtRange doc $ lineRange position
   let { port, modules } = un ServerState state
       char = _.character $ un Position $ position
-  case port, identifierAtPoint text char, moduleAtPoint text char of
-    Just _, _, Just { word, range } -> do
-      let mod = getQualModule word (un ServerState state).modules
-      pure $ toNullable $ case uncons mod of 
-        Just { head } -> 
-          Just $ Hover {
-            contents: markupContent head
-          , range: toNullable $ Just $ wordRange position range
-          }
-        _ -> Nothing
-    Just port', Just { word, qualifier }, _ -> do
-      ty <- getTypeInfo port' word modules.main qualifier (getUnqualActiveModules modules $ Just word) (flip getQualModule modules)
-      pure $ toNullable $ map (convertInfo word) ty
-    _, _, _-> pure $ toNullable Nothing
+  case port, identifierAtPoint text char of
+    Just port', Just { word, qualifier, range: range@{ left } } -> do
+      case qualifier of
+        Just q | char < left + String.length q -> do
+          let mod = getQualModule q (un ServerState state).modules
+          pure $ toNullable $ case uncons mod of 
+            Just { head } -> 
+              Just $ Hover {
+                contents: markupContent head
+              , range: toNullable $ Just $ wordRange position range { right = left + String.length q }
+              }
+            _ -> Nothing
+        _ -> do
+          ty <- getTypeInfo port' word modules.main qualifier (getUnqualActiveModules modules $ Just word) (flip getQualModule modules)
+          pure $ toNullable $ map (convertInfo word) ty
+    _, _ -> pure $ toNullable Nothing
 
   where