-- | 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
  ) 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 :: Maybe ForeignSrcLang
ctxForeignSrcLang = ForeignSrcLang -> Maybe ForeignSrcLang
forall a. a -> Maybe a
Just ForeignSrcLang
TH.LangCxx
  , ctxOutput :: Maybe (String -> String)
ctxOutput = (String -> String) -> Maybe (String -> String)
forall a. a -> Maybe a
Just ((String -> String) -> Maybe (String -> String))
-> (String -> String) -> Maybe (String -> String)
forall a b. (a -> b) -> a -> b
$ \String
s -> String
"extern \"C\" {\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n}"
  , ctxEnableCpp :: Bool
ctxEnableCpp = Bool
True
  }

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


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