wip

src/Language/Haskell/GhciWrapper.hs

@@ -16,7 +16,8 @@ module Language.Haskell.GhciWrapper (
 #ifdef TEST
 , sensei_ghc_version
 , lookupGhc
-, getGhcVersion
+, lookupGhcVersion
+, numericVersion
 , extractReloadDiagnostics
 , extractDiagnostics
 #endif
@@ -37,20 +38,23 @@ import qualified ReadHandle
 import           GHC.Diagnostic (Diagnostic)
 import qualified GHC.Diagnostic as Diagnostic
 
-sensei_ghc :: String
-sensei_ghc = "SENSEI_GHC"
-
 sensei_ghc_version :: String
 sensei_ghc_version = "SENSEI_GHC_VERSION"
 
 lookupGhc :: [(String, String)] -> FilePath
-lookupGhc = fromMaybe "ghc" . lookup sensei_ghc
+lookupGhc = fromMaybe "ghc" . lookup "SENSEI_GHC"
+
+lookupGhcVersion :: [(String, String)] -> Maybe String
+lookupGhcVersion = lookup sensei_ghc_version
 
 getGhcVersion :: FilePath -> [(String, String)] -> IO String
-getGhcVersion ghc env = case lookup sensei_ghc_version env of
-  Nothing -> strip <$> readProcess ghc ["--numeric-version"] ""
+getGhcVersion ghc env = case lookupGhcVersion env of
+  Nothing -> numericVersion ghc
   Just version -> return version
 
+numericVersion :: [Char] -> IO [Char]
+numericVersion ghc = strip <$> readProcess ghc ["--numeric-version"] ""
+
 data Config = Config {
   configIgnoreDotGhci :: Bool
 , configWorkingDirectory :: Maybe FilePath

test/GHC/DiagnosticSpec.hs

@@ -30,7 +30,6 @@ test name = it name $ do
     translate = map \ case
       '‘' -> '`'
       '’' -> '\''
-      -- '•' -> '*'
       c -> c
 
 ftest :: HasCallStack => FilePath -> Spec

test/Helper.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
 module Helper (
   module Imports
 , silent
@@ -124,6 +125,5 @@ to_json = toStrict . encode
 requireGhc :: [Int] -> IO ()
 requireGhc (makeVersion -> required) = do
   env <- getEnvironment
-  let ghc = lookupGhc env
-  ghcVersion <- parseVersion <$> getGhcVersion ghc env
-  when (ghcVersion < Just required) pending
+  let Just ghcVersion = lookupGhcVersion env >>= parseVersion
+  when (ghcVersion < required) pending

test/Language/Haskell/GhciWrapperSpec.hs

@@ -168,7 +168,7 @@ spec = do
 
     context "with -fno-diagnostics-as-json" $ do
       it "does not extract diagnostics" do
-        requireGhc [9, 10]
+        requireGhc [9,10]
         withModule \ file -> do
           withInterpreter ["-fno-diagnostics-as-json", file] \ ghci -> do
             failingModule file

test/SpecHook.hs

@@ -14,9 +14,9 @@ ensurePackageEnvironment ghc file = doesFileExist file >>= \ case
   False -> installPackageEnvironment ghc file
   True -> pass
 
-getGhcVersion :: FilePath -> [(FilePath, FilePath)] -> IO FilePath
-getGhcVersion ghc env = do
-  ghcVersion <- Interpreter.getGhcVersion ghc env
+getGhcVersion :: FilePath -> IO String
+getGhcVersion ghc = do
+  ghcVersion <- Interpreter.numericVersion ghc
   setEnv Interpreter.sensei_ghc_version ghcVersion
   return ghcVersion
 
@@ -25,7 +25,7 @@ setPackageEnvironment = do
   dir <- getCurrentDirectory
   env <- getEnvironment
   let ghc = Interpreter.lookupGhc env
-  ghcVersion <- getGhcVersion ghc env
+  ghcVersion <- getGhcVersion ghc
   let file = dir </> "dist-newstyle" </> "test-env" </> ghcVersion
   ensurePackageEnvironment ghc file
   setEnv "GHC_ENVIRONMENT" file