Work in progress

Author: sol

.github/workflows/build.yml

@@ -25,7 +25,6 @@ jobs:
         os:
           - ubuntu-latest
         ghc:
-          - '9.4'
           - '9.6'
           - '9.8'
           - '9.10'

package.yaml

@@ -22,7 +22,7 @@ default-extensions:
   - DerivingVia
 
 dependencies:
-  - base >= 4.11 && < 5
+  - base >= 4.18 && < 5
   - pretty
   - process
   - fsnotify == 0.4.*

sensei.cabal

@@ -19,7 +19,7 @@ module GHC.Diagnostic (
 
 import           Imports hiding (stripPrefix)
 import           Builder (Builder, Color(..))
-import qualified Builder as Builder
+import qualified Builder
 
 import           System.IO
 import           Data.Text (stripPrefix, stripSuffix)
@@ -39,10 +39,10 @@ formatAnnotated annotated = Builder.toText $
   fromString (format annotated.diagnostic) <> formatSolutions annotated.solutions
 
 formatSolutions :: [Solution] -> Builder
-formatSolutions = Builder.unlines . map formatNumbered . zip [1..]
+formatSolutions = Builder.unlines . zipWith formatNumbered [1..]
   where
-    formatNumbered :: (Int, Solution) -> Builder
-    formatNumbered (n, solution) = formatNumber n <> formatSolution solution
+    formatNumbered :: Int -> Solution -> Builder
+    formatNumbered n solution = formatNumber n <> formatSolution solution
 
     formatNumber :: Int -> Builder
     formatNumber n = Builder.withColor Cyan $ "    " <> "[" <> Builder.show n <> "] "

src/GHC/Diagnostic.hs

@@ -8,7 +8,7 @@ import GHC.Diagnostic.Annotated
 import GHC.Diagnostic.Util
 
 spec :: Spec
-spec = focus do
+spec = do
   describe "joinMessageLines" do
     context "when a line starts with whitespace" do
       it "joins that line with the previous line" do

test/GHC/Diagnostic/UtilSpec.hs

@@ -2,7 +2,6 @@
 {-# LANGUAGE QuasiQuotes #-}
 module GHC.DiagnosticSpec (spec) where
 
-import Data.ByteString qualified as B
 import           Helper hiding (diagnostic)
 import           Test.Hspec.Expectations.Contrib qualified as Hspec
 import           Text.RawString.QQ (r, rQ)
@@ -11,11 +10,12 @@ import           System.Process
 import           System.Environment
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
+import           Data.ByteString qualified as B
+import qualified Data.Map as Map
 
 import           Language.Haskell.GhciWrapper (lookupGhc)
 import           GHC.Diagnostic
 import           GHC.Diagnostic.Annotated
-import qualified Data.Map as Map
 
 data Requirement = NoRequirement | RequireGhc912
 
@@ -33,15 +33,8 @@ _ignore = let _ = (ftest, xtest) in ()
 normalizeGhcVersion :: String -> String
 normalizeGhcVersion = T.unpack . T.replace __GLASGOW_HASKELL_FULL_VERSION__ "9.10.0" . T.pack
 
-availableImports :: AvailableImports
-availableImports = Map.fromList [
-    ("c2w", ["Data.ByteString.Internal"])
-  , ("fromList", ["Data.Map"])
-  ]
-
-
 testWith :: HasCallStack => FilePath -> Requirement -> [String] -> String -> Maybe Annotation -> [Solution] -> Spec
-testWith name requirement extraArgs (unindent -> code) action solutions = it name $ do
+testWith name requirement extraArgs (unindent -> code) annotation solutions = it name do
   unless (T.null code) do
     ensureFile src $ T.encodeUtf8 code
   err <- translate <$> ghc ["-fno-diagnostics-show-caret"]
@@ -50,9 +43,9 @@ testWith name requirement extraArgs (unindent -> code) action solutions = it nam
   ensureFile (dir </> "err.json") (encodeUtf8 $ normalizeGhcVersion json)
   Hspec.annotate (separator <> err <> separator) do
     Just annotated <- return . parseAnnotated availableImports $ encodeUtf8 json
-    when shouldRun $ do
+    when shouldRun do
       format annotated.diagnostic `shouldBe` err
-    annotated.annotation `shouldBe` action
+    annotated.annotation `shouldBe` annotation
     annotated.solutions `shouldBe` solutions
   where
     separator :: String
@@ -90,6 +83,12 @@ testWith name requirement extraArgs (unindent -> code) action solutions = it nam
         True
 #endif
 
+availableImports :: AvailableImports
+availableImports = Map.fromList [
+    ("c2w", ["Data.ByteString.Internal"])
+  , ("fromList", ["Data.Map"])
+  ]
+
 unindent :: String -> Text
 unindent (T.pack >>> T.dropWhileEnd isSpace >>> T.lines -> input) = go input
   where
@@ -102,58 +101,38 @@ unindent (T.pack >>> T.dropWhileEnd isSpace >>> T.lines -> input) = go input
     dropEmptyLines :: [Text] -> [Text]
     dropEmptyLines = filter (not . T.all isSpace)
 
-variableNotInScope :: RequiredVariable -> Maybe Annotation
-variableNotInScope name = Just $ NotInScope name
-
 redundantImport :: Maybe Annotation
 redundantImport = Just RedundantImport
 
-suggestImport :: Module -> Text -> Solution
-suggestImport module_ name = ImportName module_ Unqualified name
+notInScope :: RequiredVariable -> Maybe Annotation
+notInScope = Just . NotInScope
+
+importName :: Module -> Text -> Solution
+importName module_ = ImportName module_ Unqualified
 
 spec :: Spec
 spec = do
-  describe "format" $ do
+  describe "format" do
     test "not-in-scope" [] [r|
       module Foo where
       foo = c2w
-      |] (variableNotInScope "c2w") [suggestImport "Data.ByteString.Internal" "c2w"]
-
-    test "not-in-scope-type-signature" [] [r|
-      module Foo where
-      foo :: String -> String -> String -> String -> String -> String -> String
-      foo = c2w
-      |] (variableNotInScope $ RequiredVariable Unqualified "c2w" $ Just "String -> String -> String -> String -> String -> String -> String") [suggestImport "Data.ByteString.Internal" "c2w"]
-
-    test "not-in-scope-qualified" [] [r|
-      module Foo where
-      foo = B.c2w
-      |] (variableNotInScope $ RequiredVariable "B" "c2w" Nothing) [ImportName "Data.ByteString.Internal" (Qualified "B") "c2w"]
-
-    test "not-in-scope-qualified-2" [] [r|
-      module Foo where
-      import Data.List.NonEmpty qualified as Ma
-      foo = Map.fromList
-      |] (variableNotInScope $ RequiredVariable "Map" "fromList" Nothing) [
-          UseName "Ma.fromList"
-        , ImportName "Data.Map" (Qualified "Map") "fromList"
-        ]
+      |] (notInScope "c2w") [importName "Data.ByteString.Internal" "c2w"]
 
     test "not-in-scope-perhaps-use" [] [r|
       module Foo where
       foo = filter_
-      |] (variableNotInScope "filter_") [UseName "filter"]
+      |] (notInScope "filter_") [UseName "filter"]
 
     test "not-in-scope-perhaps-use-one-of-these" [] [r|
       module Foo where
       foo = fold
-      |] (variableNotInScope "fold") [UseName "foldl", UseName "foldr"]
+      |] (notInScope "fold") [UseName "foldl", UseName "foldr"]
 
     test "not-in-scope-perhaps-use-multiline" [] [r|
       module Foo where
       import Data.List
       foo = fold
-      |] (variableNotInScope "fold") [UseName "foldl", UseName "foldr"]
+      |] (notInScope "fold") [UseName "foldl", UseName "foldr"]
 
     test "use-BlockArguments" [] [r|
       {-# LANGUAGE NoBlockArguments #-}
@@ -194,28 +173,29 @@ spec = do
       foo = "foo" + 23
       |] Nothing []
 
-  describe "extractIdentifiers" $ do
-    it "extracts identifiers" $ do
+  describe "extractIdentifiers" do
+    it "extracts identifiers" do
       extractIdentifiers ".. `foldl' ..., `foldr' .." `shouldBe` [UseName "foldl", UseName "foldr"]
 
-  describe "qualifiedName" $ do
-    it "" do
+  describe "qualifiedName" do
+    it "parses an unqualified name" do
       qualifiedName "foo" `shouldBe` RequiredVariable Unqualified "foo" Nothing
+
+    it "parses a qualified name" do
       qualifiedName "Foo.Bar.baz" `shouldBe` RequiredVariable "Foo.Bar" "baz" Nothing
 
-  describe "formatAnnotated" $ do
-    it "extracts identifiers" $ do
-      err <- B.readFile "test/fixtures/not-in-scope/err.json"
-      Just foo <- return $ parseAnnotated availableImports err
-      formatAnnotated foo `shouldBe` T.unlines [
+  describe "formatAnnotated" do
+    it "formats an annotated diagnostic message" do
+      Just annotated <- B.readFile "test/fixtures/not-in-scope/err.json" <&> parseAnnotated availableImports
+      formatAnnotated annotated `shouldBe` T.unlines [
           "test/fixtures/not-in-scope/Foo.hs:2:7: error: [GHC-88464]"
         , "    Variable not in scope: c2w"
         , ""
         , T.pack (withColor Cyan "    [1] ") <> "import Data.ByteString.Internal (c2w)"
         ]
 
-  describe "applyReplace" $ do
-    it "replaces a given source span with a substitute" $ do
+  describe "applyReplace" do
+    it "replaces a given source span with a substitute" do
       applyReplace (Location 2 7) (Location 2 14) "filter" [
           "module Foo where"
         , "foo = filter_ p xs"
@@ -224,7 +204,7 @@ spec = do
         , "foo = filter p xs"
         ]
 
-    it "correctly handles source spans that span over multiple lines" $ do
+    it "correctly handles source spans that span over multiple lines" do
       applyReplace (Location 2 8) (Location 3 7) "Ya" [
           "module Foo where"
         , "import Data.Maybe"
@@ -235,13 +215,3 @@ spec = do
         , "import Yabar"
         , "one = two"
         ]
-
-        {-
-src/Command.hs:263:106: error: [GHC-88464]
-    Data constructor not in scope: PascalCase :: [String] -> String
-    Suggested fix: Perhaps use variable `pascalCase' (line 366)
-
-test/Language/Haskell/GhciWrapperSpec.hs:164:25: error: [GHC-88464]
-    Data constructor not in scope:
-      NotInScope :: t0 -> [a0] -> GHC.Diagnostic.Annotated.Annotation
-    -}

test/GHC/DiagnosticSpec.hs

@@ -21,6 +21,7 @@ module Helper (
 
 , Annotated(..)
 , Diagnostic(..)
+, Annotation(..)
 , Span(..)
 , Location(..)
 , Severity(..)
@@ -57,6 +58,7 @@ import           Language.Haskell.GhciWrapper
 import qualified Trigger
 
 import           GHC.Diagnostic
+import           GHC.Diagnostic.Annotated
 
 timeout :: HasCallStack => IO a -> IO a
 timeout action = do

test/Helper.hs

@@ -7,7 +7,6 @@ import qualified Data.ByteString.Char8 as ByteString
 
 import           Language.Haskell.GhciWrapper (Config(..), Interpreter(..), ReloadStatus(..), Extract(..))
 import qualified Language.Haskell.GhciWrapper as Interpreter
-import           GHC.Diagnostic.Annotated
 
 main :: IO ()
 main = hspec spec