Finish adding LSP annotation tests

codebase2/core/U/Core/ABT.hs

@@ -17,7 +17,7 @@ data ABT f v r
   | Cycle r
   | Abs v r
   | Tm (f r)
-  deriving (Show, Functor, Foldable, Traversable)
+  deriving stock (Eq, Show, Functor, Foldable, Traversable)
 
 -- | At each level in the tree, we store the set of free variables and
 -- a value of type `a`. Variables are of type `v`.

parser-typechecker/src/Unison/Codebase/Init/CreateCodebaseError.hs

@@ -10,3 +10,4 @@ type Pretty = P.Pretty P.ColorText
 
 data CreateCodebaseError
   = CreateCodebaseAlreadyExists
+  deriving stock (Show)

unison-cli/tests/Main.hs

@@ -14,12 +14,12 @@ import qualified Unison.Test.VersionParser as VersionParser
 test :: Test ()
 test =
   tests
-    [ ClearCache.test,
+    [ LSP.test,
+      ClearCache.test,
       Cli.Monad.test,
       GitSync.test,
       UriParser.test,
-      VersionParser.test,
-      LSP.test
+      VersionParser.test
     ]
 
 main :: IO ()

unison-cli/tests/Unison/Test/LSP.hs

@@ -1,47 +1,64 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
 
 module Unison.Test.LSP (test) where
 
-import Control.Error.Safe (rightMay)
 import qualified Crypto.Random as Random
+import Data.Bifunctor (bimap)
+import Data.List.Extra (firstJust)
 import Data.String.Here.Uninterpolated (here)
 import Data.Text
 import qualified Data.Text as Text
 import EasyTest
 import qualified System.IO.Temp as Temp
-import Text.Megaparsec
+import qualified Unison.ABT as ABT
 import qualified Unison.Cli.TypeCheck as Typecheck
 import Unison.Codebase (Codebase)
-import Unison.Codebase.Editor.RemoteRepo
-import Unison.Codebase.Editor.VersionParser
 import qualified Unison.Codebase.Init as Codebase.Init
-import qualified Unison.Codebase.Path as Path
 import qualified Unison.Codebase.SqliteCodebase as SC
+import qualified Unison.LSP.Queries as LSPQ
 import qualified Unison.Lexer.Pos as Lexer
 import Unison.Parser.Ann (Ann (..))
+import Unison.Prelude
 import qualified Unison.Result as Result
 import Unison.Symbol (Symbol)
 import qualified Unison.Syntax.Lexer as L
 import qualified Unison.Syntax.Parser as Parser
 import Unison.Term (Term)
 import qualified Unison.Term as Term
-import qualified Unison.Test.Ucm as Ucm
 import Unison.Type (Type)
+import qualified Unison.Type as Type
 import qualified Unison.UnisonFile as UF
 
 test :: Test ()
 test =
-  scope "annotations" . tests . fmap makeTest $
+  scope "annotations" . tests . fmap makeNodeSelectionTest $
     [ ( "Binary Op lhs",
-        [here|term = 100 + 200|],
-        Lexer.Pos 0 8,
-        Left (Term.Nat 100)
+        [here|term = tr|ue && false|],
+        True,
+        Left (Term.Boolean True)
+      ),
+      ( "Binary Op rhs",
+        [here|term = true && fa|lse|],
+        True,
+        Left (Term.Boolean False)
       )
     ]
 
-makeTest :: (String, Text, Lexer.Pos, Either ((Term.F Symbol Ann Ann (Term Symbol Ann))) (Type Symbol Ann)) -> Test ()
-makeTest (name, src, pos, expected) = scope name $ do
-  (pf, tf) <- withTestCodebase \codebase -> do
+-- | Test helper which lets you specify a cursor position inline with source text as a '|'.
+extractCursor :: Text -> Test (Lexer.Pos, Text)
+extractCursor txt =
+  case Text.splitOn "|" txt of
+    [before, after] ->
+      let col = Text.length $ Text.takeWhileEnd (/= '\n') before
+          line = Prelude.length $ Text.lines before
+       in pure $ (Lexer.Pos line col, before <> after)
+    _ -> crash "expected exactly one cursor"
+
+makeNodeSelectionTest :: (String, Text, Bool, Either ((Term.F Symbol Ann Ann (Term Symbol Ann))) (Type.F (Type Symbol Ann))) -> Test ()
+makeNodeSelectionTest (name, testSrc, testTypechecked, expected) = scope name $ do
+  (pos, src) <- extractCursor testSrc
+  (mayParsedFile, mayTypecheckedFile) <- withTestCodebase \codebase -> do
     let generateUniqueName = Parser.uniqueBase32Namegen <$> Random.getSystemDRG
     let ambientAbilities = []
     let parseNames = mempty
@@ -54,25 +71,28 @@ makeTest (name, src, pos, expected) = scope name $ do
           Just (Right tf) -> (Just $ UF.discardTypes tf, Just tf)
     pure (parsedFile, typecheckedFile)
   scope "parsed file" $ do
-    pfResult <-
-      UF.terms parsedFile
-        & find \(_v, trm) ->
-          LSPQ.findSmallestEnclosingNode pos trm
-    expectEqual pfResult expected
+    pf <- maybe (crash "Failed to parse") pure mayParsedFile
+    let pfResult =
+          UF.terms pf
+            & firstJust \(_v, trm) ->
+              LSPQ.findSmallestEnclosingNode pos trm
+    expectEqual (Just $ bimap ABT.Tm ABT.Tm expected) (bimap ABT.out ABT.out <$> pfResult)
 
-  scope "typechecked file" $ do
-    pfResult <-
-      UF.hashTermsId
-        & find \(_refId, _wk, trm, _typ) ->
-          LSPQ.findSmallestEnclosingNode pos trm
-    expectEqual (bimap ABT.out ABT.out <$> pfResult) (Just expected)
+  when testTypechecked $
+    scope "typechecked file" $ do
+      tf <- maybe (crash "Failed to typecheck") pure mayTypecheckedFile
+      let tfResult =
+            UF.hashTermsId tf
+              & toList
+              & firstJust \(_refId, _wk, trm, _typ) ->
+                LSPQ.findSmallestEnclosingNode pos trm
+      expectEqual (Just $ bimap ABT.Tm ABT.Tm expected) (bimap ABT.out ABT.out <$> tfResult)
 
 withTestCodebase ::
   (Codebase IO Symbol Ann -> IO r) -> Test r
 withTestCodebase action = do
   r <- io do
-    tmp <-
-      Temp.getCanonicalTemporaryDirectory
-        >>= flip Temp.createTempDirectory "lsp-test"
-    Codebase.Init.withCreatedCodebase SC.init "lsp-test" tmp SC.DoLock action
+    tmp <- Temp.getCanonicalTemporaryDirectory
+    tmpDir <- Temp.createTempDirectory tmp "lsp-test"
+    Codebase.Init.withCreatedCodebase SC.init "lsp-test" tmpDir SC.DontLock action
   either (crash . show) pure r