{-# LANGUAGE OverloadedStrings #-}

module FFICXX.Generate.Code.HsProxy where

import Language.Haskell.Exts.Build    ( app, doE, listE, qualStmt, strE )
import qualified Data.List as L       ( foldr1 )
import Language.Haskell.Exts.Syntax   ( Decl(..) )
--
import qualified FFICXX.Runtime.CodeGen.Cxx as R
import FFICXX.Generate.Util.HaskellSrcExts
                                      ( con, inapp, mkFun, mkVar
                                      , op, qualifier
                                      , tyapp, tycon, tylist
                                      )


genProxyInstance :: [Decl ()]
genProxyInstance :: [Decl ()]
genProxyInstance =
    String
-> Type () -> [Pat ()] -> Exp () -> Maybe (Binds ()) -> [Decl ()]
mkFun String
fname Type ()
sig [] Exp ()
rhs Maybe (Binds ())
forall a. Maybe a
Nothing
  where fname :: String
fname = String
"genImplProxy"
        v :: String -> Exp ()
v = String -> Exp ()
mkVar
        sig :: Type ()
sig = String -> Type ()
tycon String
"Q" Type () -> Type () -> Type ()
`tyapp` Type () -> Type ()
tylist (String -> Type ()
tycon String
"Dec")
        rhs :: Exp ()
rhs = [Stmt ()] -> Exp ()
doE [Stmt ()
foreignSrcStmt, Exp () -> Stmt ()
qualStmt Exp ()
retstmt]
        foreignSrcStmt :: Stmt ()
foreignSrcStmt =
          Exp () -> Stmt ()
qualifier (Exp () -> Stmt ()) -> Exp () -> Stmt ()
forall a b. (a -> b) -> a -> b
$
                  (String -> Exp ()
v String
"addModFinalizer")
            Exp () -> Exp () -> Exp ()
`app` (      String -> Exp ()
v String
"addForeignSource"
                   Exp () -> Exp () -> Exp ()
`app` String -> Exp ()
con String
"LangCxx"
                   Exp () -> Exp () -> Exp ()
`app` ((Exp () -> Exp () -> Exp ()) -> [Exp ()] -> Exp ()
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
L.foldr1 (\Exp ()
x Exp ()
y -> Exp () -> QOp () -> Exp () -> Exp ()
inapp Exp ()
x (String -> QOp ()
op String
"++") Exp ()
y)
                            [ Exp ()
includeStatic ]
                         )
                  )
          where
            includeStatic :: Exp ()
includeStatic =
              String -> Exp ()
strE (String -> Exp ()) -> String -> Exp ()
forall a b. (a -> b) -> a -> b
$ (String -> String) -> [String] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n")
                [ CMacro Identity -> String
R.renderCMacro (HeaderName -> CMacro Identity
forall (f :: * -> *). HeaderName -> CMacro f
R.Include HeaderName
"MacroPatternMatch.h") ]
        retstmt :: Exp ()
retstmt = String -> Exp ()
v String
"pure" Exp () -> Exp () -> Exp ()
`app` [Exp ()] -> Exp ()
listE []