Pass correct SafeHaskell information to mkIfaceTc (#489)

Seems like this was never implemented the first time, woops! Fixes #424
haskell · Mar 19, 2020 · 7ecdd21 · 7ecdd21
1 parent 8ba58cc
commit 7ecdd21
Show file tree

Hide file tree

Showing 2 changed files with 34 additions and 2 deletions.
diff --git a/src/Development/IDE/Core/Compile.hs b/src/Development/IDE/Core/Compile.hs
@@ -234,10 +234,11 @@ mkTcModuleResult
     -> m TcModuleResult
 mkTcModuleResult tcm = do
     session <- getSession
+    let sf = modInfoSafe (tm_checked_module_info tcm)
 #if MIN_GHC_API_VERSION(8,10,0)
-    iface <- liftIO $ mkIfaceTc session Sf_None details tcGblEnv
+    iface <- liftIO $ mkIfaceTc session sf details tcGblEnv
 #else
-    (iface, _) <- liftIO $ mkIfaceTc session Nothing Sf_None details tcGblEnv
+    (iface, _) <- liftIO $ mkIfaceTc session Nothing sf details tcGblEnv
 #endif
     let mod_info = HomeModInfo iface details Nothing
     return $ TcModuleResult tcm mod_info

diff --git a/test/exe/Main.hs b/test/exe/Main.hs
@@ -63,6 +63,7 @@ main = defaultMainWithRerun $ testGroup "HIE"
   , pluginTests
   , preprocessorTests
   , thTests
+  , safeTests
   , unitTests
   , haddockTests
   , positionMappingTests
@@ -1485,6 +1486,36 @@ preprocessorTests = testSessionWait "preprocessor" $ do
       )
     ]
 
+
+safeTests :: TestTree
+safeTests =
+  testGroup
+    "SafeHaskell"
+    [ -- Test for https://github.com/digital-asset/ghcide/issues/424
+      testSessionWait "load" $ do
+        let sourceA =
+              T.unlines
+                ["{-# LANGUAGE Trustworthy #-}"
+                ,"module A where"
+                ,"import System.IO.Unsafe"
+                ,"import System.IO"
+                ,"trustWorthyId :: a -> a"
+                ,"trustWorthyId i = unsafePerformIO $ do"
+                ,"  putStrLn \"I'm safe\""
+                ,"  return i"]
+            sourceB =
+              T.unlines
+                ["{-# LANGUAGE Safe #-}"
+                ,"module B where"
+                ,"import A"
+                ,"safeId :: a -> a"
+                ,"safeId = trustWorthyId"
+                ]
+
+        _ <- openDoc' "A.hs" "haskell" sourceA
+        _ <- openDoc' "B.hs" "haskell" sourceB
+        expectNoMoreDiagnostics 1 ]
+
 thTests :: TestTree
 thTests =
   testGroup