    {-# LANGUAGE CPP #-}
    {-# LANGUAGE QuasiQuotes #-}
    {-# LANGUAGE TemplateHaskell #-}

    module Language.C.Inline.FunPtr
      ( mkFunPtr
      , mkFunPtrFromName
      , peekFunPtr
      , 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

    ------------------------------------------------------------------------
    -- FFI wrappers

    -- | @$('mkFunPtr' [t| 'CDouble' -> 'IO' 'CDouble' |] @ generates a foreign import
    -- wrapper of type
    --
    -- @
    -- ('CDouble' -> 'IO' 'CDouble') -> 'IO' ('FunPtr' ('CDouble' -> 'IO' 'CDouble'))
    -- @
    --
    -- And invokes it.
    mkFunPtr :: TH.TypeQ -> TH.ExpQ
    mkFunPtr :: TypeQ -> ExpQ
    mkFunPtr TypeQ
    hsTy = do
      ffiImportName <- Q Name
    uniqueFfiImportName
      -- 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'
    -- ('CDouble' -> 'IO' 'CDouble'))@.
    mkFunPtrFromName :: TH.Name -> TH.ExpQ
    mkFunPtrFromName :: Name -> ExpQ
    mkFunPtrFromName Name
    name = do
      i <- Name -> Q Info
    TH.reify Name
    name
      case i of
    #if MIN_VERSION_template_haskell(2,11,0)
        TH.VarI Name
    _ Type
    ty Maybe Dec
    _ -> [| $(TypeQ -> ExpQ
    mkFunPtr (Type -> TypeQ
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    ty)) $(Name -> ExpQ
    forall (m :: * -> *). Quote m => Name -> m Exp
    TH.varE Name
    name) |]
    #else
        TH.VarI _ ty _ _ -> [| $(mkFunPtr (return ty)) $(TH.varE name) |]
    #endif
        Info
    _ -> String -> ExpQ
    forall a. String -> Q a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "mkFunPtrFromName: expecting a variable as argument."

    -- | @$('peekFunPtr' [t| 'CDouble' -> 'IO' 'CDouble' |])@ generates a foreign import
    -- dynamic of type
    --
    -- @
    -- 'FunPtr' ('CDouble' -> 'IO' 'CDouble') -> ('CDouble' -> 'IO' 'CDouble')
    -- @
    --
    -- And invokes it.
    peekFunPtr :: TH.TypeQ -> TH.ExpQ
    peekFunPtr :: TypeQ -> ExpQ
    peekFunPtr TypeQ
    hsTy = do
      ffiImportName <- Q Name
    uniqueFfiImportName
      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?
    uniqueFfiImportName :: TH.Q TH.Name
    uniqueFfiImportName :: Q Name
    uniqueFfiImportName = String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    TH.newName (String -> Q Name) -> (Name -> String) -> Name -> Q Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> String
    forall a. Show a => a -> String
    show (Name -> Q Name) -> Q Name -> Q Name
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    TH.newName String
    "inline_c_ffi"