stdcxx-0.7.0.0: src/STD/MapIterator/TH.hs

{-# LANGUAGE TemplateHaskell #-}
module STD.MapIterator.TH where
import Data.Char
import Data.List
import Data.Monoid
import Foreign.C.Types
import Foreign.Ptr
import Language.Haskell.TH
import Language.Haskell.TH.Syntax
import FFICXX.Runtime.CodeGen.Cxx
import FFICXX.Runtime.TH
import STD.MapIterator.Template
import STD.Pair.Template

t_deRef :: (Type, Type) -> String -> Q Exp
t_deRef (typ1, typ2) suffix
  = mkTFunc
      ((typ1, typ2), suffix, \ n -> "MapIterator_deRef" <> n, tyf)
  where tyf _
          = let tpk = pure typ1
                tpv = pure typ2
              in
              [t| MapIterator $( tpk ) $( tpv ) -> IO (Pair $( tpk ) $( tpv )) |]

t_increment :: (Type, Type) -> String -> Q Exp
t_increment (typ1, typ2) suffix
  = mkTFunc
      ((typ1, typ2), suffix, \ n -> "MapIterator_increment" <> n, tyf)
  where tyf _
          = let tpk = pure typ1
                tpv = pure typ2
              in
              [t|
                MapIterator $( tpk ) $( tpv ) -> IO (MapIterator $( tpk ) $( tpv ))
                |]

genMapIteratorInstanceFor ::
                          IsCPrimitive ->
                            (Q Type, TemplateParamInfo) ->
                              (Q Type, TemplateParamInfo) -> Q [Dec]
genMapIteratorInstanceFor isCprim (qtyp1, param1) (qtyp2, param2)
  = do let params = map tpinfoSuffix [param1, param2]
       let suffix
             = concatMap (\ x -> "_" ++ tpinfoSuffix x) [param1, param2]
       callmod_ <- fmap loc_module location
       let callmod = dot2_ callmod_
       typ1 <- qtyp1
       typ2 <- qtyp2
       f1 <- mkMember "deRef" t_deRef (typ1, typ2) suffix
       f2 <- mkMember "increment" t_increment (typ1, typ2) suffix
       addModFinalizer
         (addForeignSource LangCxx
            ("\n#include \"MacroPatternMatch.h\"\n\n\n#include \"map\"\n\n\n#define MapIterator_deRef(callmod, tpk, tpv) \\\nextern \"C\" {\\\nvoid* MapIterator_deRef_##tpk##_##tpv ( void* p );}\\\ninline void* MapIterator_deRef_##tpk##_##tpv ( void* p ) {\\\nstd::pair<tpk,tpv>* r=new std::pair<tpk,tpv>((static_cast<std::map<tpk, tpv>::iterator*>(p))->operator*());return static_cast<void*>(r);\\\n}\\\nauto a_##callmod##_MapIterator_deRef_##tpk##_##tpv=MapIterator_deRef_##tpk##_##tpv;\n\n\n#define MapIterator_increment(callmod, tpk, tpv) \\\nextern \"C\" {\\\nvoid* MapIterator_increment_##tpk##_##tpv ( void* p );}\\\ninline void* MapIterator_increment_##tpk##_##tpv ( void* p ) {\\\nstd::map<tpk,tpv>::iterator* r=new std::map<tpk,tpv>::iterator((static_cast<std::map<tpk, tpv>::iterator*>(p))->operator++());return static_cast<void*>(r);\\\n}\\\nauto a_##callmod##_MapIterator_increment_##tpk##_##tpv=MapIterator_increment_##tpk##_##tpv;\n\n\n#define MapIterator_deRef_s(callmod, tpk, tpv) \\\nextern \"C\" {\\\nvoid* MapIterator_deRef_##tpk##_##tpv ( void* p );}\\\ninline void* MapIterator_deRef_##tpk##_##tpv ( void* p ) {\\\nstd::pair<tpk,tpv>* r=new std::pair<tpk,tpv>((static_cast<std::map<tpk, tpv>::iterator*>(p))->operator*());return static_cast<void*>(r);\\\n}\\\nauto a_##callmod##_MapIterator_deRef_##tpk##_##tpv=MapIterator_deRef_##tpk##_##tpv;\n\n\n#define MapIterator_increment_s(callmod, tpk, tpv) \\\nextern \"C\" {\\\nvoid* MapIterator_increment_##tpk##_##tpv ( void* p );}\\\ninline void* MapIterator_increment_##tpk##_##tpv ( void* p ) {\\\nstd::map<tpk,tpv>::iterator* r=new std::map<tpk,tpv>::iterator((static_cast<std::map<tpk, tpv>::iterator*>(p))->operator++());return static_cast<void*>(r);\\\n}\\\nauto a_##callmod##_MapIterator_increment_##tpk##_##tpv=MapIterator_increment_##tpk##_##tpv;\n\n\n#define MapIterator_instance(callmod, tpk, tpv) \\\nMapIterator_deRef(callmod, tpk, tpv)\\\nMapIterator_increment(callmod, tpk, tpv)\n\n\n#define MapIterator_instance_s(callmod, tpk, tpv) \\\nMapIterator_deRef_s(callmod, tpk, tpv)\\\nMapIterator_increment_s(callmod, tpk, tpv)\n\n"
               ++
               let headers = concatMap tpinfoCxxHeaders [param1, param2]
                   f x = renderCMacro (Include x)
                 in concatMap f headers
                 ++
                 let nss = concatMap tpinfoCxxNamespaces [param1, param2]
                     f x = renderCStmt (UsingNamespace x)
                   in concatMap f nss
                   ++
                   "MapIterator_instance" ++
                     (case isCprim of
                          CPrim -> "_s"
                          NonCPrim -> "")
                       ++ "(" ++ intercalate ", " (callmod : params) ++ ")\n"))
       let lst = [f1, f2]
       pure
         [mkInstance [] (AppT (AppT (con "IMapIterator") typ1) typ2) lst]