{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}

module FFICXX.Generate.Code.HsTemplate where

import qualified Data.List as L (foldr1)
import FFICXX.Generate.Code.Cpp
  ( genTLTmplFunCpp,
    genTmplClassCpp,
    genTmplFunCpp,
    genTmplVarCpp,
  )
import FFICXX.Generate.Code.HsCast (castBody)
import FFICXX.Generate.Code.Primitive
  ( convertCpp2HS,
    convertCpp2HS4Tmpl,
    functionSignatureT,
    functionSignatureTMF,
    functionSignatureTT,
    tmplAccessorToTFun,
  )
import FFICXX.Generate.Dependency (calculateDependency)
import FFICXX.Generate.Name
  ( ffiTmplFuncName,
    hsTemplateClassName,
    hsTemplateMemberFunctionName,
    hsTemplateMemberFunctionNameTH,
    hsTmplFuncName,
    hsTmplFuncNameTH,
    subModuleName,
    tmplAccessorName,
    typeclassNameT,
  )
import FFICXX.Generate.Type.Class
  ( Accessor (Getter, Setter),
    Arg (..),
    Class (..),
    TLTemplate (..),
    TemplateClass (..),
    TemplateFunction (..),
    TemplateMemberFunction (..),
    Types (Void),
    Variable (..),
  )
import FFICXX.Generate.Type.Module
  ( ClassImportHeader (..),
    TemplateClassImportHeader (..),
    TemplateClassSubmoduleType (..),
    TopLevelImportHeader (..),
  )
import FFICXX.Generate.Util (firstUpper)
import FFICXX.Generate.Util.HaskellSrcExts
  ( bracketExp,
    clsDecl,
    con,
    conDecl,
    cxEmpty,
    generator,
    inapp,
    insDecl,
    insType,
    match,
    mkBind1,
    mkClass,
    mkData,
    mkFun,
    mkFunSig,
    mkImport,
    mkInstance,
    mkNewtype,
    mkPVar,
    mkTBind,
    mkTVar,
    mkVar,
    op,
    parenSplice,
    pbind_,
    qualConDecl,
    qualifier,
    tyPtr,
    tySplice,
    tyapp,
    tycon,
    tyfun,
    tylist,
    typeBracket,
  )
import FFICXX.Runtime.CodeGen.Cxx (HeaderName (..))
import qualified FFICXX.Runtime.CodeGen.Cxx as R
import FFICXX.Runtime.TH (IsCPrimitive (CPrim, NonCPrim))
import Language.Haskell.Exts.Build
  ( app,
    binds,
    caseE,
    doE,
    lamE,
    letE,
    letStmt,
    listE,
    name,
    pApp,
    pTuple,
    paren,
    qualStmt,
    strE,
    tuple,
    wildcard,
  )
import Language.Haskell.Exts.Syntax (Boxed (Boxed), Decl (..), ImportDecl (..), Type (TyTuple))

------------------------------
-- Template member function --
------------------------------

genTemplateMemberFunctions :: ClassImportHeader -> [Decl ()]
genTemplateMemberFunctions cih =
  let c = cihClass cih
   in concatMap (\f -> genTMFExp c f <> genTMFInstance cih f) (class_tmpl_funcs c)

-- TODO: combine this with genTmplInstance
genTMFExp :: Class -> TemplateMemberFunction -> [Decl ()]
genTMFExp c f = mkFun nh sig (tvars_p ++ [p "suffix"]) rhs (Just bstmts)
  where
    nh = hsTemplateMemberFunctionNameTH c f
    v = mkVar
    p = mkPVar
    itps = zip ([1 ..] :: [Int]) (tmf_params f)
    tvars = map (\(i, _) -> "typ" ++ show i) itps
    nparams = length itps
    tparams = if nparams == 1 then tycon "Type" else TyTuple () Boxed (replicate nparams (tycon "Type"))
    sig = foldr1 tyfun [tparams, tycon "String", tyapp (tycon "Q") (tycon "Exp")]
    tvars_p = if nparams == 1 then map p tvars else [pTuple (map p tvars)]
    lit' = strE (hsTemplateMemberFunctionName c f <> "_")
    lam = lamE [p "n"] (lit' `app` v "<>" `app` v "n")
    rhs =
      app (v "mkTFunc") $
        let typs = if nparams == 1 then map v tvars else [tuple (map v tvars)]
         in tuple (typs ++ [v "suffix", lam, v "tyf"])
    sig' = functionSignatureTMF c f
    tassgns = map (\(i, tp) -> pbind_ (p tp) (v "pure" `app` (v ("typ" ++ show i)))) itps
    bstmts =
      binds
        [ mkBind1
            "tyf"
            [mkPVar "n"]
            ( letE
                tassgns
                (bracketExp (typeBracket sig'))
            )
            Nothing
        ]

genTMFInstance :: ClassImportHeader -> TemplateMemberFunction -> [Decl ()]
genTMFInstance cih f =
  mkFun
    fname
    sig
    [p "isCprim", pTuple [p "qtyp", p "param"]]
    rhs
    Nothing
  where
    c = cihClass cih
    fname = "genInstanceFor_" <> hsTemplateMemberFunctionName c f
    p = mkPVar
    v = mkVar
    sig =
      tycon "IsCPrimitive"
        `tyfun` TyTuple () Boxed [tycon "Q" `tyapp` tycon "Type", tycon "TemplateParamInfo"]
        `tyfun` (tycon "Q" `tyapp` tylist (tycon "Dec"))
    rhs = doE [suffixstmt, qtypstmt, genstmt, foreignSrcStmt, letStmt lststmt, qualStmt retstmt]
    suffixstmt = letStmt [pbind_ (p "suffix") (v "tpinfoSuffix" `app` v "param")]
    qtypstmt = generator (p "typ") (v "qtyp")
    genstmt =
      generator
        (p "f1")
        ( v "mkMember"
            `app` ( strE (hsTemplateMemberFunctionName c f <> "_")
                      `app` v "<>"
                      `app` v "suffix"
                  )
            `app` v (hsTemplateMemberFunctionNameTH c f)
            `app` v "typ"
            `app` v "suffix"
        )
    lststmt = [pbind_ (p "lst") (listE ([v "f1"]))]
    retstmt = v "pure" `app` v "lst"
    -- TODO: refactor out the following code.
    foreignSrcStmt =
      qualifier $
        (v "addModFinalizer")
          `app` ( v "addForeignSource"
                    `app` con "LangCxx"
                    `app` ( L.foldr1
                              (\x y -> inapp x (op "++") y)
                              [ includeStatic,
                                includeDynamic,
                                namespaceStr,
                                strE (hsTemplateMemberFunctionName c f),
                                strE "(",
                                v "suffix",
                                strE ")\n"
                              ]
                          )
                )
      where
        includeStatic =
          strE $
            concatMap ((<> "\n") . R.renderCMacro . R.Include) $
              [HdrName "MacroPatternMatch.h", cihSelfHeader cih]
                <> cihIncludedHPkgHeadersInCPP cih
                <> cihIncludedCPkgHeaders cih
        includeDynamic =
          letE
            [ pbind_ (p "headers") (v "tpinfoCxxHeaders" `app` v "param"),
              pbind_
                (pApp (name "f") [p "x"])
                (v "renderCMacro" `app` (con "Include" `app` v "x"))
            ]
            (v "concatMap" `app` v "f" `app` v "headers")
        namespaceStr =
          letE
            [ pbind_ (p "nss") (v "tpinfoCxxNamespaces" `app` v "param"),
              pbind_
                (pApp (name "f") [p "x"])
                (v "renderCStmt" `app` (con "UsingNamespace" `app` v "x"))
            ]
            (v "concatMap" `app` v "f" `app` v "nss")

--------------------
-- Template Class --
--------------------

genImportInTemplate :: TemplateClass -> [ImportDecl ()]
genImportInTemplate t0 =
  fmap (mkImport . subModuleName) $ calculateDependency $ Left (TCSTTemplate, t0)

-- |
genTmplInterface :: TemplateClass -> [Decl ()]
genTmplInterface t =
  [ mkData rname (map mkTBind tps) [] Nothing,
    mkNewtype
      hname
      (map mkTBind tps)
      [qualConDecl Nothing Nothing (conDecl hname [tyapp tyPtr rawtype])]
      Nothing,
    mkClass cxEmpty (typeclassNameT t) (map mkTBind tps) methods,
    mkInstance cxEmpty "FPtr" [hightype] fptrbody,
    mkInstance cxEmpty "Castable" [hightype, tyapp tyPtr rawtype] castBody
  ]
  where
    (hname, rname) = hsTemplateClassName t
    tps = tclass_params t
    fs = tclass_funcs t
    vfs = tclass_vars t
    rawtype = foldl1 tyapp (tycon rname : map mkTVar tps)
    hightype = foldl1 tyapp (tycon hname : map mkTVar tps)
    sigdecl f = mkFunSig (hsTmplFuncName t f) (functionSignatureT t f)
    sigdeclV vf =
      let f_g = tmplAccessorToTFun vf Getter
          f_s = tmplAccessorToTFun vf Setter
       in [sigdecl f_g, sigdecl f_s]
    methods = map (clsDecl . sigdecl) fs ++ (map clsDecl . concatMap sigdeclV) vfs
    fptrbody =
      [ insType (tyapp (tycon "Raw") hightype) rawtype,
        insDecl (mkBind1 "get_fptr" [pApp (name hname) [mkPVar "ptr"]] (mkVar "ptr") Nothing),
        insDecl (mkBind1 "cast_fptr_to_obj" [] (con hname) Nothing)
      ]

-- |
genImportInTH :: TemplateClass -> [ImportDecl ()]
genImportInTH t0 =
  fmap (mkImport . subModuleName) $ calculateDependency $ Left (TCSTTH, t0)

-- |
genTmplImplementation :: TemplateClass -> [Decl ()]
genTmplImplementation t =
  concatMap gen (tclass_funcs t) ++ concatMap genV (tclass_vars t)
  where
    v = mkVar
    p = mkPVar
    itps = zip ([1 ..] :: [Int]) (tclass_params t)
    tvars = map (\(i, _) -> "typ" ++ show i) itps
    nparams = length itps
    tparams = if nparams == 1 then tycon "Type" else TyTuple () Boxed (replicate nparams (tycon "Type"))
    sig = foldr1 tyfun [tparams, tycon "String", tyapp (tycon "Q") (tycon "Exp")]
    tvars_p = if nparams == 1 then map p tvars else [pTuple (map p tvars)]
    prefix = tclass_name t
    gen f = mkFun nh sig (tvars_p ++ [p "suffix"]) rhs (Just bstmts)
      where
        nh = hsTmplFuncNameTH t f
        nc = ffiTmplFuncName f
        lit' = strE (prefix <> "_" <> nc)
        lam = lamE [p "n"] (lit' `app` v "<>" `app` v "n")
        rhs =
          app (v "mkTFunc") $
            let typs = if nparams == 1 then map v tvars else [tuple (map v tvars)]
             in tuple (typs ++ [v "suffix", lam, v "tyf"])
        sig' = functionSignatureTT t f
        tassgns = map (\(i, tp) -> pbind_ (p tp) (v "pure" `app` (v ("typ" ++ show i)))) itps
        bstmts =
          binds
            [ mkBind1
                "tyf"
                [wildcard]
                ( letE
                    tassgns
                    (bracketExp (typeBracket sig'))
                )
                Nothing
            ]
    genV vf =
      let f_g = tmplAccessorToTFun vf Getter
          f_s = tmplAccessorToTFun vf Setter
       in gen f_g ++ gen f_s

-- |
genTmplInstance ::
  TemplateClassImportHeader ->
  [Decl ()]
genTmplInstance tcih =
  mkFun
    fname
    sig
    (p "isCprim" : zipWith (\x y -> pTuple [p x, p y]) qtvars pvars)
    rhs
    Nothing
  where
    t = tcihTClass tcih
    fs = tclass_funcs t
    vfs = tclass_vars t
    tname = tclass_name t
    fname = "gen" <> tname <> "InstanceFor"
    p = mkPVar
    v = mkVar
    itps = zip ([1 ..] :: [Int]) (tclass_params t)
    tvars = map (\(i, _) -> "typ" ++ show i) itps
    qtvars = map (\(i, _) -> "qtyp" ++ show i) itps
    pvars = map (\(i, _) -> "param" ++ show i) itps
    nparams = length itps
    typs_v = if nparams == 1 then v (tvars !! 0) else tuple (map v tvars)
    params_l = listE (map v pvars)
    sig =
      foldr1 tyfun $
        [tycon "IsCPrimitive"]
          ++ replicate
            nparams
            (TyTuple () Boxed [tycon "Q" `tyapp` tycon "Type", tycon "TemplateParamInfo"])
          ++ [tycon "Q" `tyapp` tylist (tycon "Dec")]
    nfs = zip ([1 ..] :: [Int]) fs
    nvfs = zip ([1 ..] :: [Int]) vfs
    --------------------------
    -- final RHS expression --
    --------------------------
    rhs =
      doE
        ( [paramsstmt, suffixstmt]
            <> [ generator (p "callmod_") (v "fmap" `app` v "loc_module" `app` (v "location")),
                 letStmt
                   [ pbind_
                       (p "callmod")
                       (v "dot2_" `app` v "callmod_")
                   ]
               ]
            <> map genqtypstmt (zip tvars qtvars)
            <> map genstmt nfs
            <> concatMap genvarstmt nvfs
            <> [foreignSrcStmt, letStmt lststmt, qualStmt retstmt]
        )
    --------------------------
    paramsstmt =
      letStmt
        [ pbind_
            (p "params")
            (v "map" `app` (v "tpinfoSuffix") `app` params_l)
        ]
    suffixstmt =
      letStmt
        [ pbind_
            (p "suffix")
            ( v "concatMap"
                `app` (lamE [p "x"] (inapp (strE "_") (op "++") (v "tpinfoSuffix" `app` v "x")))
                `app` params_l
            )
        ]
    genqtypstmt (tvar, qtvar) = generator (p tvar) (v qtvar)
    gen prefix nm f n =
      generator
        (p (prefix <> show n))
        ( v nm `app` strE (hsTmplFuncName t f)
            `app` v (hsTmplFuncNameTH t f)
            `app` typs_v
            `app` v "suffix"
        )
    genstmt (n, f@TFun {}) = gen "f" "mkMember" f n
    genstmt (n, f@TFunNew {}) = gen "f" "mkNew" f n
    genstmt (n, f@TFunDelete) = gen "f" "mkDelete" f n
    genstmt (n, f@TFunOp {}) = gen "f" "mkMember" f n
    genvarstmt (n, vf) =
      let Variable (Arg {..}) = vf
          f_g =
            TFun
              { tfun_ret = arg_type,
                tfun_name = tmplAccessorName vf Getter,
                tfun_oname = tmplAccessorName vf Getter,
                tfun_args = []
              }
          f_s =
            TFun
              { tfun_ret = Void,
                tfun_name = tmplAccessorName vf Setter,
                tfun_oname = tmplAccessorName vf Setter,
                tfun_args = [Arg arg_type "value"]
              }
       in [ gen "vf" "mkMember" f_g (2 * n - 1),
            gen "vf" "mkMember" f_s (2 * n)
          ]
    lststmt =
      let mkElems prefix xs = map (v . (\n -> prefix <> show n) . fst) xs
       in [ pbind_
              (p "lst")
              ( listE
                  ( mkElems "f" nfs
                      <> mkElems "vf" (concatMap (\(n, vf) -> [(2 * n - 1, vf), (2 * n, vf)]) nvfs)
                  )
              )
          ]
    -- TODO: refactor out the following code.
    foreignSrcStmt =
      qualifier $
        (v "addModFinalizer")
          `app` ( v "addForeignSource"
                    `app` con "LangCxx"
                    `app` ( L.foldr1
                              (\x y -> inapp x (op "++") y)
                              [ includeStatic,
                                includeDynamic,
                                namespaceStr,
                                strE (tname <> "_instance"),
                                paren $
                                  caseE
                                    (v "isCprim")
                                    [ match (p "CPrim") (strE "_s"),
                                      match (p "NonCPrim") (strE "")
                                    ],
                                strE "(",
                                v "intercalate"
                                  `app` strE ", "
                                  `app` paren (inapp (v "callmod") (op ":") (v "params")),
                                strE ")\n"
                              ]
                          )
                )
      where
        -- temporary
        body =
          map R.renderCMacro $
            map R.Include (tcihCxxHeaders tcih)
              ++ map (genTmplFunCpp NonCPrim t) fs
              ++ map (genTmplFunCpp CPrim t) fs
              ++ concatMap (genTmplVarCpp NonCPrim t) vfs
              ++ concatMap (genTmplVarCpp CPrim t) vfs
              ++ [ genTmplClassCpp NonCPrim t (fs, vfs),
                   genTmplClassCpp CPrim t (fs, vfs)
                 ]
        includeStatic =
          strE $
            concatMap
              (<> "\n")
              ( [R.renderCMacro (R.Include (HdrName "MacroPatternMatch.h"))]
                  ++ body
              )
        cxxHeaders = v "concatMap" `app` (v "tpinfoCxxHeaders") `app` params_l
        cxxNamespaces = v "concatMap" `app` (v "tpinfoCxxNamespaces") `app` params_l
        includeDynamic =
          letE
            [ pbind_ (p "headers") cxxHeaders,
              pbind_
                (pApp (name "f") [p "x"])
                (v "renderCMacro" `app` (con "Include" `app` v "x"))
            ]
            (v "concatMap" `app` v "f" `app` v "headers")
        namespaceStr =
          letE
            [ pbind_ (p "nss") cxxNamespaces,
              pbind_
                (pApp (name "f") [p "x"])
                (v "renderCStmt" `app` (con "UsingNamespace" `app` v "x"))
            ]
            (v "concatMap" `app` v "f" `app` v "nss")
    retstmt =
      v "pure"
        `app` listE
          [ v "mkInstance"
              `app` listE []
              `app` foldl1
                (\f x -> con "AppT" `app` f `app` x)
                (v "con" `app` strE (typeclassNameT t) : map v tvars)
              `app` (v "lst")
          ]

---------------
-- top-level --
---------------

-- |
genTLTemplateInterface :: TLTemplate -> [Decl ()]
genTLTemplateInterface t =
  [ mkClass cxEmpty (firstUpper (topleveltfunc_name t)) (map mkTBind tps) methods
  ]
  where
    tps = topleveltfunc_params t
    ctyp = convertCpp2HS Nothing (topleveltfunc_ret t)
    lst = map (convertCpp2HS Nothing . arg_type) (topleveltfunc_args t)
    sigdecl = mkFunSig (topleveltfunc_name t) $ foldr1 tyfun (lst <> [tyapp (tycon "IO") ctyp])
    methods = [clsDecl sigdecl]

-- |
genTLTemplateImplementation :: TLTemplate -> [Decl ()]
genTLTemplateImplementation t =
  mkFun nh sig (tvars_p ++ [p "suffix"]) rhs (Just bstmts)
  where
    v = mkVar
    p = mkPVar
    itps = zip ([1 ..] :: [Int]) (topleveltfunc_params t)
    tvars = map (\(i, _) -> "typ" ++ show i) itps
    nparams = length itps
    tparams = if nparams == 1 then tycon "Type" else TyTuple () Boxed (replicate nparams (tycon "Type"))
    sig = foldr1 tyfun [tparams, tycon "String", tyapp (tycon "Q") (tycon "Exp")]
    tvars_p = if nparams == 1 then map p tvars else [pTuple (map p tvars)]
    prefix = "TL"
    nh = "t_" <> topleveltfunc_name t
    nc = topleveltfunc_name t
    lit' = strE (prefix <> "_" <> nc)
    lam = lamE [p "n"] (lit' `app` v "<>" `app` v "n")
    rhs =
      app (v "mkTFunc") $
        let typs = if nparams == 1 then map v tvars else [tuple (map v tvars)]
         in tuple (typs ++ [v "suffix", lam, v "tyf"])
    sig' =
      let e = error "genTLTemplateImplementation"
          spls = map (tySplice . parenSplice . mkVar) $ topleveltfunc_params t
          ctyp = convertCpp2HS4Tmpl e Nothing spls (topleveltfunc_ret t)
          lst = map (convertCpp2HS4Tmpl e Nothing spls . arg_type) (topleveltfunc_args t)
       in foldr1 tyfun (lst <> [tyapp (tycon "IO") ctyp])
    tassgns = map (\(i, tp) -> pbind_ (p tp) (v "pure" `app` (v ("typ" ++ show i)))) itps
    bstmts =
      binds
        [ mkBind1
            "tyf"
            [wildcard]
            ( letE
                tassgns
                (bracketExp (typeBracket sig'))
            )
            Nothing
        ]

genTLTemplateInstance ::
  TopLevelImportHeader ->
  TLTemplate ->
  [Decl ()]
genTLTemplateInstance tih t =
  mkFun
    fname
    sig
    (p "isCprim" : zipWith (\x y -> pTuple [p x, p y]) qtvars pvars)
    rhs
    Nothing
  where
    p = mkPVar
    v = mkVar
    tcname = firstUpper (topleveltfunc_name t)
    fname = "gen" <> tcname <> "InstanceFor"
    itps = zip ([1 ..] :: [Int]) (topleveltfunc_params t)
    tvars = map (\(i, _) -> "typ" ++ show i) itps
    qtvars = map (\(i, _) -> "qtyp" ++ show i) itps
    pvars = map (\(i, _) -> "param" ++ show i) itps
    nparams = length itps
    typs_v = if nparams == 1 then v (tvars !! 0) else tuple (map v tvars)
    params_l = listE (map v pvars)
    sig =
      foldr1 tyfun $
        [tycon "IsCPrimitive"]
          ++ replicate
            nparams
            (TyTuple () Boxed [tycon "Q" `tyapp` tycon "Type", tycon "TemplateParamInfo"])
          ++ [tycon "Q" `tyapp` tylist (tycon "Dec")]
    -- nvfs = zip ([1..] :: [Int]) vfs

    --------------------------
    -- final RHS expression --
    --------------------------
    rhs =
      doE
        ( [paramsstmt, suffixstmt]
            <> [ generator (p "callmod_") (v "fmap" `app` v "loc_module" `app` (v "location")),
                 letStmt
                   [ pbind_
                       (p "callmod")
                       (v "dot2_" `app` v "callmod_")
                   ]
               ]
            <> map genqtypstmt (zip tvars qtvars)
            <> [genstmt "f" (1 :: Int)]
            <> [ foreignSrcStmt,
                 letStmt lststmt,
                 qualStmt retstmt
               ]
        )
    --------------------------
    paramsstmt =
      letStmt
        [ pbind_
            (p "params")
            (v "map" `app` (v "tpinfoSuffix") `app` params_l)
        ]
    suffixstmt =
      letStmt
        [ pbind_
            (p "suffix")
            ( v "concatMap"
                `app` (lamE [p "x"] (inapp (strE "_") (op "++") (v "tpinfoSuffix" `app` v "x")))
                `app` params_l
            )
        ]
    genqtypstmt (tvar, qtvar) = generator (p tvar) (v qtvar)
    genstmt prefix n =
      generator
        (p (prefix <> show n))
        ( v "mkFunc" `app` strE (topleveltfunc_name t)
            `app` v ("t_" <> topleveltfunc_name t)
            `app` typs_v
            `app` v "suffix"
        )
    lststmt = [pbind_ (p "lst") (listE [v "f1"])]
    -- TODO: refactor out the following code.
    foreignSrcStmt =
      qualifier $
        (v "addModFinalizer")
          `app` ( v "addForeignSource"
                    `app` con "LangCxx"
                    `app` ( L.foldr1
                              (\x y -> inapp x (op "++") y)
                              [ includeStatic,
                                {-                        , includeDynamic
                                                        , namespaceStr -}
                                strE (tcname <> "_instance"),
                                paren $
                                  caseE
                                    (v "isCprim")
                                    [ match (p "CPrim") (strE "_s"),
                                      match (p "NonCPrim") (strE "")
                                    ],
                                strE "(",
                                v "intercalate"
                                  `app` strE ", "
                                  `app` paren (inapp (v "callmod") (op ":") (v "params")),
                                strE ")\n"
                              ]
                          )
                )
      where
        -- temporary
        includeStatic =
          strE $
            concatMap
              (<> "\n")
              ( [R.renderCMacro (R.Include (HdrName "MacroPatternMatch.h"))]
                  ++ map
                    R.renderCMacro
                    ( map R.Include (tihExtraHeadersInCPP tih)
                        ++ [genTLTmplFunCpp CPrim t, genTLTmplFunCpp NonCPrim t]
                    )
              )
    {-
    cxxHeaders = v "concatMap" `app` (v "tpinfoCxxHeaders") `app` params_l
    cxxNamespaces = v "concatMap" `app` (v "tpinfoCxxNamespaces") `app` params_l

    includeDynamic =
      letE
        [ pbind_ (p "headers") cxxHeaders,
          pbind_
            (pApp (name "f") [p "x"])
            (v "renderCMacro" `app` (con "Include" `app` v "x"))
        ]
        (v "concatMap" `app` v "f" `app` v "headers")

    namespaceStr =
      letE
        [ pbind_ (p "nss") cxxNamespaces,
          pbind_
            (pApp (name "f") [p "x"])
            (v "renderCStmt" `app` (con "UsingNamespace" `app` v "x"))
        ]
        (v "concatMap" `app` v "f" `app` v "nss")
    -}
    retstmt =
      v "pure"
        `app` listE
          [ v "mkInstance"
              `app` listE []
              -- `app` (v "con" `app` strE tcname)
              `app` foldl1
                (\f x -> con "AppT" `app` f `app` x)
                (v "con" `app` strE tcname : map v tvars)
              `app` (v "lst")
          ]