Cxt.hs

-- autogenerated by mkCxt.sh. defines a CC.ctxTypesTable based on the Types.hs files in opencascade-hs
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
module Cxt where
import Data.Map (fromList)
import qualified Language.C.Inline.Cpp as C
import qualified Language.C.Types as C
import qualified Language.C.Inline.Context as C

import qualified OpenCascade.BRepBuilderAPI.Types as BRepBuilderAPI
import qualified OpenCascade.BRepFilletAPI.Types as BRepFilletAPI
import qualified OpenCascade.BRepMesh.Types as BRepMesh
import qualified OpenCascade.BRepOffsetAPI.Types as BRepOffsetAPI
import qualified OpenCascade.BRepPrimAPI.Types as BRepPrimAPI
import qualified OpenCascade.BRepTools.Types as BRepTools
import qualified OpenCascade.Bnd.Types as Bnd
import qualified OpenCascade.Font.Types as Font
import qualified OpenCascade.GP.Types as GP
import qualified OpenCascade.GProp.Types as GProp
import qualified OpenCascade.Geom.Types as Geom
import qualified OpenCascade.Message.Types as Message
import qualified OpenCascade.NCollection.Types as NCollection
import qualified OpenCascade.Poly.Types as Poly
import qualified OpenCascade.RWGltf.Types as RWGltf
import qualified OpenCascade.RWMesh.Types as RWMesh
import qualified OpenCascade.RWObj.Types as RWObj
import qualified OpenCascade.STEPControl.Types as STEPControl
import qualified OpenCascade.ShapeFix.Types as ShapeFix
import qualified OpenCascade.StlAPI.Types as StlAPI
import qualified OpenCascade.TColStd.Types as TColStd
import qualified OpenCascade.TDF.Types as TDF
import qualified OpenCascade.TDocStd.Types as TDocStd
import qualified OpenCascade.TopExp.Types as TopExp
import qualified OpenCascade.TopLoc.Types as TopLoc
import qualified OpenCascade.TopTools.Types as TopTools
import qualified OpenCascade.TopoDS.Types as TopoDS
import qualified OpenCascade.XCAFDoc.Types as XCAFDoc
import qualified OpenCascade.XSControl.Types as XSControl
occtTypes :: C.TypesTable
occtTypes = fromList [
 (C.TypeName "NCollection_Array1", [t| NCollection.Array1 |])

 , (C.TypeName "Font_BRepFont", [t| Font.BRepFont |])
 , (C.TypeName "Font_BRepTextBuilder", [t| Font.BRepTextBuilder |])

 , (C.TypeName "TopoDS_Shape", [t| TopoDS.Shape |])
 , (C.TypeName "TopoDS_CompSolid", [t| TopoDS.CompSolid |])
 , (C.TypeName "TopoDS_Compound", [t| TopoDS.Compound |])
 , (C.TypeName "TopoDS_Edge", [t| TopoDS.Edge |])
 , (C.TypeName "TopoDS_Face", [t| TopoDS.Face |])
 , (C.TypeName "TopoDS_Shell", [t| TopoDS.Shell |])
 , (C.TypeName "TopoDS_Solid", [t| TopoDS.Solid |])
 , (C.TypeName "TopoDS_Vertex", [t| TopoDS.Vertex |])
 , (C.TypeName "TopoDS_Wire", [t| TopoDS.Wire |])
 , (C.TypeName "TopoDS_Builder", [t| TopoDS.Builder |])

 , (C.TypeName "TDocStd_Document", [t| TDocStd.Document |])

 , (C.TypeName "BRepBuilderAPI_MakeWire", [t| BRepBuilderAPI.MakeWire |])
 , (C.TypeName "BRepBuilderAPI_MakeFace", [t| BRepBuilderAPI.MakeFace |])
 , (C.TypeName "BRepBuilderAPI_MakeSolid", [t| BRepBuilderAPI.MakeSolid |])
 , (C.TypeName "BRepBuilderAPI_MakeShape", [t| BRepBuilderAPI.MakeShape |])
 , (C.TypeName "BRepBuilderAPI_Sewing", [t| BRepBuilderAPI.Sewing |])

 , (C.TypeName "Geom_Curve", [t| Geom.Curve |])
 , (C.TypeName "Geom_TrimmedCurve", [t| Geom.TrimmedCurve |])
 , (C.TypeName "Geom_BezierCurve", [t| Geom.BezierCurve |])
 , (C.TypeName "Geom_Surface", [t| Geom.Surface |])

 , (C.TypeName "RWMesh_CafReader", [t| RWMesh.CafReader |])

 , (C.TypeName "BRepOffsetAPI_MakePipe", [t| BRepOffsetAPI.MakePipe |])
 , (C.TypeName "BRepOffsetAPI_MakeOffsetShape", [t| BRepOffsetAPI.MakeOffsetShape |])

 , (C.TypeName "XCAFDoc_ShapeTool", [t| XCAFDoc.ShapeTool |])

 , (C.TypeName "TopTools_ListOfShape", [t| TopTools.ListOfShape |])

 , (C.TypeName "BRepMesh_IncrementalMesh", [t| BRepMesh.IncrementalMesh |])

 , (C.TypeName "TopLoc_Location", [t| TopLoc.Location |])

 , (C.TypeName "GP_Pnt", [t| GP.Pnt |])
 , (C.TypeName "GP_Pnt2d", [t| GP.Pnt2d |])
 , (C.TypeName "GP_Ax1", [t| GP.Ax1 |])
 , (C.TypeName "GP_Ax2", [t| GP.Ax2 |])
 , (C.TypeName "GP_Ax2d", [t| GP.Ax2d |])
 , (C.TypeName "GP_Ax3", [t| GP.Ax3 |])
 , (C.TypeName "GP_Dir", [t| GP.Dir |])
 , (C.TypeName "GP_Dir2d", [t| GP.Dir2d |])
 , (C.TypeName "GP_Vec", [t| GP.Vec |])
 , (C.TypeName "GP_Vec2d", [t| GP.Vec2d |])
 , (C.TypeName "GP_Trsf", [t| GP.Trsf |])
 , (C.TypeName "GP_Trsf2d", [t| GP.Trsf2d |])
 , (C.TypeName "GP_GTrsf", [t| GP.GTrsf |])
 , (C.TypeName "GP_XYZ", [t| GP.XYZ |])

 , (C.TypeName "BRepTools_WireExplorer", [t| BRepTools.WireExplorer |])

 , (C.TypeName "RWObj_CafWriter", [t| RWObj.CafWriter |])
 , (C.TypeName "RWObj_CafReader", [t| RWObj.CafReader |])

 , (C.TypeName "Poly_Triangulation", [t| Poly.Triangulation |])
 , (C.TypeName "Poly_Triangle", [t| Poly.Triangle |])

 , (C.TypeName "GProp_GProps", [t| GProp.GProps |])

 , (C.TypeName "BRepFilletAPI_MakeFillet", [t| BRepFilletAPI.MakeFillet |])

 , (C.TypeName "TColStd_IndexedDataMapOfStringString", [t| TColStd.IndexedDataMapOfStringString |])

 , (C.TypeName "TopExp_Explorer", [t| TopExp.Explorer |])

 , (C.TypeName "BRepPrimAPI_MakeBox", [t| BRepPrimAPI.MakeBox |])
 , (C.TypeName "BRepPrimAPI_MakeRevol", [t| BRepPrimAPI.MakeRevol |])

 , (C.TypeName "Message_ProgressRange", [t| Message.ProgressRange |])

 , (C.TypeName "TDF_Label", [t| TDF.Label |])

 , (C.TypeName "XSControl_Reader", [t| XSControl.Reader |])

 , (C.TypeName "Bnd_Box", [t| Bnd.Box |])
 , (C.TypeName "Bnd_OBB", [t| Bnd.OBB |])

 , (C.TypeName "STEPControl_Writer", [t| STEPControl.Writer |])
 , (C.TypeName "STEPControl_Reader", [t| STEPControl.Reader |])

 , (C.TypeName "RWGltf_CafWriter", [t| RWGltf.CafWriter |])
 , (C.TypeName "RWGltf_CafReader", [t| RWGltf.CafReader |])

 , (C.TypeName "ShapeFix_Solid", [t| ShapeFix.Solid |])

 , (C.TypeName "StlAPI_Writer", [t| StlAPI.Writer |])
 , (C.TypeName "StlAPI_Reader", [t| StlAPI.Reader |])
 ]
type NCollection_Array1 = NCollection.Array1
type Font_BRepFont = Font.BRepFont
type Font_BRepTextBuilder = Font.BRepTextBuilder
type TopoDS_Shape = TopoDS.Shape
type TopoDS_CompSolid = TopoDS.CompSolid
type TopoDS_Compound = TopoDS.Compound
type TopoDS_Edge = TopoDS.Edge
type TopoDS_Face = TopoDS.Face
type TopoDS_Shell = TopoDS.Shell
type TopoDS_Solid = TopoDS.Solid
type TopoDS_Vertex = TopoDS.Vertex
type TopoDS_Wire = TopoDS.Wire
type TopoDS_Builder = TopoDS.Builder
type TDocStd_Document = TDocStd.Document
type BRepBuilderAPI_MakeWire = BRepBuilderAPI.MakeWire
type BRepBuilderAPI_MakeFace = BRepBuilderAPI.MakeFace
type BRepBuilderAPI_MakeSolid = BRepBuilderAPI.MakeSolid
type BRepBuilderAPI_MakeShape = BRepBuilderAPI.MakeShape
type BRepBuilderAPI_Sewing = BRepBuilderAPI.Sewing
type Geom_Curve = Geom.Curve
type Geom_TrimmedCurve = Geom.TrimmedCurve
type Geom_BezierCurve = Geom.BezierCurve
type Geom_Surface = Geom.Surface
type RWMesh_CafReader = RWMesh.CafReader
type BRepOffsetAPI_MakePipe = BRepOffsetAPI.MakePipe
type BRepOffsetAPI_MakeOffsetShape = BRepOffsetAPI.MakeOffsetShape
type XCAFDoc_ShapeTool = XCAFDoc.ShapeTool
type TopTools_ListOfShape = TopTools.ListOfShape
type BRepMesh_IncrementalMesh = BRepMesh.IncrementalMesh
type TopLoc_Location = TopLoc.Location
type GP_Pnt = GP.Pnt
type GP_Pnt2d = GP.Pnt2d
type GP_Ax1 = GP.Ax1
type GP_Ax2 = GP.Ax2
type GP_Ax2d = GP.Ax2d
type GP_Ax3 = GP.Ax3
type GP_Dir = GP.Dir
type GP_Dir2d = GP.Dir2d
type GP_Vec = GP.Vec
type GP_Vec2d = GP.Vec2d
type GP_Trsf = GP.Trsf
type GP_Trsf2d = GP.Trsf2d
type GP_GTrsf = GP.GTrsf
type GP_XYZ = GP.XYZ
type BRepTools_WireExplorer = BRepTools.WireExplorer
type RWObj_CafWriter = RWObj.CafWriter
type RWObj_CafReader = RWObj.CafReader
type Poly_Triangulation = Poly.Triangulation
type Poly_Triangle = Poly.Triangle
type GProp_GProps = GProp.GProps
type BRepFilletAPI_MakeFillet = BRepFilletAPI.MakeFillet
type TColStd_IndexedDataMapOfStringString = TColStd.IndexedDataMapOfStringString
type TopExp_Explorer = TopExp.Explorer
type BRepPrimAPI_MakeBox = BRepPrimAPI.MakeBox
type BRepPrimAPI_MakeRevol = BRepPrimAPI.MakeRevol
type Message_ProgressRange = Message.ProgressRange
type TDF_Label = TDF.Label
type XSControl_Reader = XSControl.Reader
type Bnd_Box = Bnd.Box
type Bnd_OBB = Bnd.OBB
type STEPControl_Writer = STEPControl.Writer
type STEPControl_Reader = STEPControl.Reader
type RWGltf_CafWriter = RWGltf.CafWriter
type RWGltf_CafReader = RWGltf.CafReader
type ShapeFix_Solid = ShapeFix.Solid
type StlAPI_Writer = StlAPI.Writer
type StlAPI_Reader = StlAPI.Reader

main.hs

{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE OverloadedStrings #-}
import Waterfall
import Waterfall.Internal.Solid
import Linear

import qualified Language.C.Inline.Cpp as C
import qualified Language.C.Inline.Context as CC
import           Foreign
import           Foreign.C
import qualified Data.Map as M

import qualified Language.C.Types as C

import Cxt
import qualified Waterfall as W

C.context $ 
  C.cppCtx <>
  C.cppCtx { CC.ctxTypesTable = Cxt.occtTypes  <> M.fromList [
        -- table 1 https://dev.opencascade.org/doc/overview/html/occt_user_guides__foundation_classes.html
        (C.TypeName "Standard_Integer", [t|CInt|]),
        (C.TypeName "Standard_Real", [t|CDouble|]),
        (C.TypeName "Standard_ShortReal", [t|CFloat|]),
        (C.TypeName "Standard_Boolean", [t|CBool|]),
        (C.TypeName "Standard_Character", [t|CUChar|]),
        (C.TypeName "Standard_Utf16Char", [t| Word16 |]), -- char16_t
        (C.TypeName "Standard_CString", [t|CString|]),
        (C.TypeName "Standard_Address", [t|Ptr ()|]),
        (C.TypeName "Standard_ExtString", [t| Ptr Word16 |]) -- char16_t*
        ],

        CC.ctxAntiQuoters = M.singleton "V3" $ CC.SomeAntiQuoter CC.AntiQuoter {
                -- TODO:
                -- $V3:x
                CC.aqParser = return undefined,
                CC.aqMarshaller = \_purity _ttable _cid () -> return undefined
        }
    }

C.include "<BRepIntCurveSurface_Inter.hxx>"
C.include "<IntCurvesFace_ShapeIntersector.hxx>"
C.include "<BRepBndLib.hxx>"

aabb :: W.Solid -> IO (Ptr Bnd_Box)
aabb s = do
    let x = rawSolid s
    [C.block| Bnd_Box*{
          TopoDS_Shape* shape = $(TopoDS_Shape* x);
          Bnd_Box* box = new Bnd_Box();
          BRepBndLib::AddOptimal(*shape, *box, true, false);
          return box;
      } |]

main = do
  let b = box (V3 10 10 10)
  bb <- aabb b
  [C.exp| double{ $(Bnd_Box* bb)->SquareExtent() } |] >>= print
  -- prints 300 as expected

mkCxt.sh

#!/bin/bash

echo "-- autogenerated by mkCxt.sh. defines a CC.ctxTypesTable based on the Types.hs files in opencascade-hs
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
module Cxt where
import Data.Map (fromList)
import qualified Language.C.Inline.Cpp as C
import qualified Language.C.Types as C
import qualified Language.C.Inline.Context as C
" > Cxt.hs

imports() {
# call ghc-pkg with the package-id and package-db flags
# from the newest .ghc.environment file in the current directory

# first get the file:
ENVFILE=$(ls -t .ghc.environment.* | head -n 1)
dbflag=$(egrep '^package-db' $ENVFILE | sed 's/^/--/')

# import qualified OpenCascade.BRepBuilderAPI.Types as BRepBuilderAPI etc.
ghc-pkg field opencascade-hs exposed-modules --simple-output $dbflag \
        | sed 's/ /\n/g' \
        | grep Types \
        | sed 's/^/import qualified /' \
        | sed 's/\.\([a-zA-Z]*\)\.Types/.\1.Types as \1/'
}


aliasfile=$(mktemp)
proc1() {
        q=$(basename $(dirname $1))
        grep '^data ' $1 | awk -F' ' '{print " , (C.TypeName \"'$q'_"$2"\", [t| '$q'."$2 " |])"}'

        # the same but "type $q_$2 = $q.$2"
        grep '^data ' $1 | awk -F' ' '{print "type '$q'_"$2" = '$q'."$2}' >> $aliasfile
}

cxtDecl() {
        echo "occtTypes :: C.TypesTable"
        echo "occtTypes = fromList ["
        # oocthsdir=$HOME/wip/opencascade-hs/opencascade-hs
        oocthsdir=opencascade-hs-0.2.2.0
        if [ ! -d $oocthsdir ]; then
                # instead get it from github, cabal unpack opencascade-hs?
                echo "$oocthsdir must be the opencascade-hs package source (cabal unpack opencascade-hs)" >&2
                exit 1
        fi

        for f in $(find $oocthsdir -name 'Types.hs'); do
                if [ $? -eq 0 ]; then
                        echo ""
                fi
                proc1 $f $?
        done | tail -c +4
        echo " ]"
}


imports >> Cxt.hs
cxtDecl >> Cxt.hs
cat $aliasfile >> Cxt.hs
rm $aliasfile
echo "done"