Update to depend on lsp-2.4.0.0

.github/workflows/haskell-ci.yml

@@ -17,9 +17,9 @@
 #
 # For more information, see https://github.com/haskell-CI/haskell-ci
 #
-# version: 0.16.3
+# version: 0.17.20240109
 #
-# REGENDATA ("0.16.3",["github","--config=cabal.haskell-ci","--copy-fields=all","swarm.cabal"])
+# REGENDATA ("0.17.20240109",["github","--config=cabal.haskell-ci","--copy-fields=all","swarm.cabal"])
 #
 name: Haskell-CI
 on:
@@ -57,24 +57,19 @@ jobs:
     strategy:
       matrix:
         include:
-          - compiler: ghc-9.6.2
+          - compiler: ghc-9.6.4
             compilerKind: ghc
-            compilerVersion: 9.6.2
+            compilerVersion: 9.6.4
             setup-method: ghcup
             allow-failure: false
-          - compiler: ghc-9.4.5
+          - compiler: ghc-9.4.8
             compilerKind: ghc
-            compilerVersion: 9.4.5
+            compilerVersion: 9.4.8
             setup-method: ghcup
             allow-failure: false
-          - compiler: ghc-9.2.7
+          - compiler: ghc-9.2.8
             compilerKind: ghc
-            compilerVersion: 9.2.7
-            setup-method: ghcup
-            allow-failure: false
-          - compiler: ghc-9.0.2
-            compilerKind: ghc
-            compilerVersion: 9.0.2
+            compilerVersion: 9.2.8
             setup-method: ghcup
             allow-failure: false
       fail-fast: false
@@ -84,10 +79,10 @@ jobs:
           apt-get update
           apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5
           mkdir -p "$HOME/.ghcup/bin"
-          curl -sL https://downloads.haskell.org/ghcup/0.1.19.2/x86_64-linux-ghcup-0.1.19.2 > "$HOME/.ghcup/bin/ghcup"
+          curl -sL https://downloads.haskell.org/ghcup/0.1.20.0/x86_64-linux-ghcup-0.1.20.0 > "$HOME/.ghcup/bin/ghcup"
           chmod a+x "$HOME/.ghcup/bin/ghcup"
           "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false)
-          "$HOME/.ghcup/bin/ghcup" install cabal 3.10.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false)
+          "$HOME/.ghcup/bin/ghcup" install cabal 3.10.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false)
         env:
           HCKIND: ${{ matrix.compilerKind }}
           HCNAME: ${{ matrix.compiler }}
@@ -99,11 +94,13 @@ jobs:
           echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV"
           echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV"
           HCDIR=/opt/$HCKIND/$HCVER
-          HC=$HOME/.ghcup/bin/$HCKIND-$HCVER
+          HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER")
+          HCPKG=$(echo "$HC" | sed 's#ghc$#ghc-pkg#')
+          HADDOCK=$(echo "$HC" | sed 's#ghc$#haddock#')
           echo "HC=$HC" >> "$GITHUB_ENV"
-          echo "HCPKG=$HOME/.ghcup/bin/$HCKIND-pkg-$HCVER" >> "$GITHUB_ENV"
-          echo "HADDOCK=$HOME/.ghcup/bin/haddock-$HCVER" >> "$GITHUB_ENV"
-          echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.1.0 -vnormal+nowrap" >> "$GITHUB_ENV"
+          echo "HCPKG=$HCPKG" >> "$GITHUB_ENV"
+          echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV"
+          echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.2.0 -vnormal+nowrap" >> "$GITHUB_ENV"
           HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')
           echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV"
           echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV"
@@ -153,7 +150,7 @@ jobs:
       - name: cache (tools)
         uses: actions/cache/restore@v3
         with:
-          key: ${{ runner.os }}-${{ matrix.compiler }}-tools-1d2d1963
+          key: ${{ runner.os }}-${{ matrix.compiler }}-tools-fda4bbd7
           path: ~/.haskell-ci-tools
       - name: install cabal-plan
         run: |
@@ -167,8 +164,8 @@ jobs:
       - name: install cabal-docspec
         run: |
           mkdir -p $HOME/.cabal/bin
-          curl -sL https://github.com/phadej/cabal-extras/releases/download/cabal-docspec-0.0.0.20230517/cabal-docspec-0.0.0.20230517-x86_64-linux.xz > cabal-docspec.xz
-          echo '3b31bbe463ad4d671abbc103db49628562ec48a6604cab278207b5b6acd21ed7  cabal-docspec.xz' | sha256sum -c -
+          curl -sL https://github.com/phadej/cabal-extras/releases/download/cabal-docspec-0.0.0.20231219/cabal-docspec-0.0.0.20231219-x86_64-linux.xz > cabal-docspec.xz
+          echo '8b60448275466bbe2b9409741b5dd07a41c541283017b95b44efe6e31379d067  cabal-docspec.xz' | sha256sum -c -
           xz -d < cabal-docspec.xz > $HOME/.cabal/bin/cabal-docspec
           rm -f cabal-docspec.xz
           chmod a+x $HOME/.cabal/bin/cabal-docspec
@@ -183,7 +180,7 @@ jobs:
         uses: actions/cache/save@v3
         if: always()
         with:
-          key: ${{ runner.os }}-${{ matrix.compiler }}-tools-1d2d1963
+          key: ${{ runner.os }}-${{ matrix.compiler }}-tools-fda4bbd7
           path: ~/.haskell-ci-tools
       - name: checkout
         uses: actions/checkout@v3
@@ -245,6 +242,13 @@ jobs:
       - name: hlint
         run: |
           if [ $((HCNUMVER >= 90400 && HCNUMVER < 90600)) -ne 0 ] ; then (cd ${PKGDIR_swarm} && hlint -h ${GITHUB_WORKSPACE}/source/.hlint.yaml -XHaskell2010 -XBangPatterns -XDeriveAnyClass -XDeriveDataTypeable -XDeriveFunctor -XDeriveGeneric -XDeriveTraversable -XExplicitForAll -XFlexibleContexts -XFlexibleInstances -XGADTSyntax -XMultiParamTypeClasses -XNumericUnderscores -XRankNTypes -XScopedTypeVariables -XStandaloneDeriving -XTupleSections -XTypeApplications -XTypeOperators -XImportQualifiedPost -XLambdaCase -XStrictData src) ; fi
+          if [ $((HCNUMVER >= 90400 && HCNUMVER < 90600)) -ne 0 ] ; then (cd ${PKGDIR_swarm} && hlint -h ${GITHUB_WORKSPACE}/source/.hlint.yaml -XHaskell2010 -XBangPatterns -XDeriveAnyClass -XDeriveDataTypeable -XDeriveFunctor -XDeriveGeneric -XDeriveTraversable -XExplicitForAll -XFlexibleContexts -XFlexibleInstances -XGADTSyntax -XMultiParamTypeClasses -XNumericUnderscores -XRankNTypes -XScopedTypeVariables -XStandaloneDeriving -XTupleSections -XTypeApplications -XTypeOperators -XImportQualifiedPost -XLambdaCase -XStrictData src/swarm-util) ; fi
+          if [ $((HCNUMVER >= 90400 && HCNUMVER < 90600)) -ne 0 ] ; then (cd ${PKGDIR_swarm} && hlint -h ${GITHUB_WORKSPACE}/source/.hlint.yaml -XHaskell2010 -XBangPatterns -XDeriveAnyClass -XDeriveDataTypeable -XDeriveFunctor -XDeriveGeneric -XDeriveTraversable -XExplicitForAll -XFlexibleContexts -XFlexibleInstances -XGADTSyntax -XMultiParamTypeClasses -XNumericUnderscores -XRankNTypes -XScopedTypeVariables -XStandaloneDeriving -XTupleSections -XTypeApplications -XTypeOperators -XImportQualifiedPost -XLambdaCase -XStrictData src/swarm-web) ; fi
+          if [ $((HCNUMVER >= 90400 && HCNUMVER < 90600)) -ne 0 ] ; then (cd ${PKGDIR_swarm} && hlint -h ${GITHUB_WORKSPACE}/source/.hlint.yaml -XHaskell2010 -XBangPatterns -XDeriveAnyClass -XDeriveDataTypeable -XDeriveFunctor -XDeriveGeneric -XDeriveTraversable -XExplicitForAll -XFlexibleContexts -XFlexibleInstances -XGADTSyntax -XMultiParamTypeClasses -XNumericUnderscores -XRankNTypes -XScopedTypeVariables -XStandaloneDeriving -XTupleSections -XTypeApplications -XTypeOperators -XImportQualifiedPost -XLambdaCase -XStrictData src/swarm-engine) ; fi
+          if [ $((HCNUMVER >= 90400 && HCNUMVER < 90600)) -ne 0 ] ; then (cd ${PKGDIR_swarm} && hlint -h ${GITHUB_WORKSPACE}/source/.hlint.yaml -XHaskell2010 -XBangPatterns -XDeriveAnyClass -XDeriveDataTypeable -XDeriveFunctor -XDeriveGeneric -XDeriveTraversable -XExplicitForAll -XFlexibleContexts -XFlexibleInstances -XGADTSyntax -XMultiParamTypeClasses -XNumericUnderscores -XRankNTypes -XScopedTypeVariables -XStandaloneDeriving -XTupleSections -XTypeApplications -XTypeOperators -XImportQualifiedPost -XLambdaCase -XStrictData src/swarm-scenario) ; fi
+          if [ $((HCNUMVER >= 90400 && HCNUMVER < 90600)) -ne 0 ] ; then (cd ${PKGDIR_swarm} && hlint -h ${GITHUB_WORKSPACE}/source/.hlint.yaml -XHaskell2010 -XBangPatterns -XDeriveAnyClass -XDeriveDataTypeable -XDeriveFunctor -XDeriveGeneric -XDeriveTraversable -XExplicitForAll -XFlexibleContexts -XFlexibleInstances -XGADTSyntax -XMultiParamTypeClasses -XNumericUnderscores -XRankNTypes -XScopedTypeVariables -XStandaloneDeriving -XTupleSections -XTypeApplications -XTypeOperators -XImportQualifiedPost -XLambdaCase -XStrictData src/swarm-lang) ; fi
+          if [ $((HCNUMVER >= 90400 && HCNUMVER < 90600)) -ne 0 ] ; then (cd ${PKGDIR_swarm} && hlint -h ${GITHUB_WORKSPACE}/source/.hlint.yaml -XHaskell2010 -XBangPatterns -XDeriveAnyClass -XDeriveDataTypeable -XDeriveFunctor -XDeriveGeneric -XDeriveTraversable -XExplicitForAll -XFlexibleContexts -XFlexibleInstances -XGADTSyntax -XMultiParamTypeClasses -XNumericUnderscores -XRankNTypes -XScopedTypeVariables -XStandaloneDeriving -XTupleSections -XTypeApplications -XTypeOperators -XImportQualifiedPost -XLambdaCase app/doc) ; fi
+          if [ $((HCNUMVER >= 90400 && HCNUMVER < 90600)) -ne 0 ] ; then (cd ${PKGDIR_swarm} && hlint -h ${GITHUB_WORKSPACE}/source/.hlint.yaml -XHaskell2010 -XBangPatterns -XDeriveAnyClass -XDeriveDataTypeable -XDeriveFunctor -XDeriveGeneric -XDeriveTraversable -XExplicitForAll -XFlexibleContexts -XFlexibleInstances -XGADTSyntax -XMultiParamTypeClasses -XNumericUnderscores -XRankNTypes -XScopedTypeVariables -XStandaloneDeriving -XTupleSections -XTypeApplications -XTypeOperators -XImportQualifiedPost -XLambdaCase app/scene) ; fi
           if [ $((HCNUMVER >= 90400 && HCNUMVER < 90600)) -ne 0 ] ; then (cd ${PKGDIR_swarm} && hlint -h ${GITHUB_WORKSPACE}/source/.hlint.yaml -XHaskell2010 -XImportQualifiedPost app) ; fi
       - name: cabal check
         run: |

.mergify.yml

@@ -14,10 +14,9 @@ queue_rules:
           - or:
             - check-success=Enforce issue references
             - -files~=\.hs$
-          - check-success=Haskell-CI - Linux - ghc-9.6.2
-          - check-success=Haskell-CI - Linux - ghc-9.4.5
-          - check-success=Haskell-CI - Linux - ghc-9.2.7
-          - check-success=Haskell-CI - Linux - ghc-9.0.2
+          - check-success=Haskell-CI - Linux - ghc-9.6.4
+          - check-success=Haskell-CI - Linux - ghc-9.4.8
+          - check-success=Haskell-CI - Linux - ghc-9.2.8
 
 pull_request_rules:
 - actions:
@@ -44,10 +43,9 @@ pull_request_rules:
       - or:
         - check-success=Enforce issue references
         - -files~=\.hs$
-      - check-success=Haskell-CI - Linux - ghc-9.6.2
-      - check-success=Haskell-CI - Linux - ghc-9.4.5
-      - check-success=Haskell-CI - Linux - ghc-9.2.7
-      - check-success=Haskell-CI - Linux - ghc-9.0.2
+      - check-success=Haskell-CI - Linux - ghc-9.6.4
+      - check-success=Haskell-CI - Linux - ghc-9.4.8
+      - check-success=Haskell-CI - Linux - ghc-9.2.8
   - label=merge me
   - ! '#approved-reviews-by>=1'
   - ! '#changes-requested-reviews-by=0'

cabal.haskell-ci

@@ -19,7 +19,7 @@ benchmarks: True
 
 -- Run HLint
 hlint: True
-hlint-job: 9.4.5
+hlint-job: 9.4.8
 hlint-yaml: .hlint.yaml
 hlint-download-binary: True
 

src/swarm-lang/Swarm/Language/LSP.hs

@@ -10,14 +10,15 @@ module Swarm.Language.LSP where
 import Control.Lens (to, (^.))
 import Control.Monad (void)
 import Control.Monad.IO.Class
+import Data.Int (Int32)
 import Data.Maybe (fromMaybe, mapMaybe)
 import Data.Text (Text)
 import Data.Text.IO qualified as Text
 import Language.LSP.Diagnostics
+import Language.LSP.Protocol.Lens qualified as LSP
+import Language.LSP.Protocol.Message qualified as LSP
+import Language.LSP.Protocol.Types qualified as LSP
 import Language.LSP.Server
-import Language.LSP.Types (Hover (Hover))
-import Language.LSP.Types qualified as J
-import Language.LSP.Types.Lens qualified as J
 import Language.LSP.VFS (VirtualFile (..), virtualFileText)
 import Swarm.Language.LSP.Hover qualified as H
 import Swarm.Language.LSP.VarUsage qualified as VU
@@ -34,38 +35,42 @@ lspMain =
   void $
     runServer $
       ServerDefinition
-        { onConfigurationChange = const $ const $ Right ()
-        , defaultConfig = ()
+        { defaultConfig = ()
+        , configSection = "swarm"
+        , parseConfig = const $ const $ Right ()
+        , onConfigChange = const $ return ()
         , doInitialize = \env _req -> pure $ Right env
-        , staticHandlers = handlers
+        , staticHandlers = const handlers
         , interpretHandler = \env -> Iso (runLspT env) liftIO
         , options =
             defaultOptions
               { -- set sync options to get DidSave event, as well as Open and Close events.
-                textDocumentSync =
+                optTextDocumentSync =
                   Just
-                    ( J.TextDocumentSyncOptions
+                    ( LSP.TextDocumentSyncOptions
                         (Just True)
                         (Just syncKind)
                         (Just False)
                         (Just False)
-                        (Just . J.InR . J.SaveOptions $ Just True)
+                        (Just . LSP.InR . LSP.SaveOptions $ Just True)
                     )
               }
         }
  where
   -- Using SyncFull seems to handle the debounce for us.
-  -- The alternative is to use SyncIncremental, but then then
-  -- handler is called for each key-stroke.
-  syncKind = J.TdSyncFull
+  -- The alternative is to use SyncIncremental, but then the
+  -- handler is called for each keystroke.
+  syncKind = LSP.TextDocumentSyncKind_Full
 
 diagnosticSourcePrefix :: Text
 diagnosticSourcePrefix = "swarm-lsp"
 
 debug :: (MonadIO m) => Text -> m ()
 debug msg = liftIO $ Text.hPutStrLn stderr $ "[swarm-lsp] " <> msg
 
-validateSwarmCode :: J.NormalizedUri -> J.TextDocumentVersion -> Text -> LspM () ()
+type TextDocumentVersion = Int32
+
+validateSwarmCode :: LSP.NormalizedUri -> Maybe TextDocumentVersion -> Text -> LspM () ()
 validateSwarmCode doc version content = do
   -- debug $ "Validating: " <> from (show doc) <> " ( " <> content <> ")"
 
@@ -101,32 +106,36 @@ validateSwarmCode doc version content = do
   publishDiags $
     map makeParseErrorDiagnostic parsingErrs
  where
-  publishDiags :: [J.Diagnostic] -> LspM () ()
+  publishDiags :: [LSP.Diagnostic] -> LspM () ()
   publishDiags = publishDiagnostics 1 doc version . partitionBySource
 
-  makeUnusedVarDiagnostic :: (J.Range, Text) -> J.Diagnostic
+  makeUnusedVarDiagnostic :: (LSP.Range, Text) -> LSP.Diagnostic
   makeUnusedVarDiagnostic (range, msg) =
-    J.Diagnostic
+    LSP.Diagnostic
       range
-      (Just J.DsWarning) -- severity
+      (Just LSP.DiagnosticSeverity_Warning) -- severity
       Nothing -- code
+      Nothing -- code description
       (Just diagnosticSourcePrefix) -- source
       msg
-      (Just (J.List [J.DtUnnecessary])) -- tags
+      (Just [LSP.DiagnosticTag_Unnecessary]) -- tags
       Nothing -- related source code info
-  makeParseErrorDiagnostic :: ((Int, Int), (Int, Int), Text) -> J.Diagnostic
+      Nothing -- data
+  makeParseErrorDiagnostic :: ((Int, Int), (Int, Int), Text) -> LSP.Diagnostic
   makeParseErrorDiagnostic ((startLine, startCol), (endLine, endCol), msg) =
-    J.Diagnostic
-      ( J.Range
-          (J.Position (fromIntegral startLine) (fromIntegral startCol))
-          (J.Position (fromIntegral endLine) (fromIntegral endCol))
+    LSP.Diagnostic
+      ( LSP.Range
+          (LSP.Position (fromIntegral startLine) (fromIntegral startCol))
+          (LSP.Position (fromIntegral endLine) (fromIntegral endCol))
       )
-      (Just J.DsError) -- severity
+      (Just LSP.DiagnosticSeverity_Error) -- severity
       Nothing -- code
+      Nothing -- code description
       (Just diagnosticSourcePrefix) -- source
       msg
       Nothing -- tags
-      (Just (J.List []))
+      (Just []) -- related info
+      Nothing -- data
 
 showTypeErrorPos :: Text -> ContextualTypeErr -> ((Int, Int), (Int, Int), Text)
 showTypeErrorPos code (CTE l _ te) = (minusOne start, minusOne end, msg)
@@ -141,30 +150,30 @@ showTypeErrorPos code (CTE l _ te) = (minusOne start, minusOne end, msg)
 handlers :: Handlers (LspM ())
 handlers =
   mconcat
-    [ notificationHandler J.SInitialized $ \_not -> do
+    [ notificationHandler LSP.SMethod_Initialized $ \_not -> do
         debug "Initialized"
-    , notificationHandler J.STextDocumentDidSave $ \msg -> do
-        let doc = msg ^. J.params . J.textDocument . J.uri
-            content = fromMaybe "?" $ msg ^. J.params . J.text
-        validateSwarmCode (J.toNormalizedUri doc) Nothing content
-    , notificationHandler J.STextDocumentDidOpen $ \msg -> do
-        let doc = msg ^. J.params . J.textDocument . J.uri
-            content = msg ^. J.params . J.textDocument . J.text
-        validateSwarmCode (J.toNormalizedUri doc) Nothing content
-    , notificationHandler J.STextDocumentDidChange $ \msg -> do
-        let doc = msg ^. J.params . J.textDocument . J.uri . to J.toNormalizedUri
+    , notificationHandler LSP.SMethod_TextDocumentDidSave $ \msg -> do
+        let doc = msg ^. LSP.params . LSP.textDocument . LSP.uri
+            content = fromMaybe "?" $ msg ^. LSP.params . LSP.text
+        validateSwarmCode (LSP.toNormalizedUri doc) Nothing content
+    , notificationHandler LSP.SMethod_TextDocumentDidOpen $ \msg -> do
+        let doc = msg ^. LSP.params . LSP.textDocument . LSP.uri
+            content = msg ^. LSP.params . LSP.textDocument . LSP.text
+        validateSwarmCode (LSP.toNormalizedUri doc) Nothing content
+    , notificationHandler LSP.SMethod_TextDocumentDidChange $ \msg -> do
+        let doc = msg ^. LSP.params . LSP.textDocument . LSP.uri . to LSP.toNormalizedUri
         mdoc <- getVirtualFile doc
         case mdoc of
           Just vf@(VirtualFile _ version _rope) -> do
-            validateSwarmCode doc (Just $ fromIntegral version) (virtualFileText vf)
+            validateSwarmCode doc (Just (fromIntegral version)) (virtualFileText vf)
           _ -> debug $ "No virtual file found for: " <> from (show msg)
-    , requestHandler J.STextDocumentHover $ \req responder -> do
-        let doc = req ^. J.params . J.textDocument . J.uri . to J.toNormalizedUri
-            pos = req ^. J.params . J.position
+    , requestHandler LSP.SMethod_TextDocumentHover $ \req responder -> do
+        let doc = req ^. LSP.params . LSP.textDocument . LSP.uri . to LSP.toNormalizedUri
+            pos = req ^. LSP.params . LSP.position
         mdoc <- getVirtualFile doc
         let maybeHover = do
               vf <- mdoc
-              (markdownText, maybeRange) <- H.showHoverInfo doc Nothing pos vf
-              return $ Hover (J.HoverContents $ J.MarkupContent J.MkMarkdown markdownText) maybeRange
-        responder $ Right maybeHover
+              (markdownText, maybeRange) <- H.showHoverInfo doc pos vf
+              return $ LSP.Hover (LSP.InL $ LSP.MarkupContent LSP.MarkupKind_Markdown markdownText) maybeRange
+        responder . Right . LSP.maybeToNull $ maybeHover
     ]