diff --git a/ghcide/exe/Main.hs b/ghcide/exe/Main.hs
index d20bf4f0cf..6e7f169ad5 100644
--- a/ghcide/exe/Main.hs
+++ b/ghcide/exe/Main.hs
@@ -99,7 +99,7 @@ main = withTelemetryLogger $ \telemetryLogger -> do
liftIO $ (cb1 <> cb2) env
}
- let docWithFilteredPriorityRecorder@Recorder{ logger_ } =
+ let docWithFilteredPriorityRecorder =
(docWithPriorityRecorder & cfilter (\WithPriority{ priority } -> priority >= minPriority)) <>
(lspLogRecorder & cmapWithPrio (renderStrict . layoutPretty defaultLayoutOptions)
& cfilter (\WithPriority{ priority } -> priority >= minPriority)) <>
@@ -107,7 +107,7 @@ main = withTelemetryLogger $ \telemetryLogger -> do
& cfilter (\WithPriority{ priority } -> priority >= Error))
-- exists so old-style logging works. intended to be phased out
- let logger = Logger $ \p m -> logger_ (WithPriority p emptyCallStack (pretty m))
+ let logger = Logger $ \p m -> Logger.logger_ docWithFilteredPriorityRecorder (WithPriority p emptyCallStack (pretty m))
let recorder = docWithFilteredPriorityRecorder
& cmapWithPrio pretty
diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal
index 2ee0036ad8..23b67b1ee1 100644
--- a/haskell-language-server.cabal
+++ b/haskell-language-server.cabal
@@ -77,7 +77,6 @@ library
, hie-bios
, hiedb
, hls-plugin-api ^>=1.3
- , hslogger
, optparse-applicative
, optparse-simple
, process
@@ -410,7 +409,6 @@ executable haskell-language-server
, hiedb
, lens
, regex-tdfa
- , hslogger
, optparse-applicative
, hls-plugin-api
, lens
diff --git a/hls-plugin-api/hls-plugin-api.cabal b/hls-plugin-api/hls-plugin-api.cabal
index 4017a4b2c9..9a9c4bede4 100644
--- a/hls-plugin-api/hls-plugin-api.cabal
+++ b/hls-plugin-api/hls-plugin-api.cabal
@@ -26,7 +26,6 @@ source-repository head
library
exposed-modules:
- Ide.Logger
Ide.Plugin.Config
Ide.Plugin.ConfigUtils
Ide.Plugin.Properties
@@ -47,7 +46,6 @@ library
, ghc
, hashable
, hls-graph ^>= 1.6
- , hslogger
, lens
, lens-aeson
, lsp >=1.4.0.0 && < 1.6
diff --git a/hls-plugin-api/src/Ide/Logger.hs b/hls-plugin-api/src/Ide/Logger.hs
deleted file mode 100644
index 1f960d8688..0000000000
--- a/hls-plugin-api/src/Ide/Logger.hs
+++ /dev/null
@@ -1,29 +0,0 @@
-{- | Provides an implementation of the ghcide @Logger@ which uses
- @System.Log.Logger@ under the hood.
--}
-module Ide.Logger
- (
- logm
- , debugm
- , warningm
- , errorm
- ) where
-
-import Control.Monad.IO.Class
-import System.Log.Logger
-
--- ---------------------------------------------------------------------
-
-logm :: MonadIO m => String -> m ()
-logm s = liftIO $ infoM "hls" s
-
-debugm :: MonadIO m => String -> m ()
-debugm s = liftIO $ debugM "hls" s
-
-warningm :: MonadIO m => String -> m ()
-warningm s = liftIO $ warningM "hls" s
-
-errorm :: MonadIO m => String -> m ()
-errorm s = liftIO $ errorM "hls" s
-
--- ---------------------------------------------------------------------
diff --git a/plugins/hls-alternate-number-format-plugin/test/testdata/test/testdata/TIntDtoND.expected.hs b/plugins/hls-alternate-number-format-plugin/test/testdata/test/testdata/TIntDtoND.expected.hs
new file mode 100644
index 0000000000..b9624b6418
--- /dev/null
+++ b/plugins/hls-alternate-number-format-plugin/test/testdata/test/testdata/TIntDtoND.expected.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE NumDecimals #-}
+module TIntDtoND where
+
+convertMe :: Integer
+convertMe = 125.345e3
diff --git a/plugins/hls-hlint-plugin/hls-hlint-plugin.cabal b/plugins/hls-hlint-plugin/hls-hlint-plugin.cabal
index 8f7f496b3b..efc1e9dc17 100644
--- a/plugins/hls-hlint-plugin/hls-hlint-plugin.cabal
+++ b/plugins/hls-hlint-plugin/hls-hlint-plugin.cabal
@@ -62,6 +62,7 @@ library
, hslogger
, lens
, lsp
+ , refact
, regex-tdfa
, stm
, temporary
diff --git a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs
index a5ba0b9c2e..2f1cd7dd6d 100644
--- a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs
+++ b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs
@@ -12,11 +12,13 @@
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
-{-# OPTIONS_GHC -Wno-orphans #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE StrictData #-}
+
+{-# OPTIONS_GHC -Wno-orphans #-}
#ifdef HLINT_ON_GHC_LIB
#define MIN_GHC_API_VERSION(x,y,z) MIN_VERSION_ghc_lib(x,y,z)
@@ -55,6 +57,7 @@ import Development.IDE.Core.Rules (defineNoFil
usePropertyAction)
import Development.IDE.Core.Shake (getDiagnostics)
import qualified Refact.Apply as Refact
+import qualified Refact.Types as Refact
#ifdef HLINT_ON_GHC_LIB
import Development.IDE.GHC.Compat (BufSpan,
@@ -84,7 +87,7 @@ import System.IO (IOMode (Wri
import System.IO.Temp
#else
import Development.IDE.GHC.Compat hiding
- (setEnv)
+ (setEnv, (<+>))
import GHC.Generics (Associativity (LeftAssociative, NotAssociative, RightAssociative))
import Language.Haskell.GHC.ExactPrint.Delta (deltaOptions)
import Language.Haskell.GHC.ExactPrint.Parsers (postParseTransform)
@@ -93,7 +96,6 @@ import Language.Haskell.GhclibParserEx.Fixity as GhclibPar
import qualified Refact.Fixity as Refact
#endif
-import Ide.Logger
import Ide.Plugin.Config hiding
(Config)
import Ide.Plugin.Properties
@@ -125,13 +127,21 @@ import System.Environment (setEnv,
import Text.Regex.TDFA.Text ()
-- ---------------------------------------------------------------------
-newtype Log
+data Log
= LogShake Shake.Log
+ | LogApplying NormalizedFilePath (Either String WorkspaceEdit)
+ | LogGeneratedIdeas NormalizedFilePath [[Refact.Refactoring Refact.SrcSpan]]
+ | LogGetIdeas NormalizedFilePath
+ | LogUsingExtensions NormalizedFilePath [String] -- Extension is only imported conditionally, so we just stringify them
deriving Show
instance Pretty Log where
pretty = \case
LogShake log -> pretty log
+ LogApplying fp res -> "Applying hint(s) for" <+> viaShow fp <> ":" <+> viaShow res
+ LogGeneratedIdeas fp ideas -> "Generated hlint ideas for for" <+> viaShow fp <> ":" <+> viaShow ideas
+ LogUsingExtensions fp exts -> "Using extensions for " <+> viaShow fp <> ":" <+> pretty exts
+ LogGetIdeas fp -> "Getting hlint ideas for " <+> viaShow fp
#ifdef HLINT_ON_GHC_LIB
-- Reimplementing this, since the one in Development.IDE.GHC.Compat isn't for ghc-lib
@@ -148,8 +158,8 @@ descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeSta
descriptor recorder plId = (defaultPluginDescriptor plId)
{ pluginRules = rules recorder plId
, pluginCommands =
- [ PluginCommand "applyOne" "Apply a single hint" applyOneCmd
- , PluginCommand "applyAll" "Apply all hints to the file" applyAllCmd
+ [ PluginCommand "applyOne" "Apply a single hint" (applyOneCmd recorder)
+ , PluginCommand "applyAll" "Apply all hints to the file" (applyAllCmd recorder)
]
, pluginHandlers = mkPluginHandler STextDocumentCodeAction codeActionProvider
, pluginConfigDescriptor = defaultConfigDescriptor
@@ -179,7 +189,7 @@ rules recorder plugin = do
define (cmapWithPrio LogShake recorder) $ \GetHlintDiagnostics file -> do
config <- getClientConfigAction def
let hlintOn = pluginEnabledConfig plcDiagnosticsOn plugin config
- ideas <- if hlintOn then getIdeas file else return (Right [])
+ ideas <- if hlintOn then getIdeas recorder file else return (Right [])
return (diagnostics file ideas, Just ())
defineNoFile (cmapWithPrio LogShake recorder) $ \GetHlintSettings -> do
@@ -247,9 +257,9 @@ rules recorder plugin = do
}
srcSpanToRange (UnhelpfulSpan _) = noRange
-getIdeas :: NormalizedFilePath -> Action (Either ParseError [Idea])
-getIdeas nfp = do
- debugm $ "hlint:getIdeas:file:" ++ show nfp
+getIdeas :: Recorder (WithPriority Log) -> NormalizedFilePath -> Action (Either ParseError [Idea])
+getIdeas recorder nfp = do
+ logWith recorder Debug $ LogGetIdeas nfp
(flags, classify, hint) <- useNoFile_ GetHlintSettings
let applyHints' (Just (Right modEx)) = Right $ applyHints classify hint [modEx]
@@ -295,7 +305,7 @@ getIdeas nfp = do
setExtensions flags = do
hlintExts <- getExtensions nfp
- debugm $ "hlint:getIdeas:setExtensions:" ++ show hlintExts
+ logWith recorder Debug $ LogUsingExtensions nfp (fmap show hlintExts)
return $ flags { enabledExtensions = hlintExts }
-- Gets extensions from ModSummary dynflags for the file.
@@ -469,15 +479,14 @@ mkSuppressHintTextEdits dynFlags fileContents hint =
combinedTextEdit : lineSplitTextEditList
-- ---------------------------------------------------------------------
-applyAllCmd :: CommandFunction IdeState Uri
-applyAllCmd ide uri = do
+applyAllCmd :: Recorder (WithPriority Log) -> CommandFunction IdeState Uri
+applyAllCmd recorder ide uri = do
let file = maybe (error $ show uri ++ " is not a file.")
toNormalizedFilePath'
(uriToFilePath' uri)
withIndefiniteProgress "Applying all hints" Cancellable $ do
- logm $ "hlint:applyAllCmd:file=" ++ show file
- res <- liftIO $ applyHint ide file Nothing
- logm $ "hlint:applyAllCmd:res=" ++ show res
+ res <- liftIO $ applyHint recorder ide file Nothing
+ logWith recorder Debug $ LogApplying file res
case res of
Left err -> pure $ Left (responseError (T.pack $ "hlint:applyAll: " ++ show err))
Right fs -> do
@@ -500,34 +509,33 @@ data OneHint = OneHint
, oneHintTitle :: HintTitle
} deriving (Eq, Show)
-applyOneCmd :: CommandFunction IdeState ApplyOneParams
-applyOneCmd ide (AOP uri pos title) = do
+applyOneCmd :: Recorder (WithPriority Log) -> CommandFunction IdeState ApplyOneParams
+applyOneCmd recorder ide (AOP uri pos title) = do
let oneHint = OneHint pos title
let file = maybe (error $ show uri ++ " is not a file.") toNormalizedFilePath'
(uriToFilePath' uri)
let progTitle = "Applying hint: " <> title
withIndefiniteProgress progTitle Cancellable $ do
- logm $ "hlint:applyOneCmd:file=" ++ show file
- res <- liftIO $ applyHint ide file (Just oneHint)
- logm $ "hlint:applyOneCmd:res=" ++ show res
+ res <- liftIO $ applyHint recorder ide file (Just oneHint)
+ logWith recorder Debug $ LogApplying file res
case res of
Left err -> pure $ Left (responseError (T.pack $ "hlint:applyOne: " ++ show err))
Right fs -> do
_ <- sendRequest SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing fs) (\_ -> pure ())
pure $ Right Null
-applyHint :: IdeState -> NormalizedFilePath -> Maybe OneHint -> IO (Either String WorkspaceEdit)
-applyHint ide nfp mhint =
+applyHint :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> Maybe OneHint -> IO (Either String WorkspaceEdit)
+applyHint recorder ide nfp mhint =
runExceptT $ do
let runAction' :: Action a -> IO a
runAction' = runAction "applyHint" ide
let errorHandlers = [ Handler $ \e -> return (Left (show (e :: IOException)))
, Handler $ \e -> return (Left (show (e :: ErrorCall)))
]
- ideas <- bimapExceptT showParseError id $ ExceptT $ runAction' $ getIdeas nfp
+ ideas <- bimapExceptT showParseError id $ ExceptT $ runAction' $ getIdeas recorder nfp
let ideas' = maybe ideas (`filterIdeas` ideas) mhint
let commands = map ideaRefactoring ideas'
- liftIO $ logm $ "applyHint:apply=" ++ show commands
+ logWith recorder Debug $ LogGeneratedIdeas nfp commands
let fp = fromNormalizedFilePath nfp
(_, mbOldContent) <- liftIO $ runAction' $ getFileContents nfp
oldContent <- maybe (liftIO $ fmap T.decodeUtf8 (BS.readFile fp)) return mbOldContent
@@ -584,7 +592,6 @@ applyHint ide nfp mhint =
Right appliedFile -> do
let uri = fromNormalizedUri (filePathToUri' nfp)
let wsEdit = diffText' True (uri, oldContent) (T.pack appliedFile) IncludeDeletions
- liftIO $ logm $ "hlint:applyHint:diff=" ++ show wsEdit
ExceptT $ return (Right wsEdit)
Left err ->
throwE err
diff --git a/src/Ide/Main.hs b/src/Ide/Main.hs
index ff7752a4d8..d8d1df432f 100644
--- a/src/Ide/Main.hs
+++ b/src/Ide/Main.hs
@@ -25,10 +25,10 @@ import qualified Development.IDE.Main as IDEMain
import qualified Development.IDE.Session as Session
import Development.IDE.Types.Logger as G
import qualified Development.IDE.Types.Options as Ghcide
+import GHC.Stack (emptyCallStack)
import qualified HIE.Bios.Environment as HieBios
import HIE.Bios.Types
import Ide.Arguments
-import Ide.Logger
import Ide.Plugin.ConfigUtils (pluginsToDefaultConfig,
pluginsToVSCodeExtensionSchema)
import Ide.Types (IdePlugins, PluginId (PluginId),
@@ -43,6 +43,7 @@ data Log
| LogDirectory !FilePath
| LogLspStart !GhcideArguments ![PluginId]
| LogIDEMain IDEMain.Log
+ | LogOther T.Text
deriving Show
instance Pretty Log where
@@ -56,6 +57,7 @@ instance Pretty Log where
, viaShow ghcideArgs
, "PluginIds:" <+> pretty (coerce @_ @[Text] pluginIds) ]
LogIDEMain iDEMainLog -> pretty iDEMainLog
+ LogOther t -> pretty t
defaultMain :: Recorder (WithPriority Log) -> Arguments -> IdePlugins IdeState -> IO ()
defaultMain recorder args idePlugins = do
@@ -108,16 +110,6 @@ defaultMain recorder args idePlugins = do
-- ---------------------------------------------------------------------
-hlsLogger :: G.Logger
-hlsLogger = G.Logger $ \pri txt ->
- case pri of
- G.Debug -> debugm (T.unpack txt)
- G.Info -> logm (T.unpack txt)
- G.Warning -> warningm (T.unpack txt)
- G.Error -> errorm (T.unpack txt)
-
--- ---------------------------------------------------------------------
-
runLspMode :: Recorder (WithPriority Log) -> GhcideArguments -> IdePlugins IdeState -> IO ()
runLspMode recorder ghcideArgs@GhcideArguments{..} idePlugins = withTelemetryLogger $ \telemetryLogger -> do
let log = logWith recorder
@@ -128,10 +120,13 @@ runLspMode recorder ghcideArgs@GhcideArguments{..} idePlugins = withTelemetryLog
when (isLSP argsCommand) $ do
log Info $ LogLspStart ghcideArgs (map fst $ ipMap idePlugins)
- IDEMain.defaultMain (cmapWithPrio LogIDEMain recorder) (IDEMain.defaultArguments (cmapWithPrio LogIDEMain recorder) hlsLogger)
+ -- exists so old-style logging works. intended to be phased out
+ let logger = Logger $ \p m -> logger_ recorder (WithPriority p emptyCallStack $ LogOther m)
+
+ IDEMain.defaultMain (cmapWithPrio LogIDEMain recorder) (IDEMain.defaultArguments (cmapWithPrio LogIDEMain recorder) logger)
{ IDEMain.argCommand = argsCommand
, IDEMain.argsHlsPlugins = idePlugins
- , IDEMain.argsLogger = pure hlsLogger <> pure telemetryLogger
+ , IDEMain.argsLogger = pure logger <> pure telemetryLogger
, IDEMain.argsThreads = if argsThreads == 0 then Nothing else Just $ fromIntegral argsThreads
, IDEMain.argsIdeOptions = \_config sessionLoader ->
let defOptions = Ghcide.defaultIdeOptions sessionLoader