Skip to content

Commit 388abc3

Browse files
michaelpjmichaelpj
authored
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
1 parent 8a90def commit 388abc3

File tree

8 files changed

+49
-74
lines changed

8 files changed

+49
-74
lines changed

‎ghcide/exe/Main.hs

+2-2
Original file line numberDiff line numberDiff line change
@@ -99,15 +99,15 @@ main = withTelemetryLogger $ \telemetryLogger -> do
9999
liftIO $ (cb1 <> cb2) env
100100
}
101101

102-
let docWithFilteredPriorityRecorder@Recorder{ logger_ } =
102+
let docWithFilteredPriorityRecorder =
103103
(docWithPriorityRecorder & cfilter (\WithPriority{ priority } -> priority >= minPriority)) <>
104104
(lspLogRecorder & cmapWithPrio (renderStrict . layoutPretty defaultLayoutOptions)
105105
& cfilter (\WithPriority{ priority } -> priority >= minPriority)) <>
106106
(lspMessageRecorder & cmapWithPrio (renderStrict . layoutPretty defaultLayoutOptions)
107107
& cfilter (\WithPriority{ priority } -> priority >= Error))
108108

109109
-- exists so old-style logging works. intended to be phased out
110-
let logger = Logger $ \p m -> logger_ (WithPriority p emptyCallStack (pretty m))
110+
let logger = Logger $ \p m -> Logger.logger_ docWithFilteredPriorityRecorder (WithPriority p emptyCallStack (pretty m))
111111

112112
let recorder = docWithFilteredPriorityRecorder
113113
& cmapWithPrio pretty

‎haskell-language-server.cabal

-2
Original file line numberDiff line numberDiff line change
@@ -77,7 +77,6 @@ library
7777
, hie-bios
7878
, hiedb
7979
, hls-plugin-api ^>=1.3
80-
, hslogger
8180
, optparse-applicative
8281
, optparse-simple
8382
, process
@@ -410,7 +409,6 @@ executable haskell-language-server
410409
, hiedb
411410
, lens
412411
, regex-tdfa
413-
, hslogger
414412
, optparse-applicative
415413
, hls-plugin-api
416414
, lens

‎hls-plugin-api/hls-plugin-api.cabal

-2
Original file line numberDiff line numberDiff line change
@@ -26,7 +26,6 @@ source-repository head
2626

2727
library
2828
exposed-modules:
29-
Ide.Logger
3029
Ide.Plugin.Config
3130
Ide.Plugin.ConfigUtils
3231
Ide.Plugin.Properties
@@ -47,7 +46,6 @@ library
4746
, ghc
4847
, hashable
4948
, hls-graph ^>= 1.6
50-
, hslogger
5149
, lens
5250
, lens-aeson
5351
, lsp >=1.4.0.0 && < 1.6

‎hls-plugin-api/src/Ide/Logger.hs

-29
This file was deleted.

‎plugins/hls-alternate-number-format-plugin/test/testdata/test/testdata/TIntDtoND.expected.hs

+5
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,5 @@
1+
{-# LANGUAGE NumDecimals #-}
2+
module TIntDtoND where
3+
4+
convertMe :: Integer
5+
convertMe = 125.345e3

‎plugins/hls-hlint-plugin/hls-hlint-plugin.cabal

+1
Original file line numberDiff line numberDiff line change
@@ -62,6 +62,7 @@ library
6262
, hslogger
6363
, lens
6464
, lsp
65+
, refact
6566
, regex-tdfa
6667
, stm
6768
, temporary

‎plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs

+33-26
Original file line numberDiff line numberDiff line change
@@ -12,11 +12,13 @@
1212
{-# LANGUAGE TupleSections #-}
1313
{-# LANGUAGE TypeFamilies #-}
1414
{-# LANGUAGE ViewPatterns #-}
15-
{-# OPTIONS_GHC -Wno-orphans #-}
1615
{-# LANGUAGE LambdaCase #-}
1716
{-# LANGUAGE MultiWayIf #-}
1817
{-# LANGUAGE NamedFieldPuns #-}
1918
{-# LANGUAGE RecordWildCards #-}
19+
{-# LANGUAGE StrictData #-}
20+
21+
{-# OPTIONS_GHC -Wno-orphans #-}
2022

2123
#ifdef HLINT_ON_GHC_LIB
2224
#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
5557
usePropertyAction)
5658
import Development.IDE.Core.Shake (getDiagnostics)
5759
import qualified Refact.Apply as Refact
60+
import qualified Refact.Types as Refact
5861

5962
#ifdef HLINT_ON_GHC_LIB
6063
import Development.IDE.GHC.Compat (BufSpan,
@@ -84,7 +87,7 @@ import System.IO (IOMode (Wri
8487
import System.IO.Temp
8588
#else
8689
import Development.IDE.GHC.Compat hiding
87-
(setEnv)
90+
(setEnv, (<+>))
8891
import GHC.Generics (Associativity (LeftAssociative, NotAssociative, RightAssociative))
8992
import Language.Haskell.GHC.ExactPrint.Delta (deltaOptions)
9093
import Language.Haskell.GHC.ExactPrint.Parsers (postParseTransform)
@@ -93,7 +96,6 @@ import Language.Haskell.GhclibParserEx.Fixity as GhclibPar
9396
import qualified Refact.Fixity as Refact
9497
#endif
9598

96-
import Ide.Logger
9799
import Ide.Plugin.Config hiding
98100
(Config)
99101
import Ide.Plugin.Properties
@@ -125,13 +127,21 @@ import System.Environment (setEnv,
125127
import Text.Regex.TDFA.Text ()
126128
-- ---------------------------------------------------------------------
127129

128-
newtype Log
130+
data Log
129131
= LogShake Shake.Log
132+
| LogApplying NormalizedFilePath (Either String WorkspaceEdit)
133+
| LogGeneratedIdeas NormalizedFilePath [[Refact.Refactoring Refact.SrcSpan]]
134+
| LogGetIdeas NormalizedFilePath
135+
| LogUsingExtensions NormalizedFilePath [String] -- Extension is only imported conditionally, so we just stringify them
130136
deriving Show
131137

132138
instance Pretty Log where
133139
pretty = \case
134140
LogShake log -> pretty log
141+
LogApplying fp res -> "Applying hint(s) for" <+> viaShow fp <> ":" <+> viaShow res
142+
LogGeneratedIdeas fp ideas -> "Generated hlint ideas for for" <+> viaShow fp <> ":" <+> viaShow ideas
143+
LogUsingExtensions fp exts -> "Using extensions for " <+> viaShow fp <> ":" <+> pretty exts
144+
LogGetIdeas fp -> "Getting hlint ideas for " <+> viaShow fp
135145

136146
#ifdef HLINT_ON_GHC_LIB
137147
-- 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
148158
descriptor recorder plId = (defaultPluginDescriptor plId)
149159
{ pluginRules = rules recorder plId
150160
, pluginCommands =
151-
[ PluginCommand "applyOne" "Apply a single hint" applyOneCmd
152-
, PluginCommand "applyAll" "Apply all hints to the file" applyAllCmd
161+
[ PluginCommand "applyOne" "Apply a single hint" (applyOneCmd recorder)
162+
, PluginCommand "applyAll" "Apply all hints to the file" (applyAllCmd recorder)
153163
]
154164
, pluginHandlers = mkPluginHandler STextDocumentCodeAction codeActionProvider
155165
, pluginConfigDescriptor = defaultConfigDescriptor
@@ -179,7 +189,7 @@ rules recorder plugin = do
179189
define (cmapWithPrio LogShake recorder) $ \GetHlintDiagnostics file -> do
180190
config <- getClientConfigAction def
181191
let hlintOn = pluginEnabledConfig plcDiagnosticsOn plugin config
182-
ideas <- if hlintOn then getIdeas file else return (Right [])
192+
ideas <- if hlintOn then getIdeas recorder file else return (Right [])
183193
return (diagnostics file ideas, Just ())
184194

185195
defineNoFile (cmapWithPrio LogShake recorder) $ \GetHlintSettings -> do
@@ -247,9 +257,9 @@ rules recorder plugin = do
247257
}
248258
srcSpanToRange (UnhelpfulSpan _) = noRange
249259

250-
getIdeas :: NormalizedFilePath -> Action (Either ParseError [Idea])
251-
getIdeas nfp = do
252-
debugm $ "hlint:getIdeas:file:" ++ show nfp
260+
getIdeas :: Recorder (WithPriority Log) -> NormalizedFilePath -> Action (Either ParseError [Idea])
261+
getIdeas recorder nfp = do
262+
logWith recorder Debug $ LogGetIdeas nfp
253263
(flags, classify, hint) <- useNoFile_ GetHlintSettings
254264

255265
let applyHints' (Just (Right modEx)) = Right $ applyHints classify hint [modEx]
@@ -295,7 +305,7 @@ getIdeas nfp = do
295305

296306
setExtensions flags = do
297307
hlintExts <- getExtensions nfp
298-
debugm $ "hlint:getIdeas:setExtensions:" ++ show hlintExts
308+
logWith recorder Debug $ LogUsingExtensions nfp (fmap show hlintExts)
299309
return $ flags { enabledExtensions = hlintExts }
300310

301311
-- Gets extensions from ModSummary dynflags for the file.
@@ -469,15 +479,14 @@ mkSuppressHintTextEdits dynFlags fileContents hint =
469479
combinedTextEdit : lineSplitTextEditList
470480
-- ---------------------------------------------------------------------
471481

472-
applyAllCmd :: CommandFunction IdeState Uri
473-
applyAllCmd ide uri = do
482+
applyAllCmd :: Recorder (WithPriority Log) -> CommandFunction IdeState Uri
483+
applyAllCmd recorder ide uri = do
474484
let file = maybe (error $ show uri ++ " is not a file.")
475485
toNormalizedFilePath'
476486
(uriToFilePath' uri)
477487
withIndefiniteProgress "Applying all hints" Cancellable $ do
478-
logm $ "hlint:applyAllCmd:file=" ++ show file
479-
res <- liftIO $ applyHint ide file Nothing
480-
logm $ "hlint:applyAllCmd:res=" ++ show res
488+
res <- liftIO $ applyHint recorder ide file Nothing
489+
logWith recorder Debug $ LogApplying file res
481490
case res of
482491
Left err -> pure $ Left (responseError (T.pack $ "hlint:applyAll: " ++ show err))
483492
Right fs -> do
@@ -500,34 +509,33 @@ data OneHint = OneHint
500509
, oneHintTitle :: HintTitle
501510
} deriving (Eq, Show)
502511

503-
applyOneCmd :: CommandFunction IdeState ApplyOneParams
504-
applyOneCmd ide (AOP uri pos title) = do
512+
applyOneCmd :: Recorder (WithPriority Log) -> CommandFunction IdeState ApplyOneParams
513+
applyOneCmd recorder ide (AOP uri pos title) = do
505514
let oneHint = OneHint pos title
506515
let file = maybe (error $ show uri ++ " is not a file.") toNormalizedFilePath'
507516
(uriToFilePath' uri)
508517
let progTitle = "Applying hint: " <> title
509518
withIndefiniteProgress progTitle Cancellable $ do
510-
logm $ "hlint:applyOneCmd:file=" ++ show file
511-
res <- liftIO $ applyHint ide file (Just oneHint)
512-
logm $ "hlint:applyOneCmd:res=" ++ show res
519+
res <- liftIO $ applyHint recorder ide file (Just oneHint)
520+
logWith recorder Debug $ LogApplying file res
513521
case res of
514522
Left err -> pure $ Left (responseError (T.pack $ "hlint:applyOne: " ++ show err))
515523
Right fs -> do
516524
_ <- sendRequest SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing fs) (\_ -> pure ())
517525
pure $ Right Null
518526

519-
applyHint :: IdeState -> NormalizedFilePath -> Maybe OneHint -> IO (Either String WorkspaceEdit)
520-
applyHint ide nfp mhint =
527+
applyHint :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> Maybe OneHint -> IO (Either String WorkspaceEdit)
528+
applyHint recorder ide nfp mhint =
521529
runExceptT $ do
522530
let runAction' :: Action a -> IO a
523531
runAction' = runAction "applyHint" ide
524532
let errorHandlers = [ Handler $ \e -> return (Left (show (e :: IOException)))
525533
, Handler $ \e -> return (Left (show (e :: ErrorCall)))
526534
]
527-
ideas <- bimapExceptT showParseError id $ ExceptT $ runAction' $ getIdeas nfp
535+
ideas <- bimapExceptT showParseError id $ ExceptT $ runAction' $ getIdeas recorder nfp
528536
let ideas' = maybe ideas (`filterIdeas` ideas) mhint
529537
let commands = map ideaRefactoring ideas'
530-
liftIO $ logm $ "applyHint:apply=" ++ show commands
538+
logWith recorder Debug $ LogGeneratedIdeas nfp commands
531539
let fp = fromNormalizedFilePath nfp
532540
(_, mbOldContent) <- liftIO $ runAction' $ getFileContents nfp
533541
oldContent <- maybe (liftIO $ fmap T.decodeUtf8 (BS.readFile fp)) return mbOldContent
@@ -584,7 +592,6 @@ applyHint ide nfp mhint =
584592
Right appliedFile -> do
585593
let uri = fromNormalizedUri (filePathToUri' nfp)
586594
let wsEdit = diffText' True (uri, oldContent) (T.pack appliedFile) IncludeDeletions
587-
liftIO $ logm $ "hlint:applyHint:diff=" ++ show wsEdit
588595
ExceptT $ return (Right wsEdit)
589596
Left err ->
590597
throwE err

‎src/Ide/Main.hs

+8-13
Original file line numberDiff line numberDiff line change
@@ -25,10 +25,10 @@ import qualified Development.IDE.Main as IDEMain
2525
import qualified Development.IDE.Session as Session
2626
import Development.IDE.Types.Logger as G
2727
import qualified Development.IDE.Types.Options as Ghcide
28+
import GHC.Stack (emptyCallStack)
2829
import qualified HIE.Bios.Environment as HieBios
2930
import HIE.Bios.Types
3031
import Ide.Arguments
31-
import Ide.Logger
3232
import Ide.Plugin.ConfigUtils (pluginsToDefaultConfig,
3333
pluginsToVSCodeExtensionSchema)
3434
import Ide.Types (IdePlugins, PluginId (PluginId),
@@ -43,6 +43,7 @@ data Log
4343
| LogDirectory !FilePath
4444
| LogLspStart !GhcideArguments ![PluginId]
4545
| LogIDEMain IDEMain.Log
46+
| LogOther T.Text
4647
deriving Show
4748

4849
instance Pretty Log where
@@ -56,6 +57,7 @@ instance Pretty Log where
5657
, viaShow ghcideArgs
5758
, "PluginIds:" <+> pretty (coerce @_ @[Text] pluginIds) ]
5859
LogIDEMain iDEMainLog -> pretty iDEMainLog
60+
LogOther t -> pretty t
5961

6062
defaultMain :: Recorder (WithPriority Log) -> Arguments -> IdePlugins IdeState -> IO ()
6163
defaultMain recorder args idePlugins = do
@@ -108,16 +110,6 @@ defaultMain recorder args idePlugins = do
108110

109111
-- ---------------------------------------------------------------------
110112

111-
hlsLogger :: G.Logger
112-
hlsLogger = G.Logger $ \pri txt ->
113-
case pri of
114-
G.Debug -> debugm (T.unpack txt)
115-
G.Info -> logm (T.unpack txt)
116-
G.Warning -> warningm (T.unpack txt)
117-
G.Error -> errorm (T.unpack txt)
118-
119-
-- ---------------------------------------------------------------------
120-
121113
runLspMode :: Recorder (WithPriority Log) -> GhcideArguments -> IdePlugins IdeState -> IO ()
122114
runLspMode recorder ghcideArgs@GhcideArguments{..} idePlugins = withTelemetryLogger $ \telemetryLogger -> do
123115
let log = logWith recorder
@@ -128,10 +120,13 @@ runLspMode recorder ghcideArgs@GhcideArguments{..} idePlugins = withTelemetryLog
128120
when (isLSP argsCommand) $ do
129121
log Info $ LogLspStart ghcideArgs (map fst $ ipMap idePlugins)
130122

131-
IDEMain.defaultMain (cmapWithPrio LogIDEMain recorder) (IDEMain.defaultArguments (cmapWithPrio LogIDEMain recorder) hlsLogger)
123+
-- exists so old-style logging works. intended to be phased out
124+
let logger = Logger $ \p m -> logger_ recorder (WithPriority p emptyCallStack $ LogOther m)
125+
126+
IDEMain.defaultMain (cmapWithPrio LogIDEMain recorder) (IDEMain.defaultArguments (cmapWithPrio LogIDEMain recorder) logger)
132127
{ IDEMain.argCommand = argsCommand
133128
, IDEMain.argsHlsPlugins = idePlugins
134-
, IDEMain.argsLogger = pure hlsLogger <> pure telemetryLogger
129+
, IDEMain.argsLogger = pure logger <> pure telemetryLogger
135130
, IDEMain.argsThreads = if argsThreads == 0 then Nothing else Just $ fromIntegral argsThreads
136131
, IDEMain.argsIdeOptions = \_config sessionLoader ->
137132
let defOptions = Ghcide.defaultIdeOptions sessionLoader

0 commit comments

Comments
 (0)