{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Module exposing a 'Context' to inline C++ code.  We only have used
-- this for experiments, so use with caution.  See the C++ tests to see
-- how to build inline C++ code.
module Language.C.Inline.Cpp
  ( module Language.C.Inline
  , cppCtx
  , cppTypePairs
  , using
  , AbstractCppExceptionPtr
  ) where

import           Data.Monoid ((<>), mempty)
import qualified Language.Haskell.TH as TH
import qualified Language.Haskell.TH.Syntax as TH

import           Language.C.Inline
import           Language.C.Inline.Context
import qualified Language.C.Types as CT

import qualified Data.Map as Map

-- | The equivalent of 'C.baseCtx' for C++.  It specifies the @.cpp@
-- file extension for the C file, so that g++ will decide to build C++
-- instead of C.  See the @.cabal@ test target for an example on how to
-- build.
cppCtx :: Context
cppCtx :: Context
cppCtx = Context
baseCtx Context -> Context -> Context
forall a. Semigroup a => a -> a -> a
<> Context
forall a. Monoid a => a
mempty
  { ctxForeignSrcLang = Just TH.LangCxx
  , ctxOutput = Just $ \[Char]
s -> [Char]
"extern \"C\" {\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
s [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n}"
  , ctxEnableCpp = True
  , ctxTypesTable = Map.singleton (CT.TypeName "std::exception_ptr") [t|AbstractCppExceptionPtr|]
  }

-- | Marks an @std::exception_ptr@. Only used via 'Ptr'.
data AbstractCppExceptionPtr

-- | Emits an @using@ directive, e.g.
--
-- @
-- C.using "namespace std" ==> using namespace std
-- @
using :: String -> TH.DecsQ
using :: [Char] -> DecsQ
using [Char]
s = [Char] -> DecsQ
verbatim ([Char] -> DecsQ) -> [Char] -> DecsQ
forall a b. (a -> b) -> a -> b
$ [Char]
"using " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
s [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
";"


cppTypePairs :: [(CT.CIdentifier, TH.TypeQ)] -> Context
cppTypePairs :: [(CIdentifier, TypeQ)] -> Context
cppTypePairs [(CIdentifier, TypeQ)]
typePairs =  Context
forall a. Monoid a => a
mempty {
  ctxTypesTable = Map.fromList $ map (\(CIdentifier
cpp_sym, TypeQ
haskell_sym) -> (CIdentifier -> TypeSpecifier
CT.TypeName CIdentifier
cpp_sym, TypeQ
haskell_sym)) typePairs
  }