Skip to content

Add support for splice plugin with GHC 9.10 #4452

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Draft
wants to merge 3 commits into
base: master
Choose a base branch
from
+1,011 −62
Draft

Add support for splice plugin with GHC 9.10 #4452

Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
726a99a
enable (some test failures)
georgefst Nov 18, 2024
49bd868
accept golden outputs (wrong, but useful to inspect)
georgefst Nov 18, 2024
8271f7c
debugging stuff
georgefst Nov 18, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 1 addition & 2 deletions .github/workflows/test.yml
View file
Original file line number Diff line number Diff line change
@@ -155,8 +155,7 @@ jobs:
name: Test hls-eval-plugin
run: cabal test hls-eval-plugin-tests || cabal test hls-eval-plugin-tests

# TODO enable when it supports 9.10
- if: matrix.test && matrix.ghc != '9.10'
- if: matrix.test
name: Test hls-splice-plugin
run: cabal test hls-splice-plugin-tests || cabal test hls-splice-plugin-tests

822 changes: 822 additions & 0 deletions 9.10
View file

Large diffs are not rendered by default.

2 changes: 1 addition & 1 deletion docs/support/plugin-support.md
View file
Original file line number Diff line number Diff line change
@@ -67,4 +67,4 @@ For example, a plugin to provide a formatter which has itself been abandoned has
| `hls-floskell-plugin` | 3 | 9.10.1 |
| `hls-stan-plugin` | 3 | |
| `hls-retrie-plugin` | 3 | 9.10.1 |
| `hls-splice-plugin` | 3 | 9.10.1 |
| `hls-splice-plugin` | 3 | |
6 changes: 3 additions & 3 deletions haskell-language-server.cabal
View file
Original file line number Diff line number Diff line change
@@ -949,13 +949,13 @@ flag splice
manual: True

common splice
if flag(splice) && impl(ghc < 9.10)
if flag(splice)
build-depends: haskell-language-server:hls-splice-plugin
cpp-options: -Dhls_splice

library hls-splice-plugin
import: defaults, pedantic, warnings
if !(flag(splice) && impl(ghc < 9.10))
if !(flag(splice))
buildable: False
exposed-modules:
Ide.Plugin.Splice
@@ -984,7 +984,7 @@ library hls-splice-plugin

test-suite hls-splice-plugin-tests
import: defaults, pedantic, test-defaults, warnings
if !(flag(splice) && impl(ghc < 9.10))
if !(flag(splice))
buildable: False
type: exitcode-stdio-1.0
hs-source-dirs: plugins/hls-splice-plugin/test
133 changes: 127 additions & 6 deletions plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs
View file
Original file line number Diff line number Diff line change
@@ -9,6 +9,7 @@
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE BlockArguments #-}

module Ide.Plugin.Splice (descriptor) where

@@ -53,6 +54,14 @@
import qualified Language.LSP.Protocol.Lens as J
import Language.LSP.Protocol.Message
import Language.LSP.Protocol.Types
import Debug.Trace
import Development.IDE.GHC.Compat.Util (FastString, fsLit)
import GHC.Types.SrcLoc (BufPos (..), BufSpan (..))
import System.IO.Unsafe (unsafePerformIO)
import System.Process.Extra (readProcess)
import GHC (EpaLocation'(EpaSpan))

Check failure on line 62 in plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs

GitHub Actions / flags (9.8, ubuntu-latest) 

Module ‘GHC’ does not export ‘EpaLocation'’.

Check failure on line 62 in plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs

GitHub Actions / test (9.8, ubuntu-latest, true) 

Module ‘GHC’ does not export ‘EpaLocation'’.

Check failure on line 62 in plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs

GitHub Actions / test (9.6, macOS-latest, false) 

Module ‘GHC’ does not export ‘EpaLocation'’

Check failure on line 62 in plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs

GitHub Actions / test (9.6, windows-latest, true) 

Module ‘GHC’ does not export ‘EpaLocation'’

Check failure on line 62 in plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs

GitHub Actions / test (9.4, ubuntu-latest, true) 

Module ‘GHC’ does not export ‘EpaLocation'’

Check failure on line 62 in plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs

GitHub Actions / test (9.8, macOS-latest, false) 

Module ‘GHC’ does not export ‘EpaLocation'’.

Check failure on line 62 in plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs

GitHub Actions / test (9.4, macOS-latest, false) 

Module ‘GHC’ does not export ‘EpaLocation'’

Check failure on line 62 in plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs

GitHub Actions / test (9.4, windows-latest, true) 

Module ‘GHC’ does not export ‘EpaLocation'’

Check failure on line 62 in plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs

GitHub Actions / test (9.6, ubuntu-latest, true) 

Module ‘GHC’ does not export ‘EpaLocation'’

Check failure on line 62 in plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs

GitHub Actions / test (9.8, windows-latest, true) 

Module ‘GHC’ does not export ‘EpaLocation'’.
import Ide.PluginUtils (diffText, WithDeletions (..))
import Control.Monad

#if !MIN_VERSION_base(4,20,0)
import Data.Foldable (Foldable (foldl'))
@@ -133,7 +142,7 @@
let Splices {..} = tmrTopLevelSplices
let exprSuperSpans =
listToMaybe $ findSubSpansDesc srcSpan exprSplices
_patSuperSpans =
patSuperSpans =
listToMaybe $ findSubSpansDesc srcSpan patSplices
typeSuperSpans =
listToMaybe $ findSubSpansDesc srcSpan typeSplices
@@ -156,10 +165,72 @@
maybe (throwError $ PluginInternalError "No splice information found") (either (throwError . PluginInternalError . T.pack) pure) $
case spliceContext of
Expr -> graftSpliceWith exprSuperSpans
Pat ->

graftSpliceWith _patSuperSpans

-- Pat -> graftSpliceWith patSuperSpans
Pat -> patSuperSpans <&> \(_, expanded) ->
-- basically just the old code inlined and with some debug tracing added
let edit0 = do
let src = printA ps
(a', _, _) <- runTransformFromT 0 $ do
val'0 <- Development.IDE.GHC.ExactPrint.annotate dflags True $ maybeParensAST expanded
-- on 9.10, this becomes `UnhelpfulSpan UnhelpfulNoLocationInfo`
-- but seems a red herring - adding the old span manually makes no difference
-- let L (EpAnn _sp0 a0 cs0) x = val'0
-- let sp' = mkSrcSpan (mkSrcLoc (fsLit "RealSrcSpan SrcSpanPoint \"ghc-exactprint\" -1 0 Nothing") 1 1) ((mkSrcLoc (fsLit "unused") 1 6))
-- -- let sp'' = sp
-- let val'' =
-- traceShow (getLoc val'') $
-- traceShow (getLoc val'0) $
-- L (EpAnn (EpaSpan sp') a0 cs0) x

let val' = val'0
pure $
-- traceShow (printA expanded) $ -- same, but weird: `"\n\n\n\n\n \"str\""`
-- traceShow (printA $ maybeParensAST expanded) $
-- traceShow (printA val') $
everywhere'
( mkT \case
L src _ :: LocatedAn l ast | locA src `eqSrcSpan` dst ->
-- prints the same, but has different spans
-- traceShow (printA val') $ -- same old and new - " \"str\""
-- traceShow (locA src) $ -- same
-- traceShow (getLoc val') $
-- traceShow dst $ -- same except `Nothing` for `BufSpan`
val'
l -> l
)
ps
-- this differs - 9.10 version lacks the space
-- how does that happen? src spans are the same as for the expr replaced...
let res = printA a'
pure $
-- trace (renderWithContext defaultSDocContext $ ppr a') $
-- traceShow a' $
-- traceShow res $

-- trace (pShow $ showsMod a' "") $
traceFile traceFileName (pShowNoColor $ showsMod a' "") $

-- traceShow (src,res) $
-- same apart from `_newText = "f \"str\"= putStrLn \"is str\""`
-- where previously there was correctly an extra space
diffText clientCapabilities (verTxtDocId, T.pack src) (T.pack res) IncludeDeletions
edit = edit0
dst = (RealSrcSpan spliceSpan Nothing)
in
traceShow () $

Check failure on line 220 in plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs

GitHub Actions / Hlint check run 

Error in expandTHSplice in module Ide.Plugin.Splice: Avoid restricted function ▫︎ Found: "traceShow" ▫︎ Note: may break the code
-- same on both GHC versions - weird leading newlines but no whitespace at end
-- traceShow (printA expanded) $
-- traceShow (g dflags) $
-- traceShow spliceSpan $
traceShowId $

Check failure on line 225 in plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs

GitHub Actions / Hlint check run 

Error in expandTHSplice in module Ide.Plugin.Splice: Avoid restricted function ▫︎ Found: "traceShowId" ▫︎ Note: may break the code
edit
-- matchSplice _ (SplicePat _ spl) = Just spl
-- matchSplice _ _ = Nothing
-- expandSplice _ =
-- #if MIN_VERSION_ghc(9,5,0)
-- fmap (first (Left . unLoc . utsplice_result . snd )) .
-- #endif
-- rnSplicePat
HsType -> graftSpliceWith typeSuperSpans
HsDecl ->
declSuperSpans <&> \(_, expanded) ->
@@ -181,7 +252,7 @@
=<< MaybeT
(runAction "expandTHSplice.TypeCheck" ideState $ use TypeCheck fp)
)
<|> lift (runExceptT $ expandManually fp)
-- <|> lift (runExceptT $ expandManually fp)

case eedits of
Left err -> do
@@ -195,13 +266,63 @@
Nothing -> pure $ Right $ InR Null
Just (Left err) -> pure $ Left err
Just (Right edit) -> do
-- huh, edit unnecessarily goes all the way to end of line - why?
-- liftIO $ print edit
_ <- pluginSendRequest SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing edit) (\_ -> pure ())
pure $ Right $ InR Null

where
range = realSrcSpanToRange spliceSpan
srcSpan = RealSrcSpan spliceSpan Nothing

traceFileName :: [Char]
traceFileName =
#if MIN_VERSION_ghc(9,9,0)
"9.10"
#else
"9.8"
#endif

showsModSimple :: ParsedSource -> ShowS
showsModSimple = gshowsWith
(\(s :: SrcSpan) ->
-- ("george-src-span-placeholder" <>)
shows s
)
showsMod :: Data a => a -> ShowS
showsMod =
( \t ->
showChar '('
. (showString . showConstr . toConstr $ t)
. (foldr (.) id . gmapQ ((showChar ' ' .) . showsMod) $ t)
. showChar ')'
)
`extQ` (shows :: String -> ShowS)
`extQ` (\(s :: SrcSpan) -> shows s)
`extQ` (\(s :: FastString) -> shows s)

gshowsWith :: (Data a, Typeable b) => (b -> ShowS) -> a -> ShowS
gshowsWith f =
( \t ->
showChar '('
. (showString . showConstr . toConstr $ t)
. (foldr (.) id . gmapQ ((showChar ' ' .) . gshowsWith f) $ t)
. showChar ')'
)
`extQ` (shows :: String -> ShowS)
`extQ` f

pPrint :: (Show a) => a -> IO ()
pPrint = putStrLn <=< readProcess "pretty-simple" [] . show
{-# NOINLINE pShow #-}
pShow :: String -> String
pShow = unsafePerformIO . readProcess "pretty-simple" []

Check failure on line 319 in plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs

GitHub Actions / Hlint check run 

Error in pShow in module Ide.Plugin.Splice: Avoid restricted function ▫︎ Found: "unsafePerformIO" ▫︎ Note: may break the code
{-# NOINLINE pShowNoColor #-}
pShowNoColor :: String -> String
pShowNoColor = unsafePerformIO . readProcess "pretty-simple" ["-cno-color"]

Check failure on line 322 in plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs

GitHub Actions / Hlint check run 

Error in pShowNoColor in module Ide.Plugin.Splice: Avoid restricted function ▫︎ Found: "unsafePerformIO" ▫︎ Note: may break the code
{-# NOINLINE traceFile #-}
traceFile :: String -> String -> a -> a
traceFile fp s x = unsafePerformIO $ writeFile fp s >> pure x

Check failure on line 325 in plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs

GitHub Actions / Hlint check run 

Error in traceFile in module Ide.Plugin.Splice: Avoid restricted function ▫︎ Found: "unsafePerformIO" ▫︎ Note: may break the code

setupHscEnv
:: IdeState
79 changes: 40 additions & 39 deletions plugins/hls-splice-plugin/test/Main.hs
View file
Original file line number Diff line number Diff line change
@@ -23,45 +23,46 @@ splicePlugin = mkPluginTestDescriptor' Splice.descriptor "splice"

tests :: TestTree
tests = testGroup "splice"
[ goldenTest "TSimpleExp" Inplace 6 15
, goldenTest "TSimpleExp" Inplace 6 24
, goldenTest "TTypeAppExp" Inplace 7 5
, goldenTest "TErrorExp" Inplace 6 15
, goldenTest "TErrorExp" Inplace 6 51
, goldenTest "TQQExp" Inplace 6 17
, goldenTest "TQQExp" Inplace 6 25
, goldenTest "TQQExpError" Inplace 6 13
, goldenTest "TQQExpError" Inplace 6 22
, testGroup "Pattern Splices"
[ goldenTest "TSimplePat" Inplace 6 3
, goldenTest "TSimplePat" Inplace 6 22
, goldenTest "TSimplePat" Inplace 6 3
, goldenTest "TSimplePat" Inplace 6 22
, goldenTest "TErrorPat" Inplace 6 3
, goldenTest "TErrorPat" Inplace 6 18
, goldenTest "TQQPat" Inplace 6 3
, goldenTest "TQQPat" Inplace 6 11
, goldenTest "TQQPatError" Inplace 6 3
, goldenTest "TQQPatError" Inplace 6 11
]
, goldenTest "TSimpleType" Inplace 5 12
, goldenTest "TSimpleType" Inplace 5 22
, goldenTest "TTypeTypeError" Inplace 7 12
, goldenTest "TTypeTypeError" Inplace 7 52
, goldenTest "TQQType" Inplace 8 19
, goldenTest "TQQType" Inplace 8 28
, goldenTest "TQQTypeTypeError" Inplace 8 19
, goldenTest "TQQTypeTypeError" Inplace 8 28
, goldenTest "TSimpleDecl" Inplace 8 1
, goldenTest "TQQDecl" Inplace 5 1
, goldenTestWithEdit "TTypeKindError" (
if ghcVersion >= GHC96 then
"96-expected"
else
"expected"
) Inplace 7 9
, goldenTestWithEdit "TDeclKindError" "expected" Inplace 8 1
]
[goldenTest "TQQPat" Inplace 6 11] -- a useful simple test to focus on
-- [ goldenTest "TSimpleExp" Inplace 6 15
-- , goldenTest "TSimpleExp" Inplace 6 24
-- , goldenTest "TTypeAppExp" Inplace 7 5
-- , goldenTest "TErrorExp" Inplace 6 15
-- , goldenTest "TErrorExp" Inplace 6 51
-- , goldenTest "TQQExp" Inplace 6 17
-- , goldenTest "TQQExp" Inplace 6 25
-- , goldenTest "TQQExpError" Inplace 6 13
-- , goldenTest "TQQExpError" Inplace 6 22
-- , testGroup "Pattern Splices"
-- [ goldenTest "TSimplePat" Inplace 6 3
-- , goldenTest "TSimplePat" Inplace 6 22
-- , goldenTest "TSimplePat" Inplace 6 3
-- , goldenTest "TSimplePat" Inplace 6 22
-- , goldenTest "TErrorPat" Inplace 6 3
-- , goldenTest "TErrorPat" Inplace 6 18
-- , goldenTest "TQQPat" Inplace 6 3
-- , goldenTest "TQQPat" Inplace 6 11
-- , goldenTest "TQQPatError" Inplace 6 3
-- , goldenTest "TQQPatError" Inplace 6 11
-- ]
-- , goldenTest "TSimpleType" Inplace 5 12
-- , goldenTest "TSimpleType" Inplace 5 22
-- , goldenTest "TTypeTypeError" Inplace 7 12
-- , goldenTest "TTypeTypeError" Inplace 7 52
-- , goldenTest "TQQType" Inplace 8 19
-- , goldenTest "TQQType" Inplace 8 28
-- , goldenTest "TQQTypeTypeError" Inplace 8 19
-- , goldenTest "TQQTypeTypeError" Inplace 8 28
-- , goldenTest "TSimpleDecl" Inplace 8 1
-- , goldenTest "TQQDecl" Inplace 5 1
-- , goldenTestWithEdit "TTypeKindError" (
-- if ghcVersion >= GHC96 then
-- "96-expected"
-- else
-- "expected"
-- ) Inplace 7 9
-- , goldenTestWithEdit "TDeclKindError" "expected" Inplace 8 1
-- ]

goldenTest :: FilePath -> ExpandStyle -> Int -> Int -> TestTree
goldenTest fp tc line col =
2 changes: 1 addition & 1 deletion plugins/hls-splice-plugin/test/testdata/TErrorExp.expected.hs
View file
Original file line number Diff line number Diff line change
@@ -3,4 +3,4 @@ module TErrorExp where
import Language.Haskell.TH ( tupE, litE, integerL )

main :: IO ()
main = return (42, ())
main = return 42, ())
7 changes: 6 additions & 1 deletion plugins/hls-splice-plugin/test/testdata/TErrorPat.expected.hs
View file
Original file line number Diff line number Diff line change
@@ -3,4 +3,9 @@ module TErrorPat where
import Language.Haskell.TH ( conP )

f :: () -> ()
f True = x
f True




= x
1 change: 0 additions & 1 deletion plugins/hls-splice-plugin/test/testdata/TQQDecl.expected.hs
View file
Original file line number Diff line number Diff line change
@@ -1,6 +1,5 @@
{-# LANGUAGE QuasiQuotes #-}
module TQQDecl where
import QQ (str)

foo :: String
foo = "foo"
2 changes: 1 addition & 1 deletion plugins/hls-splice-plugin/test/testdata/TQQPat.expected.hs
View file
Original file line number Diff line number Diff line change
@@ -3,5 +3,5 @@ module TQQPat where
import QQ

f :: String -> IO ()
f "str" = putStrLn "is str"
f "str"= putStrLn "is str"
f _ = putStrLn " not str"
2 changes: 1 addition & 1 deletion plugins/hls-splice-plugin/test/testdata/TQQPatError.expected.hs
View file
Original file line number Diff line number Diff line change
@@ -3,5 +3,5 @@ module TQQPatError where
import QQ

f :: () -> IO ()
f "str" = putStrLn "is str"
f "str"= putStrLn "is str"
f _ = putStrLn " not str"
3 changes: 0 additions & 3 deletions plugins/hls-splice-plugin/test/testdata/TSimpleDecl.expected.hs
View file
Original file line number Diff line number Diff line change
@@ -2,9 +2,6 @@
{-# LANGUAGE QuasiQuotes #-}
module TSimpleDecl where
import Language.Haskell.TH ( mkName, clause, normalB, funD, sigD )

-- Foo
-- Bar
foo :: Int
foo = 42
-- Bar
7 changes: 6 additions & 1 deletion plugins/hls-splice-plugin/test/testdata/TSimplePat.expected.hs
View file
Original file line number Diff line number Diff line change
@@ -3,4 +3,9 @@ module TSimplePat where
import Language.Haskell.TH ( varP, mkName )

f :: x -> x
f x = x
f x




= x
2 changes: 1 addition & 1 deletion plugins/hls-splice-plugin/test/testdata/TSimpleType.expected.hs
View file
Original file line number Diff line number Diff line change
@@ -2,5 +2,5 @@
module TSimpleType where
import Language.Haskell.TH ( tupleT )

main :: IO ()
main :: IO )
main = return ()
2 changes: 1 addition & 1 deletion plugins/hls-splice-plugin/test/testdata/TTypeTypeError.expected.hs
View file
Original file line number Diff line number Diff line change
@@ -4,5 +4,5 @@ module TTypeTypeError where
import Language.Haskell.TH ( appT, numTyLit, litT, conT )
import Data.Proxy ( Proxy )

main :: IO (Proxy 42)
main :: IO Proxy 42)
main = return ()

Unchanged files with check annotations Beta

View file
exe/Wrapper.hs
{-# LANGUAGE CPP #-}

Check warning on line 1 in exe/Wrapper.hs

GitHub Actions / Hlint check run 

Warning in module Main: Use module export list ▫︎ Found: "module Main where" ▫︎ Perhaps: "module Main (\n module Main\n ) where" ▫︎ Note: an explicit list is usually better
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
View file
ghcide/session-loader/Development/IDE/Session.hs
[] -> error $ "GHC version could not be parsed: " <> version
((runTime, _):_)
| compileTime == runTime -> do
atomicModifyIORef' cradle_files (\xs -> (cfp:xs,()))

Check warning on line 636 in ghcide/session-loader/Development/IDE/Session.hs

GitHub Actions / Hlint check run 

Warning in loadSessionWithOptions in module Development.IDE.Session: Use atomicModifyIORef'_ ▫︎ Found: "atomicModifyIORef' cradle_files (\\ xs -> (cfp : xs, ()))" ▫︎ Perhaps: "atomicModifyIORef'_ cradle_files ((:) cfp)"
session (hieYaml, toNormalizedFilePath' cfp, opts, libDir)
| otherwise -> return (([renderPackageSetupException cfp GhcVersionMismatch{..}], Nothing),[])
-- Failure case, either a cradle error or the none cradle
x <- bagToList $ mapBag errMsgDiagnostic $ unionManyBags $ map Compat.getMessages closure_errs
DriverHomePackagesNotClosed us <- pure x
pure us
isBad ci = (homeUnitId_ (componentDynFlags ci)) `OS.member` bad_units

Check warning on line 884 in ghcide/session-loader/Development/IDE/Session.hs

GitHub Actions / Hlint check run 

Suggestion in newComponentCache in module Development.IDE.Session: Redundant bracket ▫︎ Found: "(homeUnitId_ (componentDynFlags ci)) `OS.member` bad_units" ▫︎ Perhaps: "homeUnitId_ (componentDynFlags ci) `OS.member` bad_units"
-- Whenever we spin up a session on Linux, dynamically load libm.so.6
-- in. We need this in case the binary is statically linked, in which
-- case the interactive session will fail when trying to load
View file
ghcide/session-loader/Development/IDE/Session/Diagnostics.hs
{-# LANGUAGE DeriveAnyClass #-}

Check warning on line 1 in ghcide/session-loader/Development/IDE/Session/Diagnostics.hs

GitHub Actions / Hlint check run 

Warning in module Development.IDE.Session.Diagnostics: Use module export list ▫︎ Found: "module Development.IDE.Session.Diagnostics where" ▫︎ Perhaps: "module Development.IDE.Session.Diagnostics (\n module Development.IDE.Session.Diagnostics\n ) where" ▫︎ Note: an explicit list is usually better
module Development.IDE.Session.Diagnostics where
import Control.Applicative
surround start s end = do
guard (listToMaybe s == Just start)
guard (listToMaybe (reverse s) == Just end)
pure $ drop 1 $ take (length s - 1) s

Check warning on line 87 in ghcide/session-loader/Development/IDE/Session/Diagnostics.hs

GitHub Actions / Hlint check run 

Warning in parseMultiCradleErr in module Development.IDE.Session.Diagnostics: Use drop1 ▫︎ Found: "drop 1" ▫︎ Perhaps: "drop1"
multiCradleErrMessage :: MultiCradleErr -> [String]
multiCradleErrMessage e =
View file
ghcide/src/Development/IDE/Core/Compile.hs
import Data.Time (UTCTime (..))
import Data.Tuple.Extra (dupe)
import Debug.Trace
import Development.IDE.Core.FileStore (resetInterfaceStore)

Check warning on line 72 in ghcide/src/Development/IDE/Core/Compile.hs

GitHub Actions / Hlint check run 

Warning in module Development.IDE.Core.Compile: Use fewer imports ▫︎ Found: "import Development.IDE.Core.FileStore ( resetInterfaceStore )\nimport Development.IDE.Core.FileStore ( shareFilePath )\n" ▫︎ Perhaps: "import Development.IDE.Core.FileStore\n ( resetInterfaceStore, shareFilePath )\n"
import Development.IDE.Core.Preprocessor
import Development.IDE.Core.ProgressReporting (progressUpdate)
import Development.IDE.Core.RuleTypes
convImport (L _ i) = (
(ideclPkgQual i)

Check warning on line 960 in ghcide/src/Development/IDE/Core/Compile.hs

GitHub Actions / Hlint check run 

Suggestion in getModSummaryFromImports in module Development.IDE.Core.Compile: Redundant bracket ▫︎ Found: "((ideclPkgQual i), reLoc $ ideclName i)" ▫︎ Perhaps: "(ideclPkgQual i, reLoc $ ideclName i)"
, reLoc $ ideclName i)
msrImports = implicit_imports ++ imps
View file
ghcide/src/Development/IDE/Core/Rules.hs
{ source_version = ver
, old_value = m_old
, get_file_version = use GetModificationTime_{missingFileDiagnostics = False}
, get_linkable_hashes = \fs -> map (snd . fromJust . hirCoreFp) <$> uses_ GetModIface fs

Check warning on line 794 in ghcide/src/Development/IDE/Core/Rules.hs

GitHub Actions / Hlint check run 

Suggestion in getModIfaceFromDiskRule in module Development.IDE.Core.Rules: Use fmap ▫︎ Found: "\\ fs -> map (snd . fromJust . hirCoreFp) <$> uses_ GetModIface fs" ▫︎ Perhaps: "fmap (map (snd . fromJust . hirCoreFp)) . uses_ GetModIface"
, regenerate = regenerateHiFile session f ms
}
r <- loadInterface (hscEnv session) ms linkableType recompInfo
-- thus bump its modification time, forcing this rule to be rerun every time.
exists <- liftIO $ doesFileExist obj_file
mobj_time <- liftIO $
if exists

Check warning on line 1067 in ghcide/src/Development/IDE/Core/Rules.hs

GitHub Actions / Hlint check run 

Warning in getLinkableRule in module Development.IDE.Core.Rules: Use whenMaybe ▫︎ Found: "if exists then Just <$> getModTime obj_file else pure Nothing" ▫︎ Perhaps: "whenMaybe exists (getModTime obj_file)"
then Just <$> getModTime obj_file
else pure Nothing
case mobj_time of
View file
ghcide/src/Development/IDE/GHC/Compat/Core.hs
moduleUnit, toUnitId)
import qualified GHC.Unit.Module as Module
import GHC.Unit.State (ModuleOrigin (..))
import GHC.Utils.Error (Severity (..), emptyMessages)

Check warning on line 482 in ghcide/src/Development/IDE/GHC/Compat/Core.hs

GitHub Actions / Hlint check run 

Warning in module Development.IDE.GHC.Compat.Core: Use fewer imports ▫︎ Found: "import GHC.Utils.Error ( Severity(..), emptyMessages )\nimport GHC.Utils.Error ( mkPlainErrorMsgEnvelope )\n" ▫︎ Perhaps: "import GHC.Utils.Error\n ( Severity(..), emptyMessages, mkPlainErrorMsgEnvelope )\n"
import GHC.Utils.Panic hiding (try)
import qualified GHC.Utils.Panic.Plain as Plain
View file
ghcide-bench/src/Experiments.hs
examplesPath = "bench/example"
defConfig :: Config
Success defConfig = execParserPure defaultPrefs (info configP fullDesc) []

Check warning on line 345 in ghcide-bench/src/Experiments.hs

GitHub Actions / test (9.6, macOS-latest, false) 

Pattern match(es) are non-exhaustive

Check warning on line 345 in ghcide-bench/src/Experiments.hs

GitHub Actions / test (9.6, windows-latest, true) 

Pattern match(es) are non-exhaustive

Check warning on line 345 in ghcide-bench/src/Experiments.hs

GitHub Actions / test (9.6, ubuntu-latest, true) 

Pattern match(es) are non-exhaustive
quiet, verbose :: Config -> Bool
verbose = (== All) . verbosity
results <- forM benchmarks $ \b@Bench{name} -> do
let p = (proc (ghcide ?config) (allArgs name dir))
{ std_in = CreatePipe, std_out = CreatePipe, std_err = CreatePipe }
run sess = withCreateProcess p $ \(Just inH) (Just outH) (Just errH) pH -> do

Check warning on line 453 in ghcide-bench/src/Experiments.hs

GitHub Actions / test (9.6, macOS-latest, false) 

Pattern match(es) are non-exhaustive

Check warning on line 453 in ghcide-bench/src/Experiments.hs

GitHub Actions / test (9.6, windows-latest, true) 

Pattern match(es) are non-exhaustive

Check warning on line 453 in ghcide-bench/src/Experiments.hs

GitHub Actions / test (9.6, ubuntu-latest, true) 

Pattern match(es) are non-exhaustive
-- Need to continuously consume to stderr else it gets blocked
-- Can't pass NoStream either to std_err
hSetBuffering errH NoBuffering