Skip to content

Commit 039ff70

Browse files
cho-mcho-m
authored
dhall-lsp-server: patch for GHC 9.6 (#971)
dhall-lang/dhall-haskell@d7a024e
1 parent e1d275b commit 039ff70

File tree

1 file changed

+199
-0
lines changed

1 file changed

+199
-0
lines changed

‎dhall-lsp-server/ghc-9.6.patch

+199
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,199 @@
1+
diff --git a/dhall-lsp-server.cabal b/dhall-lsp-server.cabal
2+
index bf8b11b9b..a44e37d00 100644
3+
--- a/dhall-lsp-server.cabal
4+
+++ b/dhall-lsp-server.cabal
5+
@@ -46,15 +46,14 @@ library
6+
, aeson-pretty >= 0.8.7 && < 0.9
7+
, base >= 4.11 && < 5
8+
, bytestring >= 0.10.8.2 && < 0.12
9+
+ , co-log-core >= 0.3.1.0 && < 0.4
10+
, containers >= 0.5.11.0 && < 0.7
11+
, data-default >= 0.7.1.1 && < 0.8
12+
, directory >= 1.2.2.0 && < 1.4
13+
, dhall >= 1.38.0 && < 1.43
14+
, dhall-json >= 1.4 && < 1.8
15+
, filepath >= 1.4.2 && < 1.5
16+
- , lsp >= 1.2.0.0 && < 1.5
17+
- , rope-utf16-splay >= 0.3.1.0 && < 0.5
18+
- , hslogger >= 1.2.10 && < 1.4
19+
+ , lsp >= 1.5.0.0 && < 2
20+
, lens >= 4.16.1 && < 5.3
21+
-- megaparsec follows SemVer: https://github.com/mrkkrp/megaparsec/issues/469#issuecomment-927918469
22+
, megaparsec >= 7.0.2 && < 10
23+
@@ -62,6 +61,7 @@ library
24+
, network-uri >= 2.6.1.0 && < 2.7
25+
, prettyprinter >= 1.7.0 && < 1.8
26+
, text >= 1.2.3.0 && < 2.1
27+
+ , text-rope >= 0.2 && < 0.3
28+
, transformers >= 0.5.5.0 && < 0.6
29+
, unordered-containers >= 0.2.9.0 && < 0.3
30+
, uri-encode >= 1.5.0.5 && < 1.6
31+
@@ -104,7 +104,7 @@ Test-Suite tests
32+
GHC-Options: -Wall
33+
Build-Depends:
34+
base ,
35+
- lsp-types >= 1.2.0.0 && < 1.5 ,
36+
+ lsp-types >= 1.2.0.0 && < 1.7 ,
37+
hspec >= 2.7 && < 2.11 ,
38+
lsp-test >= 0.13.0.0 && < 0.15 ,
39+
tasty >= 0.11.2 && < 1.5 ,
40+
diff --git a/doctest/Main.hs b/doctest/Main.hs
41+
index 20d594862..b858ae470 100644
42+
--- a/doctest/Main.hs
43+
+++ b/doctest/Main.hs
44+
@@ -1,23 +1,26 @@
45+
-module Main where
46+
+module Main (main) where
47+
48+
import System.FilePath ((</>))
49+
50+
import qualified GHC.IO.Encoding
51+
import qualified System.Directory
52+
+import qualified System.Environment
53+
import qualified System.IO
54+
import qualified Test.DocTest
55+
56+
main :: IO ()
57+
main = do
58+
-
59+
GHC.IO.Encoding.setLocaleEncoding System.IO.utf8
60+
- pwd <- System.Directory.getCurrentDirectory
61+
+ args <- System.Environment.getArgs
62+
+ pwd <- System.Directory.getCurrentDirectory
63+
prefix <- System.Directory.makeAbsolute pwd
64+
+ let src = prefix </> "src"
65+
66+
- Test.DocTest.doctest
67+
+ Test.DocTest.doctest $
68+
[ "--fast"
69+
, "-XOverloadedStrings"
70+
, "-XRecordWildCards"
71+
- , "-i" <> (prefix </> "src")
72+
- , prefix </> "src/Dhall/LSP/Backend/Diagnostics.hs"
73+
+ ] <> args <>
74+
+ [ "-i" <> src
75+
+ , src </> "Dhall/LSP/Backend/Diagnostics.hs"
76+
]
77+
diff --git a/src/Dhall/LSP/Handlers.hs b/src/Dhall/LSP/Handlers.hs
78+
index fe37522f5..a5c778919 100644
79+
--- a/src/Dhall/LSP/Handlers.hs
80+
+++ b/src/Dhall/LSP/Handlers.hs
81+
@@ -75,7 +75,7 @@ import Text.Megaparsec (SourcePos (..), unPos)
82+
import qualified Data.Aeson as Aeson
83+
import qualified Data.HashMap.Strict as HashMap
84+
import qualified Data.Map.Strict as Map
85+
-import qualified Data.Rope.UTF16 as Rope
86+
+import qualified Data.Text.Utf16.Rope as Rope
87+
import qualified Data.Text as Text
88+
import qualified Language.LSP.Server as LSP
89+
import qualified Language.LSP.Types as LSP.Types
90+
@@ -617,12 +617,12 @@ didSaveTextDocumentNotificationHandler =
91+
92+
-- this handler is a stab to prevent `lsp:no handler for:` messages.
93+
initializedHandler :: Handlers HandlerM
94+
-initializedHandler =
95+
+initializedHandler =
96+
LSP.notificationHandler SInitialized \_ -> return ()
97+
98+
-- this handler is a stab to prevent `lsp:no handler for:` messages.
99+
workspaceChangeConfigurationHandler :: Handlers HandlerM
100+
-workspaceChangeConfigurationHandler =
101+
+workspaceChangeConfigurationHandler =
102+
LSP.notificationHandler SWorkspaceDidChangeConfiguration \_ -> return ()
103+
104+
-- this handler is a stab to prevent `lsp:no handler for:` messages.
105+
@@ -639,7 +639,7 @@ handleErrorWithDefault :: (Either a1 b -> HandlerM a2)
106+
-> b
107+
-> HandlerM a2
108+
-> HandlerM a2
109+
-handleErrorWithDefault respond _default = flip catchE handler
110+
+handleErrorWithDefault respond _default = flip catchE handler
111+
where
112+
handler (Log, _message) = do
113+
let _xtype = MtLog
114+
diff --git a/src/Dhall/LSP/Server.hs b/src/Dhall/LSP/Server.hs
115+
index e31933579..e91b1a3a7 100644
116+
--- a/src/Dhall/LSP/Server.hs
117+
+++ b/src/Dhall/LSP/Server.hs
118+
@@ -1,10 +1,12 @@
119+
{-# LANGUAGE BlockArguments #-}
120+
{-# LANGUAGE ExplicitNamespaces #-}
121+
+{-# LANGUAGE LambdaCase #-}
122+
{-# LANGUAGE RecordWildCards #-}
123+
124+
{-| This is the entry point for the LSP server. -}
125+
module Dhall.LSP.Server(run) where
126+
127+
+import Colog.Core (LogAction, WithSeverity)
128+
import Control.Monad.IO.Class (liftIO)
129+
import Data.Aeson (fromJSON)
130+
import Data.Default
131+
@@ -22,23 +24,28 @@ import Dhall.LSP.Handlers
132+
, cancelationHandler
133+
)
134+
import Dhall.LSP.State
135+
-import Language.LSP.Server (Options(..), ServerDefinition(..), type (<~>)(..))
136+
+import Language.LSP.Server (LspServerLog, Options(..), ServerDefinition(..), type (<~>)(..))
137+
import Language.LSP.Types
138+
+import Prettyprinter (Doc, Pretty, pretty, viaShow)
139+
import System.Exit (ExitCode(..))
140+
+import System.IO (stdin, stdout)
141+
142+
+import qualified Colog.Core as Colog
143+
import qualified Control.Concurrent.MVar as MVar
144+
import qualified Control.Monad.Trans.Except as Except
145+
import qualified Control.Monad.Trans.State.Strict as State
146+
import qualified Data.Aeson as Aeson
147+
import qualified Data.Text as Text
148+
+import qualified Language.LSP.Logging as LSP
149+
import qualified Language.LSP.Server as LSP
150+
import qualified System.Exit as Exit
151+
-import qualified System.Log.Logger
152+
153+
-- | The main entry point for the LSP server.
154+
run :: Maybe FilePath -> IO ()
155+
-run mlog = do
156+
- setupLogger mlog
157+
+run = withLogger $ \ioLogger -> do
158+
+ let clientLogger = Colog.cmap (fmap (Text.pack . show . pretty)) LSP.defaultClientLogger
159+
+
160+
+ let lspLogger = clientLogger <> Colog.hoistLogAction liftIO ioLogger
161+
162+
state <- MVar.newMVar initialState
163+
164+
@@ -117,20 +124,26 @@ run mlog = do
165+
166+
backward = liftIO
167+
168+
- exitCode <- LSP.runServer ServerDefinition{..}
169+
+ exitCode <- LSP.runServerWithHandles ioLogger lspLogger stdin stdout ServerDefinition{..}
170+
171+
case exitCode of
172+
0 -> return ()
173+
n -> Exit.exitWith (ExitFailure n)
174+
175+
--- | sets the output logger.
176+
--- | if no filename is provided then logger is disabled, if input is string `[OUTPUT]` then log goes to stderr,
177+
--- | which then redirects inside VSCode to the output pane of the plugin.
178+
-setupLogger :: Maybe FilePath -> IO () -- TODO: ADD verbosity
179+
-setupLogger Nothing = pure ()
180+
-setupLogger (Just "[OUTPUT]") = LSP.setupLogger Nothing [] System.Log.Logger.DEBUG
181+
-setupLogger file = LSP.setupLogger file [] System.Log.Logger.DEBUG
182+
-
183+
+-- | Retrieve the output logger.
184+
+-- If no filename is provided then logger is disabled, if input is the string
185+
+-- `[OUTPUT]` then we log to stderr.
186+
+-- TODO: ADD verbosity
187+
+withLogger :: (LogAction IO (WithSeverity LspServerLog) -> IO ()) -> Maybe FilePath -> IO ()
188+
+withLogger k = \case
189+
+ Nothing -> k (Colog.LogAction (const (pure ())))
190+
+ Just "[OUTPUT]" -> k' Colog.logStringStderr
191+
+ Just fp -> Colog.withLogStringFile fp k'
192+
+ where
193+
+ k' = k . Colog.cmap (show . prettyMsg)
194+
+
195+
+ prettyMsg :: Pretty a => WithSeverity a -> Doc ann
196+
+ prettyMsg l = "[" <> viaShow (Colog.getSeverity l) <> "] " <> pretty (Colog.getMsg l)
197+
198+
-- Tells the LSP client to notify us about file changes. Handled behind the
199+
-- scenes by haskell-lsp (in Language.Haskell.LSP.VFS); we don't handle the

0 commit comments

Comments
 (0)