mirror of
https://github.com/haskell/haskell-language-server.git
synced 2024-08-17 04:20:37 +03:00
Purge some more hslogger (#2770)
* Purge some more hslogger At this point we only really need it for `hie-bios`. * Add StrictData to Hlint plugin
This commit is contained in:
Michael Peyton Jones
GitHub
parent
8a90defeca
commit
388abc300e
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
5
plugins/hls-alternate-number-format-plugin/test/testdata/test/testdata/TIntDtoND.expected.hs
vendored
Normal file
5
plugins/hls-alternate-number-format-plugin/test/testdata/test/testdata/TIntDtoND.expected.hs
vendored
Normal file
@ -0,0 +1,5 @@
|
||||
{-# LANGUAGE NumDecimals #-}
|
||||
module TIntDtoND where
|
||||
|
||||
convertMe :: Integer
|
||||
convertMe = 125.345e3
|
||||
@ -62,6 +62,7 @@ library
|
||||
, hslogger
|
||||
, lens
|
||||
, lsp
|
||||
, refact
|
||||
, regex-tdfa
|
||||
, stm
|
||||
, temporary
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user