From 039ff700fbd7682314f2ceb0dd0fcb0040e30c46 Mon Sep 17 00:00:00 2001 From: Michael Cho Date: Sat, 4 Jan 2025 23:49:46 -0500 Subject: [PATCH] dhall-lsp-server: patch for GHC 9.6 (#971) https://github.com/dhall-lang/dhall-haskell/commit/d7a024e1ff87b89a64e51699e3f609fd4a719451 --- dhall-lsp-server/ghc-9.6.patch | 199 +++++++++++++++++++++++++++++++++ 1 file changed, 199 insertions(+) create mode 100644 dhall-lsp-server/ghc-9.6.patch diff --git a/dhall-lsp-server/ghc-9.6.patch b/dhall-lsp-server/ghc-9.6.patch new file mode 100644 index 00000000..5c28269c --- /dev/null +++ b/dhall-lsp-server/ghc-9.6.patch @@ -0,0 +1,199 @@ +diff --git a/dhall-lsp-server.cabal b/dhall-lsp-server.cabal +index bf8b11b9b..a44e37d00 100644 +--- a/dhall-lsp-server.cabal ++++ b/dhall-lsp-server.cabal +@@ -46,15 +46,14 @@ library + , aeson-pretty >= 0.8.7 && < 0.9 + , base >= 4.11 && < 5 + , bytestring >= 0.10.8.2 && < 0.12 ++ , co-log-core >= 0.3.1.0 && < 0.4 + , containers >= 0.5.11.0 && < 0.7 + , data-default >= 0.7.1.1 && < 0.8 + , directory >= 1.2.2.0 && < 1.4 + , dhall >= 1.38.0 && < 1.43 + , dhall-json >= 1.4 && < 1.8 + , filepath >= 1.4.2 && < 1.5 +- , lsp >= 1.2.0.0 && < 1.5 +- , rope-utf16-splay >= 0.3.1.0 && < 0.5 +- , hslogger >= 1.2.10 && < 1.4 ++ , lsp >= 1.5.0.0 && < 2 + , lens >= 4.16.1 && < 5.3 + -- megaparsec follows SemVer: https://github.com/mrkkrp/megaparsec/issues/469#issuecomment-927918469 + , megaparsec >= 7.0.2 && < 10 +@@ -62,6 +61,7 @@ library + , network-uri >= 2.6.1.0 && < 2.7 + , prettyprinter >= 1.7.0 && < 1.8 + , text >= 1.2.3.0 && < 2.1 ++ , text-rope >= 0.2 && < 0.3 + , transformers >= 0.5.5.0 && < 0.6 + , unordered-containers >= 0.2.9.0 && < 0.3 + , uri-encode >= 1.5.0.5 && < 1.6 +@@ -104,7 +104,7 @@ Test-Suite tests + GHC-Options: -Wall + Build-Depends: + base , +- lsp-types >= 1.2.0.0 && < 1.5 , ++ lsp-types >= 1.2.0.0 && < 1.7 , + hspec >= 2.7 && < 2.11 , + lsp-test >= 0.13.0.0 && < 0.15 , + tasty >= 0.11.2 && < 1.5 , +diff --git a/doctest/Main.hs b/doctest/Main.hs +index 20d594862..b858ae470 100644 +--- a/doctest/Main.hs ++++ b/doctest/Main.hs +@@ -1,23 +1,26 @@ +-module Main where ++module Main (main) where + + import System.FilePath (()) + + import qualified GHC.IO.Encoding + import qualified System.Directory ++import qualified System.Environment + import qualified System.IO + import qualified Test.DocTest + + main :: IO () + main = do +- + GHC.IO.Encoding.setLocaleEncoding System.IO.utf8 +- pwd <- System.Directory.getCurrentDirectory ++ args <- System.Environment.getArgs ++ pwd <- System.Directory.getCurrentDirectory + prefix <- System.Directory.makeAbsolute pwd ++ let src = prefix "src" + +- Test.DocTest.doctest ++ Test.DocTest.doctest $ + [ "--fast" + , "-XOverloadedStrings" + , "-XRecordWildCards" +- , "-i" <> (prefix "src") +- , prefix "src/Dhall/LSP/Backend/Diagnostics.hs" ++ ] <> args <> ++ [ "-i" <> src ++ , src "Dhall/LSP/Backend/Diagnostics.hs" + ] +diff --git a/src/Dhall/LSP/Handlers.hs b/src/Dhall/LSP/Handlers.hs +index fe37522f5..a5c778919 100644 +--- a/src/Dhall/LSP/Handlers.hs ++++ b/src/Dhall/LSP/Handlers.hs +@@ -75,7 +75,7 @@ import Text.Megaparsec (SourcePos (..), unPos) + import qualified Data.Aeson as Aeson + import qualified Data.HashMap.Strict as HashMap + import qualified Data.Map.Strict as Map +-import qualified Data.Rope.UTF16 as Rope ++import qualified Data.Text.Utf16.Rope as Rope + import qualified Data.Text as Text + import qualified Language.LSP.Server as LSP + import qualified Language.LSP.Types as LSP.Types +@@ -617,12 +617,12 @@ didSaveTextDocumentNotificationHandler = + + -- this handler is a stab to prevent `lsp:no handler for:` messages. + initializedHandler :: Handlers HandlerM +-initializedHandler = ++initializedHandler = + LSP.notificationHandler SInitialized \_ -> return () + + -- this handler is a stab to prevent `lsp:no handler for:` messages. + workspaceChangeConfigurationHandler :: Handlers HandlerM +-workspaceChangeConfigurationHandler = ++workspaceChangeConfigurationHandler = + LSP.notificationHandler SWorkspaceDidChangeConfiguration \_ -> return () + + -- this handler is a stab to prevent `lsp:no handler for:` messages. +@@ -639,7 +639,7 @@ handleErrorWithDefault :: (Either a1 b -> HandlerM a2) + -> b + -> HandlerM a2 + -> HandlerM a2 +-handleErrorWithDefault respond _default = flip catchE handler ++handleErrorWithDefault respond _default = flip catchE handler + where + handler (Log, _message) = do + let _xtype = MtLog +diff --git a/src/Dhall/LSP/Server.hs b/src/Dhall/LSP/Server.hs +index e31933579..e91b1a3a7 100644 +--- a/src/Dhall/LSP/Server.hs ++++ b/src/Dhall/LSP/Server.hs +@@ -1,10 +1,12 @@ + {-# LANGUAGE BlockArguments #-} + {-# LANGUAGE ExplicitNamespaces #-} ++{-# LANGUAGE LambdaCase #-} + {-# LANGUAGE RecordWildCards #-} + + {-| This is the entry point for the LSP server. -} + module Dhall.LSP.Server(run) where + ++import Colog.Core (LogAction, WithSeverity) + import Control.Monad.IO.Class (liftIO) + import Data.Aeson (fromJSON) + import Data.Default +@@ -22,23 +24,28 @@ import Dhall.LSP.Handlers + , cancelationHandler + ) + import Dhall.LSP.State +-import Language.LSP.Server (Options(..), ServerDefinition(..), type (<~>)(..)) ++import Language.LSP.Server (LspServerLog, Options(..), ServerDefinition(..), type (<~>)(..)) + import Language.LSP.Types ++import Prettyprinter (Doc, Pretty, pretty, viaShow) + import System.Exit (ExitCode(..)) ++import System.IO (stdin, stdout) + ++import qualified Colog.Core as Colog + import qualified Control.Concurrent.MVar as MVar + import qualified Control.Monad.Trans.Except as Except + import qualified Control.Monad.Trans.State.Strict as State + import qualified Data.Aeson as Aeson + import qualified Data.Text as Text ++import qualified Language.LSP.Logging as LSP + import qualified Language.LSP.Server as LSP + import qualified System.Exit as Exit +-import qualified System.Log.Logger + + -- | The main entry point for the LSP server. + run :: Maybe FilePath -> IO () +-run mlog = do +- setupLogger mlog ++run = withLogger $ \ioLogger -> do ++ let clientLogger = Colog.cmap (fmap (Text.pack . show . pretty)) LSP.defaultClientLogger ++ ++ let lspLogger = clientLogger <> Colog.hoistLogAction liftIO ioLogger + + state <- MVar.newMVar initialState + +@@ -117,20 +124,26 @@ run mlog = do + + backward = liftIO + +- exitCode <- LSP.runServer ServerDefinition{..} ++ exitCode <- LSP.runServerWithHandles ioLogger lspLogger stdin stdout ServerDefinition{..} + + case exitCode of + 0 -> return () + n -> Exit.exitWith (ExitFailure n) + +--- | sets the output logger. +--- | if no filename is provided then logger is disabled, if input is string `[OUTPUT]` then log goes to stderr, +--- | which then redirects inside VSCode to the output pane of the plugin. +-setupLogger :: Maybe FilePath -> IO () -- TODO: ADD verbosity +-setupLogger Nothing = pure () +-setupLogger (Just "[OUTPUT]") = LSP.setupLogger Nothing [] System.Log.Logger.DEBUG +-setupLogger file = LSP.setupLogger file [] System.Log.Logger.DEBUG +- ++-- | Retrieve the output logger. ++-- If no filename is provided then logger is disabled, if input is the string ++-- `[OUTPUT]` then we log to stderr. ++-- TODO: ADD verbosity ++withLogger :: (LogAction IO (WithSeverity LspServerLog) -> IO ()) -> Maybe FilePath -> IO () ++withLogger k = \case ++ Nothing -> k (Colog.LogAction (const (pure ()))) ++ Just "[OUTPUT]" -> k' Colog.logStringStderr ++ Just fp -> Colog.withLogStringFile fp k' ++ where ++ k' = k . Colog.cmap (show . prettyMsg) ++ ++ prettyMsg :: Pretty a => WithSeverity a -> Doc ann ++ prettyMsg l = "[" <> viaShow (Colog.getSeverity l) <> "] " <> pretty (Colog.getMsg l) + + -- Tells the LSP client to notify us about file changes. Handled behind the + -- scenes by haskell-lsp (in Language.Haskell.LSP.VFS); we don't handle the