Fix ghc and hlint warnings

cabal.project

@@ -10,12 +10,15 @@ test-show-details: direct
 
 benchmarks: True
 
+package *
+  ghc-options: -Wunused-packages
+
 package lsp
   flags: +demo
 
 package lsp-types
   -- This makes a big difference here as lsp-types
-  -- has very many independent modules 
+  -- has very many independent modules
   ghc-options: -j4
 
 -- We allow filepath-1.5, this lets us actually test it. There is no problem

lsp-test/lsp-test.cabal

@@ -66,7 +66,6 @@ library
     , mtl                 >=2.2   && <2.4
     , parser-combinators  ^>=1.3
     , process             ^>=1.6
-    , row-types           ^>=1.0
     , some                ^>=1.0
     , text                >=1     && <2.2
     , time                >=1.10  && <1.13

lsp-test/src/Language/LSP/Test/Compat.hs

@@ -1,7 +1,6 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
-{-# LANGUAGE OverloadedLabels #-}
 {-# LANGUAGE OverloadedStrings #-}
 -- For some reason ghc warns about not using
 -- Control.Monad.IO.Class but it's needed for
@@ -103,7 +102,7 @@ cleanupProcess (mb_stdin, mb_stdout, mb_stderr, ph) = do
     return ()
   where ignoreSigPipe = ignoreIOError ResourceVanished ePIPE
         ignorePermDenied = ignoreIOError PermissionDenied eACCES
-    
+
 ignoreIOError :: IOErrorType -> Errno -> IO () -> IO ()
 ignoreIOError ioErrorType errno =
   C.handle $ \e -> case e of

lsp-test/src/Language/LSP/Test/Decoding.hs

@@ -10,7 +10,6 @@ import Data.Aeson
 import Data.Aeson.Types
 import Data.ByteString.Lazy.Char8 qualified as B
 import Data.Foldable
-import Data.Functor.Const
 import Data.Functor.Product
 import Data.Maybe
 import Language.LSP.Protocol.Lens qualified as L
@@ -82,7 +81,7 @@ decodeFromServerMsg reqMap bytes = unP $ parse p obj
     let (mm, newMap) = pickFromIxMap lid reqMap
      in case mm of
           Nothing -> Nothing
-          Just m -> Just $ (m, Pair m (Const newMap))
+          Just m -> Just (m, Pair m (Const newMap))
   unP (Success (FromServerMess m msg)) = (reqMap, FromServerMess m msg)
   unP (Success (FromServerRsp (Pair m (Const newMap)) msg)) = (newMap, FromServerRsp m msg)
   unP (Error e) = error $ "Error decoding " <> show obj <> " :" <> e

lsp-test/src/Language/LSP/Test/Files.hs

@@ -83,18 +83,13 @@ mapUris f event =
         swapDocumentChangeUri (InR (InR (InL renameFile))) = InR $ InR $ InL $ L.newUri .~ f (renameFile ^. L.newUri) $ renameFile
         swapDocumentChangeUri (InR (InR (InR deleteFile))) = InR $ InR $ InR $ swapUri id deleteFile
      in e
-          & L.changes . _Just %~ swapKeys f
+          & L.changes . _Just %~ M.mapKeys f
           & L.documentChanges . _Just . traversed %~ swapDocumentChangeUri
 
-  swapKeys :: (Uri -> Uri) -> M.Map Uri b -> M.Map Uri b
-  swapKeys f = M.foldlWithKey' (\acc k v -> M.insert (f k) v acc) M.empty
-
   swapUri :: L.HasUri b Uri => Lens' a b -> a -> a
-  swapUri lens x =
-    let newUri = f (x ^. lens . L.uri)
-     in (lens . L.uri) .~ newUri $ x
+  swapUri lens = (lens . L.uri) %~ f
 
-  -- \| Transforms rootUri/rootPath.
+  -- Transforms rootUri/rootPath.
   transformInit :: InitializeParams -> InitializeParams
   transformInit x =
     let modifyRootPath p =

lsp-test/src/Language/LSP/Test/Session.hs

@@ -118,13 +118,13 @@ data SessionConfig = SessionConfig
   -- with a 'mylang' key whose value is the actual config for the server. You
   -- can also include other config sections if your server may request those.
   , ignoreLogNotifications :: Bool
-  -- ^ Whether or not to ignore @window/showMessage@ and @window/logMessage@ notifications 
+  -- ^ Whether or not to ignore @window/showMessage@ and @window/logMessage@ notifications
   -- from the server, defaults to True.
   , ignoreConfigurationRequests :: Bool
   -- ^ Whether or not to ignore @workspace/configuration@ requests from the server,
   -- defaults to True.
   , ignoreRegistrationRequests :: Bool
-  -- ^ Whether or not to ignore @client/registerCapability@ and @client/unregisterCapability@ 
+  -- ^ Whether or not to ignore @client/registerCapability@ and @client/unregisterCapability@
   -- requests from the server, defaults to True.
   , initialWorkspaceFolders :: Maybe [WorkspaceFolder]
   -- ^ The initial workspace folders to send in the @initialize@ request.
@@ -247,7 +247,7 @@ runSessionMonad context state (Session session) = runReaderT (runStateT conduit
       curId <- getCurTimeoutId
       case msg of
         ServerMessage sMsg -> yield sMsg
-        TimeoutMessage tId -> when (curId == tId) $ lastReceivedMessage <$> get >>= throw . Timeout
+        TimeoutMessage tId -> when (curId == tId) $ get >>= throw . Timeout . lastReceivedMessage
 
 -- | An internal version of 'runSession' that allows for a custom handler to listen to the server.
 -- It also does not automatically send initialize and exit messages.
@@ -338,7 +338,7 @@ updateStateC = awaitForever $ \msg -> do
       let requestedSections = mapMaybe (\i -> i ^? L.section . _Just) $ r ^. L.params . L.items
       let o = curLspConfig state
       -- check for each requested section whether we have it
-      let configsOrErrs = (flip fmap) requestedSections $ \section ->
+      let configsOrErrs = flip fmap requestedSections $ \section ->
             case o ^. at (fromString $ T.unpack section) of
               Just config -> Right config
               Nothing -> Left section
@@ -347,9 +347,9 @@ updateStateC = awaitForever $ \msg -> do
 
       -- we have to return exactly the number of sections requested, so if we can't find all of them then that's an error
       sendMessage $ TResponseMessage "2.0" (Just $ r ^. L.id) $
-        if null errs 
-        then (Right configs)
-        else Left $ ResponseError (InL LSPErrorCodes_RequestFailed) ("No configuration for requested sections: " <> (T.pack $ show errs)) Nothing
+        if null errs
+        then Right configs
+        else Left $ ResponseError (InL LSPErrorCodes_RequestFailed) ("No configuration for requested sections: " <> T.pack (show errs)) Nothing
     _ -> pure ()
   unless (
     (ignoringLogNotifications state && isLogNotification msg)
@@ -414,7 +414,7 @@ updateState (FromServerMess SMethod_WorkspaceApplyEdit r) = do
 
   -- First, prefer the versioned documentChanges field
   allChangeParams <- case r ^. L.params . L.edit . L.documentChanges of
-    Just (cs) -> do
+    Just cs -> do
       mapM_ (checkIfNeedsOpened . documentChangeUri) cs
       -- replace the user provided version numbers with the VFS ones + 1
       -- (technically we should check that the user versions match the VFS ones)
@@ -472,8 +472,8 @@ updateState (FromServerMess SMethod_WorkspaceApplyEdit r) = do
 
         -- TODO: move somewhere reusable
         editToChangeEvent :: TextEdit |? AnnotatedTextEdit -> TextDocumentContentChangeEvent
-        editToChangeEvent (InR e) = TextDocumentContentChangeEvent $ InL $ TextDocumentContentChangePartial { _range = (e ^. L.range) , _rangeLength = Nothing , _text = (e ^. L.newText) }
-        editToChangeEvent (InL e) = TextDocumentContentChangeEvent $ InL $ TextDocumentContentChangePartial { _range = (e ^. L.range) , _rangeLength = Nothing , _text = (e ^. L.newText) }
+        editToChangeEvent (InR e) = TextDocumentContentChangeEvent $ InL $ TextDocumentContentChangePartial { _range = e ^. L.range , _rangeLength = Nothing , _text = e ^. L.newText }
+        editToChangeEvent (InL e) = TextDocumentContentChangeEvent $ InL $ TextDocumentContentChangePartial { _range = e ^. L.range , _rangeLength = Nothing , _text = e ^. L.newText }
 
         getParamsFromDocumentChange :: DocumentChange -> Maybe DidChangeTextDocumentParams
         getParamsFromDocumentChange (InL textDocumentEdit) = getParamsFromTextDocumentEdit textDocumentEdit
@@ -491,11 +491,11 @@ updateState (FromServerMess SMethod_WorkspaceApplyEdit r) = do
 
         textDocumentEdits uri edits = do
           vers <- textDocumentVersions uri
-          pure $ map (\(v, e) -> TextDocumentEdit (review _versionedTextDocumentIdentifier v) [InL e]) $ zip vers edits
+          pure $ zipWith (\v e -> TextDocumentEdit (review _versionedTextDocumentIdentifier v) [InL e]) vers edits
 
         getChangeParams uri edits = do
           edits <- textDocumentEdits uri (reverse edits)
-          pure $ catMaybes $ map getParamsFromTextDocumentEdit edits
+          pure $ mapMaybe getParamsFromTextDocumentEdit edits
 
         mergeParams :: [DidChangeTextDocumentParams] -> DidChangeTextDocumentParams
         mergeParams params = let events = concat (toList (map (toList . (^. L.contentChanges)) params))

lsp-types/lsp-types.cabal

@@ -67,12 +67,10 @@ library
     , deepseq                        >=1.4   && <1.6
     , Diff                           >=0.4   && <0.6
     , dlist                          ^>=1.0
-    , exceptions                     ^>=0.10
     , hashable                       ^>=1.4
     , indexed-traversable            ^>=0.1
     , indexed-traversable-instances  ^>=0.1
     , lens                           >=5.1   && <5.3
-    , lens-aeson                     ^>=1.2
     , mod                            ^>=0.2
     , mtl                            >=2.2   && <2.4
     , network-uri                    ^>=2.6
@@ -92,6 +90,9 @@ library
   else
     build-depends: filepath >=1.4 && < 1.6
 
+  if impl(ghc >= 9.6)
+    build-depends: exceptions ^>=0.10
+
   ghc-options:
     -Wall -Wmissing-deriving-strategies
     -Wno-unticked-promoted-constructors
@@ -600,15 +601,13 @@ library lsp-types-quickcheck
     Language.LSP.Protocol.QuickCheck.Types
 
   build-depends:
-    , aeson             >=2
     , base              >=4.11    && <5
     , lsp-types
     , row-types
     , QuickCheck
     , quickcheck-instances
     , generic-arbitrary
     , template-haskell
-    , text              >=1       && <2.2
 
 executable generator
   hs-source-dirs:     generator
@@ -659,7 +658,6 @@ test-suite lsp-types-test
     , network-uri
     , QuickCheck
     , quickcheck-instances
-    , row-types
     , text
 
   build-tool-depends: hspec-discover:hspec-discover

lsp/lsp.cabal

@@ -68,7 +68,6 @@ library
     , mtl                   >=2.2    && <2.4
     , prettyprinter         ^>=1.7
     , random                ^>=1.2
-    , row-types             ^>=1.0
     , sorted-list           ^>=0.2.1
     , stm                   ^>=2.5
     , text                  >=1      && <2.2
@@ -129,7 +128,6 @@ test-suite lsp-test
     , containers
     , hspec
     , lsp
-    , row-types
     , sorted-list
     , text
     , text-rope

lsp/src/Language/LSP/Diagnostics.hs

@@ -50,7 +50,7 @@ type DiagnosticsBySource = Map.Map (Maybe Text) (SL.SortedList J.Diagnostic)
 -- ---------------------------------------------------------------------
 
 partitionBySource :: [J.Diagnostic] -> DiagnosticsBySource
-partitionBySource diags = Map.fromListWith mappend $ map (\d -> (J._source d, (SL.singleton d))) diags
+partitionBySource diags = Map.fromListWith mappend $ map (\d -> (J._source d, SL.singleton d)) diags
 
 -- ---------------------------------------------------------------------
 

lsp/src/Language/LSP/Server/Control.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module Language.LSP.Server.Control (
@@ -180,9 +179,9 @@ ioLoop ioLogger logger clientIn serverDefinition vfs sendMsg = do
           go (parse parser remainder)
 
   parser = do
-    try contentType <|> (return ())
+    try contentType <|> return ()
     len <- contentLength
-    try contentType <|> (return ())
+    try contentType <|> return ()
     _ <- string _ONE_CRLF
     Attoparsec.take len
 

lsp/src/Language/LSP/Server/Core.hs

@@ -22,7 +22,6 @@ import Colog.Core (
 import Control.Applicative
 import Control.Concurrent.Async
 import Control.Concurrent.Extra as C
-import Control.Concurrent.MVar
 import Control.Concurrent.STM
 import Control.Exception qualified as E
 import Control.Lens (at, (^.), (^?), _Just)
@@ -88,7 +87,7 @@ deriving instance (Show LspCoreLog)
 
 instance Pretty LspCoreLog where
   pretty (NewConfig config) = "LSP: set new config:" <+> prettyJSON config
-  pretty (ConfigurationNotSupported) = "LSP: not requesting configuration since the client does not support workspace/configuration"
+  pretty ConfigurationNotSupported = "LSP: not requesting configuration since the client does not support workspace/configuration"
   pretty (ConfigurationParseError settings err) =
     vsep
       [ "LSP: configuration parse error:"
@@ -97,7 +96,7 @@ instance Pretty LspCoreLog where
       , prettyJSON settings
       ]
   pretty (BadConfigurationResponse err) = "LSP: error when requesting configuration: " <+> pretty err
-  pretty (WrongConfigSections sections) = "LSP: expected only one configuration section, got: " <+> (prettyJSON $ J.toJSON sections)
+  pretty (WrongConfigSections sections) = "LSP: expected only one configuration section, got: " <+> prettyJSON (J.toJSON sections)
   pretty (CantRegister m) = "LSP: can't register dynamically for:" <+> pretty m
 
 newtype LspT config m a = LspT {unLspT :: ReaderT (LanguageContextEnv config) m a}
@@ -612,7 +611,7 @@ trySendRegistration logger method regOpts = do
 
       pure (Just $ RegistrationToken method regId)
     else do
-      logger <& (CantRegister SMethod_WorkspaceDidChangeConfiguration) `WithSeverity` Warning
+      logger <& CantRegister SMethod_WorkspaceDidChangeConfiguration `WithSeverity` Warning
       pure Nothing
 
 {- | Sends a @client/unregisterCapability@ request and removes the handler

lsp/src/Language/LSP/Server/Processing.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE GADTs #-}
-{-# LANGUAGE OverloadedLabels #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE RecursiveDo #-}
@@ -127,7 +126,7 @@ initializeRequestHandler logger ServerDefinition{..} vfs sendFunc req = do
         sendResp $ makeResponseError (req ^. L.id) err
         pure Nothing
       handleErr (Right a) = pure $ Just a
-  flip E.catch (initializeErrorHandler $ sendResp . makeResponseError (req ^. L.id)) $ handleErr <=< runExceptT $ mdo
+  E.handle (initializeErrorHandler $ sendResp . makeResponseError (req ^. L.id)) $ handleErr <=< runExceptT $ mdo
     let p = req ^. L.params
         rootDir =
           getFirst $
@@ -136,7 +135,7 @@ initializeRequestHandler logger ServerDefinition{..} vfs sendFunc req = do
               [ p ^? L.rootUri . _L >>= uriToFilePath
               , p ^? L.rootPath . _Just . _L <&> T.unpack
               ]
-        clientCaps = (p ^. L.capabilities)
+        clientCaps = p ^. L.capabilities
 
     let initialWfs = case p ^. L.workspaceFolders of
           Just (InL xs) -> xs
@@ -148,11 +147,11 @@ initializeRequestHandler logger ServerDefinition{..} vfs sendFunc req = do
     initialConfig <- case configObject of
       Just o -> case parseConfig defaultConfig o of
         Right newConfig -> do
-          liftIO $ logger <& (LspCore $ NewConfig o) `WithSeverity` Debug
+          liftIO $ logger <& LspCore (NewConfig o) `WithSeverity` Debug
           pure newConfig
         Left err -> do
           -- Warn not error here, since initializationOptions is pretty unspecified
-          liftIO $ logger <& (LspCore $ ConfigurationParseError o err) `WithSeverity` Warning
+          liftIO $ logger <& LspCore (ConfigurationParseError o err) `WithSeverity` Warning
           pure defaultConfig
       Nothing -> pure defaultConfig
 

lsp/test/VspSpec.hs

@@ -1,10 +1,8 @@
 {-# LANGUAGE DuplicateRecordFields #-}
-{-# LANGUAGE OverloadedLabels #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module VspSpec where
 
-import Data.Row
 import Data.String
 import Data.Text qualified as T
 import Data.Text.Utf16.Rope.Mixed qualified as Rope