{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE CApiFFI #-}
module OpenCascade.TopoDS.Types
( Shape
, CompSolid
, Compound
, Edge
, Face
, Shell
, Solid
, Vertex
, Wire
, Builder
)

where


import OpenCascade.Inheritance
import OpenCascade.TopAbs.ShapeEnum
import qualified OpenCascade.TopAbs.ShapeEnum as ShapeEnum
import Foreign.Ptr
import Foreign.C


data Shape
data CompSolid
data Compound
data Edge
data Face
data Shell
data Solid
data Vertex
data Wire

data Builder

-- duplicate definition of shape type from TopoDS.Shape
-- to simultaniously avoid Orphan Instances + circular dependencies
foreign import capi unsafe "hs_TopoDS_Shape.h hs_TopoDS_Shape_ShapeType" rawShapeType :: Ptr Shape -> IO CInt

shapeType :: Ptr Shape -> IO ShapeEnum
shapeType :: Ptr Shape -> IO ShapeEnum
shapeType Ptr Shape
s = Int -> ShapeEnum
forall a. Enum a => Int -> a
toEnum (Int -> ShapeEnum) -> (CInt -> Int) -> CInt -> ShapeEnum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> ShapeEnum) -> IO CInt -> IO ShapeEnum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Shape -> IO CInt
rawShapeType Ptr Shape
s

enumDowncast :: ShapeEnum -> Ptr Shape -> IO (Maybe (Ptr t))
enumDowncast :: forall t. ShapeEnum -> Ptr Shape -> IO (Maybe (Ptr t))
enumDowncast ShapeEnum
enum Ptr Shape
p = do
    ShapeEnum
e <- Ptr Shape -> IO ShapeEnum
shapeType Ptr Shape
p
    Maybe (Ptr t) -> IO (Maybe (Ptr t))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Ptr t) -> IO (Maybe (Ptr t)))
-> Maybe (Ptr t) -> IO (Maybe (Ptr t))
forall a b. (a -> b) -> a -> b
$ if ShapeEnum
e ShapeEnum -> ShapeEnum -> Bool
forall a. Eq a => a -> a -> Bool
== ShapeEnum
enum 
                then Ptr t -> Maybe (Ptr t)
forall a. a -> Maybe a
Just (Ptr Shape -> Ptr t
forall a b. Ptr a -> Ptr b
castPtr Ptr Shape
p)
                else Maybe (Ptr t)
forall a. Maybe a
Nothing


instance SubTypeOf Shape Compound

instance DiscriminatedSubTypeOf Shape Compound where
    downcast :: Ptr Shape -> IO (Maybe (Ptr Compound))
downcast = ShapeEnum -> Ptr Shape -> IO (Maybe (Ptr Compound))
forall t. ShapeEnum -> Ptr Shape -> IO (Maybe (Ptr t))
enumDowncast ShapeEnum
ShapeEnum.Compound


instance SubTypeOf Shape CompSolid

instance DiscriminatedSubTypeOf Shape CompSolid where
    downcast :: Ptr Shape -> IO (Maybe (Ptr CompSolid))
downcast = ShapeEnum -> Ptr Shape -> IO (Maybe (Ptr CompSolid))
forall t. ShapeEnum -> Ptr Shape -> IO (Maybe (Ptr t))
enumDowncast ShapeEnum
ShapeEnum.CompSolid


instance SubTypeOf Shape Solid

instance DiscriminatedSubTypeOf Shape Solid where
    downcast :: Ptr Shape -> IO (Maybe (Ptr Solid))
downcast = ShapeEnum -> Ptr Shape -> IO (Maybe (Ptr Solid))
forall t. ShapeEnum -> Ptr Shape -> IO (Maybe (Ptr t))
enumDowncast ShapeEnum
ShapeEnum.Solid


instance SubTypeOf Shape Shell

instance DiscriminatedSubTypeOf Shape Shell where
    downcast :: Ptr Shape -> IO (Maybe (Ptr Shell))
downcast = ShapeEnum -> Ptr Shape -> IO (Maybe (Ptr Shell))
forall t. ShapeEnum -> Ptr Shape -> IO (Maybe (Ptr t))
enumDowncast ShapeEnum
ShapeEnum.Shell


instance SubTypeOf Shape Face

instance DiscriminatedSubTypeOf Shape Face where
    downcast :: Ptr Shape -> IO (Maybe (Ptr Face))
downcast = ShapeEnum -> Ptr Shape -> IO (Maybe (Ptr Face))
forall t. ShapeEnum -> Ptr Shape -> IO (Maybe (Ptr t))
enumDowncast ShapeEnum
ShapeEnum.Face

instance SubTypeOf Shape Wire

instance DiscriminatedSubTypeOf Shape Wire where
    downcast :: Ptr Shape -> IO (Maybe (Ptr Wire))
downcast = ShapeEnum -> Ptr Shape -> IO (Maybe (Ptr Wire))
forall t. ShapeEnum -> Ptr Shape -> IO (Maybe (Ptr t))
enumDowncast ShapeEnum
ShapeEnum.Wire


instance SubTypeOf Shape Edge

instance DiscriminatedSubTypeOf Shape Edge where
    downcast :: Ptr Shape -> IO (Maybe (Ptr Edge))
downcast = ShapeEnum -> Ptr Shape -> IO (Maybe (Ptr Edge))
forall t. ShapeEnum -> Ptr Shape -> IO (Maybe (Ptr t))
enumDowncast ShapeEnum
ShapeEnum.Edge


instance SubTypeOf Shape Vertex

instance DiscriminatedSubTypeOf Shape Vertex where
    downcast :: Ptr Shape -> IO (Maybe (Ptr Vertex))
downcast = ShapeEnum -> Ptr Shape -> IO (Maybe (Ptr Vertex))
forall t. ShapeEnum -> Ptr Shape -> IO (Maybe (Ptr t))
enumDowncast ShapeEnum
ShapeEnum.Vertex