diff --git a/inline-c/src/Language/C/Inline/FunPtr.hs b/inline-c/src/Language/C/Inline/FunPtr.hs index 0f9c017..8e38212 100644 --- a/inline-c/src/Language/C/Inline/FunPtr.hs +++ b/inline-c/src/Language/C/Inline/FunPtr.hs @@ -9,7 +9,9 @@ module Language.C.Inline.FunPtr , uniqueFfiImportName ) where +import Data.Maybe (isJust) import Foreign.Ptr (FunPtr) +import System.Environment (lookupEnv) import qualified Language.Haskell.TH as TH import qualified Language.Haskell.TH.Syntax as TH @@ -27,9 +29,15 @@ import qualified Language.Haskell.TH.Syntax as TH mkFunPtr :: TH.TypeQ -> TH.ExpQ mkFunPtr hsTy = do ffiImportName <- uniqueFfiImportName - dec <- TH.forImpD TH.CCall TH.Safe "wrapper" ffiImportName [t| $(hsTy) -> IO (FunPtr $(hsTy)) |] - TH.addTopDecls [dec] - TH.varE ffiImportName + -- See note [ghcide-support] + usingGhcide <- TH.runIO $ isJust <$> lookupEnv "__GHCIDE__" + if usingGhcide + then do + [e|error "inline-c: A 'usingGhcide' mkFunPtr stub was evaluated -- this should not happen" :: $(hsTy) -> IO (FunPtr $(hsTy)) |] + else do -- Actual foreign function call generation. + dec <- TH.forImpD TH.CCall TH.Safe "wrapper" ffiImportName [t| $(hsTy) -> IO (FunPtr $(hsTy)) |] + TH.addTopDecls [dec] + TH.varE ffiImportName -- | @$('mkFunPtrFromName' 'foo)@, if @foo :: 'CDouble' -> 'IO' -- 'CDouble'@, splices in an expression of type @'IO' ('FunPtr' @@ -56,9 +64,15 @@ mkFunPtrFromName name = do peekFunPtr :: TH.TypeQ -> TH.ExpQ peekFunPtr hsTy = do ffiImportName <- uniqueFfiImportName - dec <- TH.forImpD TH.CCall TH.Safe "dynamic" ffiImportName [t| FunPtr $(hsTy) -> $(hsTy) |] - TH.addTopDecls [dec] - TH.varE ffiImportName + usingGhcide <- TH.runIO $ isJust <$> lookupEnv "__GHCIDE__" + -- See note [ghcide-support] + if usingGhcide + then do + [e|error "inline-c: A 'usingGhcide' peekFunPtr stub was evaluated -- this should not happen" :: FunPtr $(hsTy) -> $(hsTy) |] + else do -- Actual foreign function call generation. + dec <- TH.forImpD TH.CCall TH.Safe "dynamic" ffiImportName [t| FunPtr $(hsTy) -> $(hsTy) |] + TH.addTopDecls [dec] + TH.varE ffiImportName -- TODO absurdly, I need to 'newName' twice for things to work. I found -- this hack in language-c-inline. Why is this? diff --git a/inline-c/src/Language/C/Inline/Internal.hs b/inline-c/src/Language/C/Inline/Internal.hs index 633497f..7a297a7 100644 --- a/inline-c/src/Language/C/Inline/Internal.hs +++ b/inline-c/src/Language/C/Inline/Internal.hs @@ -64,12 +64,13 @@ import Control.Monad.State (evalStateT, StateT, get, put) import Control.Monad.Trans.Class (lift) import Data.Foldable (forM_) import qualified Data.Map as Map -import Data.Maybe (fromMaybe) +import Data.Maybe (fromMaybe, isJust) import Data.Traversable (for) import Data.Typeable (Typeable, cast) import qualified Language.Haskell.TH as TH import qualified Language.Haskell.TH.Quote as TH import qualified Language.Haskell.TH.Syntax as TH +import System.Environment (lookupEnv) import System.IO.Unsafe (unsafePerformIO, unsafeDupablePerformIO) import qualified Text.Parsec as Parsec import qualified Text.Parsec.Pos as Parsec @@ -298,12 +299,22 @@ inlineCode Code{..} = do void $ emitVerbatim $ out $ directive ++ codeDefs -- Create and add the FFI declaration. ffiImportName <- uniqueFfiImportName - dec <- if codeFunPtr - then - TH.forImpD TH.CCall codeCallSafety ("&" ++ codeFunName) ffiImportName [t| FunPtr $(codeType) |] - else TH.forImpD TH.CCall codeCallSafety codeFunName ffiImportName codeType - TH.addTopDecls [dec] - TH.varE ffiImportName + -- Note [ghcide-support] + -- haskell-language-server / ghcide cannot handle code that use + -- `addForeignFile`/`addForeignSource` as we do here; it will result + -- in linker errors during TH evaluations, see: + -- + -- Thus for GHCIDE, simply generate a call to `error` instead of a call to a foreign import. + usingGhcide <- TH.runIO $ isJust <$> lookupEnv "__GHCIDE__" + if usingGhcide + then do + [e|error "inline-c: A 'usingGhcide' inlineCode stub was evaluated -- this should not happen" :: $(if codeFunPtr then [t| FunPtr $(codeType) |] else codeType) |] + else do -- Actual foreign function call generation. + dec <- if codeFunPtr + then TH.forImpD TH.CCall codeCallSafety ("&" ++ codeFunName) ffiImportName [t| FunPtr $(codeType) |] + else TH.forImpD TH.CCall codeCallSafety codeFunName ffiImportName codeType + TH.addTopDecls [dec] + TH.varE ffiImportName uniqueCName :: Maybe String -> TH.Q String uniqueCName mbPostfix = do