Fix ghc and hlint warnings (#568)

* Fix ghc and hlint warnings

* exceptions needed with ghc 9.6+

* Small improvements

* Add -Wunused-packages, consolidate warning configs, fix few more warnings

* fourmolu

cabal.project

@@ -15,7 +15,7 @@ package lsp
 
 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/bench/SimpleBench.hs

@@ -1,7 +1,6 @@
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RankNTypes #-}
 
 module Main where
 

lsp-test/example/Test.hs

@@ -6,6 +6,7 @@ import Language.LSP.Protocol.Message
 import Language.LSP.Protocol.Types
 import Language.LSP.Test
 
+main :: IO ()
 main = runSession "lsp-demo-reactor-server" fullCaps "test/data/" $ do
   doc <- openDoc "Rename.hs" "haskell"
 

lsp-test/func-test/FuncTest.hs

@@ -15,14 +15,12 @@ import Control.Monad.IO.Class
 import Data.Aeson qualified as J
 import Data.Maybe
 import Data.Proxy
-import Data.Set qualified as Set
 import Language.LSP.Protocol.Lens qualified as L
 import Language.LSP.Protocol.Message
 import Language.LSP.Protocol.Types
 import Language.LSP.Server
 import Language.LSP.Test qualified as Test
 import System.Exit
-import System.IO
 import System.Process
 import Test.Hspec
 import UnliftIO

lsp-test/lsp-test.cabal

@@ -31,7 +31,11 @@ source-repository head
   type:     git
   location: https://github.com/haskell/lsp
 
+common warnings
+  ghc-options: -Wunused-packages
+
 library
+  import:             warnings
   hs-source-dirs:     src
   default-language:   GHC2021
   exposed-modules:    Language.LSP.Test
@@ -66,7 +70,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
@@ -90,6 +93,7 @@ library
   ghc-options:        -W
 
 test-suite tests
+  import:             warnings
   type:               exitcode-stdio-1.0
   hs-source-dirs:     test
   main-is:            Test.hs
@@ -115,6 +119,7 @@ test-suite tests
     , unliftio
 
 test-suite func-test
+  import:             warnings
   type:               exitcode-stdio-1.0
   hs-source-dirs:     func-test
   default-language:   GHC2021
@@ -123,7 +128,6 @@ test-suite func-test
     , base
     , aeson
     , co-log-core
-    , containers
     , hspec
     , lens
     , lsp
@@ -133,6 +137,7 @@ test-suite func-test
     , unliftio
 
 test-suite example
+  import:             warnings
   type:               exitcode-stdio-1.0
   hs-source-dirs:     example
   default-language:   GHC2021
@@ -145,11 +150,12 @@ test-suite example
   build-tool-depends: lsp:lsp-demo-reactor-server
 
 benchmark simple-bench
+  import:             warnings
   type:               exitcode-stdio-1.0
   hs-source-dirs:     bench
   default-language:   GHC2021
   main-is:            SimpleBench.hs
-  ghc-options:        -Wall -O2 -eventlog -rtsopts
+  ghc-options:        -Wall -O2 -rtsopts
   build-depends:
     , base
     , extra

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

@@ -1,8 +1,8 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TypeInType #-}
 
 {- |
 Module      : Language.LSP.Test
@@ -559,7 +559,7 @@ createDoc file languageId contents = do
   let pred :: SomeRegistration -> [TRegistration Method_WorkspaceDidChangeWatchedFiles]
       pred (SomeRegistration r@(TRegistration _ SMethod_WorkspaceDidChangeWatchedFiles _)) = [r]
       pred _ = mempty
-      regs = concatMap pred $ Map.elems dynCaps
+      regs = concatMap pred dynCaps
       watchHits :: FileSystemWatcher -> Bool
       watchHits (FileSystemWatcher (GlobPattern (InL (Pattern pattern))) kind) =
         -- If WatchKind is excluded, defaults to all true as per spec
@@ -740,7 +740,7 @@ getCodeActionContext doc = do
  Note that this does not wait for more to come in.
 -}
 getCurrentDiagnostics :: TextDocumentIdentifier -> Session [Diagnostic]
-getCurrentDiagnostics doc = fromMaybe [] . Map.lookup (toNormalizedUri $ doc ^. L.uri) . curDiagnostics <$> get
+getCurrentDiagnostics doc = Map.findWithDefault [] (toNormalizedUri $ doc ^. L.uri) . curDiagnostics <$> get
 
 -- | Returns the tokens of all progress sessions that have started but not yet ended.
 getIncompleteProgressSessions :: Session (Set.Set ProgressToken)

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

@@ -1,6 +1,6 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TypeInType #-}
 
 module Language.LSP.Test.Decoding where
 
@@ -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

@@ -1,6 +1,6 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TypeInType #-}
 
 module Language.LSP.Test.Files (
   swapFiles,
@@ -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/Parsing.hs

@@ -1,7 +1,7 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TypeInType #-}
 
 module Language.LSP.Test.Parsing (
   -- $receiving

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

@@ -5,7 +5,7 @@
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE OverloadedLabels #-}
-{-# LANGUAGE TypeInType #-}
+{-# LANGUAGE DataKinds #-}
 
 module Language.LSP.Test.Session
   ( Session(..)
@@ -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-test/test/DummyServer.hs

@@ -1,6 +1,6 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TypeInType #-}
 
 module DummyServer where
 

lsp-test/test/Test.hs

@@ -1,7 +1,7 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TypeInType #-}
 
 import Control.Applicative.Combinators
 import Control.Concurrent

lsp-types/generator/CodeGen.hs

@@ -367,7 +367,7 @@ printStruct tn s@Structure{name, documentation, since, proposed, deprecated} = d
   optionalMatcherName <- entityName "Language.LSP.Protocol.Types.Common" ".:!?"
   let toJsonD =
         let (unzip -> (args, pairEs)) = flip fmap (zip props [0 ..]) $ \(Property{name, optional}, i) ->
-              let n :: T.Text = "arg" <> (T.pack $ show i)
+              let n :: T.Text = "arg" <> T.pack (show i)
                   pairE = case optional of
                     Just True -> dquotes (pretty name) <+> pretty optionalPairerName <+> pretty n
                     _ -> brackets (dquotes (pretty name) <+> "Aeson..=" <+> pretty n)
@@ -485,7 +485,7 @@ printEnum tn Enumeration{name, type_, values, supportsCustomValues, documentatio
   let customCon =
         let cn = makeConstrName (Just enumName) "Custom"
          in if custom then Just (cn, pretty cn <+> ty) else Nothing
-  let cons = normalCons ++ (fmap snd $ maybeToList customCon)
+  let cons = normalCons ++ (snd <$> maybeToList customCon)
 
   ensureImport "Data.Aeson" (QualAs "Aeson")
   ensureImport "Data.Row.Aeson" (QualAs "Aeson")