{-# LANGUAGE OverloadedStrings #-}

module FFICXX.Generate.Code.HsProxy where

import qualified Data.List as L (foldr1)
--

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

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 a. (a -> a -> a) -> [a] -> a
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 []