{-# LANGUAGE CApiFFI #-}
module OpenCascade.TopoDS.Shape
( Shape
, new
, copy
, isNull
, nullify
, location
, setLocation
, located
, orientation
, setOrientation
, oriented
, shapeType
, free
, setFree
, locked
, setLocked
, modified
, setModified
, checked
, setChecked
, orientable
, setOrientable
, closed
, setClosed
, infinite
, setInfinite
, convex
, setConvex
, move
, moved
, nbChildren
, reverse
, reversed
, complement
, complemented
, isEqual
, isPartner
, isSame
, isNotEqual
, emptyCopy
, emptyCopied
, hashCode
) where

import Prelude hiding (reverse)
import OpenCascade.TopoDS.Types
import OpenCascade.TopoDS.Internal.Destructors
import OpenCascade.Internal.Bool
import Foreign.C
import Foreign.Ptr
import Data.Acquire 

import qualified OpenCascade.TopLoc as TopLoc
import qualified OpenCascade.TopLoc.Internal.Destructors as TopLoc.Destructors
import qualified OpenCascade.TopAbs as TopAbs
-- new

foreign import capi unsafe "hs_TopoDS_Shape.h hs_new_TopoDS_Shape" rawNew :: IO (Ptr Shape)

new :: Acquire (Ptr Shape)
new :: Acquire (Ptr Shape)
new = IO (Ptr Shape) -> (Ptr Shape -> IO ()) -> Acquire (Ptr Shape)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire IO (Ptr Shape)
rawNew  Ptr Shape -> IO ()
deleteShape

-- copy

foreign import capi unsafe "hs_TopoDS_Shape.h hs_new_TopoDS_Shape_copy" rawCopy :: Ptr Shape -> IO (Ptr Shape)

copy :: Ptr Shape -> Acquire (Ptr Shape)
copy :: Ptr Shape -> Acquire (Ptr Shape)
copy Ptr Shape
shape = IO (Ptr Shape) -> (Ptr Shape -> IO ()) -> Acquire (Ptr Shape)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Shape -> IO (Ptr Shape)
rawCopy Ptr Shape
shape)  Ptr Shape -> IO ()
deleteShape

-- isNull 
--
foreign import capi unsafe "hs_TopoDS_Shape.h hs_TopoDS_Shape_IsNull" rawIsNull :: Ptr Shape -> IO CBool

isNull :: Ptr Shape -> IO Bool
isNull :: Ptr Shape -> IO Bool
isNull Ptr Shape
s = CBool -> Bool
cBoolToBool (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Shape -> IO CBool
rawIsNull Ptr Shape
s

-- Nullify 
--
foreign import capi unsafe "hs_TopoDS_Shape.h hs_TopoDS_Shape_Nullify" nullify :: Ptr Shape -> IO ()

-- location 
--
foreign import capi unsafe "hs_TopoDS_Shape.h hs_TopoDS_Shape_Location" rawLocation :: Ptr Shape -> IO (Ptr TopLoc.Location)

location :: Ptr Shape -> Acquire (Ptr TopLoc.Location)
location :: Ptr Shape -> Acquire (Ptr Location)
location Ptr Shape
s = IO (Ptr Location)
-> (Ptr Location -> IO ()) -> Acquire (Ptr Location)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Shape -> IO (Ptr Location)
rawLocation Ptr Shape
s) Ptr Location -> IO ()
TopLoc.Destructors.deleteLocation  

-- setLocation 
--

foreign import capi unsafe "hs_TopoDS_Shape.h hs_TopoDS_Shape_SetLocation" setLocation :: Ptr Shape -> Ptr TopLoc.Location -> IO ()

-- located
--
foreign import capi unsafe "hs_TopoDS_Shape.h hs_TopoDS_Shape_Located" rawLocated :: Ptr Shape -> Ptr TopLoc.Location -> IO (Ptr Shape)

located :: Ptr Shape -> Ptr TopLoc.Location -> Acquire (Ptr Shape)
located :: Ptr Shape -> Ptr Location -> Acquire (Ptr Shape)
located Ptr Shape
s Ptr Location
l = IO (Ptr Shape) -> (Ptr Shape -> IO ()) -> Acquire (Ptr Shape)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Shape -> Ptr Location -> IO (Ptr Shape)
rawLocated Ptr Shape
s Ptr Location
l) Ptr Shape -> IO ()
deleteShape


-- orientation

foreign import capi unsafe "hs_TopoDS_Shape.h hs_TopoDS_Shape_Orientation" rawOrientation :: Ptr Shape -> IO (CInt)

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

-- setOrientation

foreign import capi unsafe "hs_TopoDS_Shape.h hs_TopoDS_Shape_SetOrientation" rawSetOrientation :: Ptr Shape -> CInt -> IO ()

setOrientation :: Ptr Shape -> TopAbs.Orientation -> IO ()
setOrientation :: Ptr Shape -> Orientation -> IO ()
setOrientation Ptr Shape
s Orientation
o = Ptr Shape -> CInt -> IO ()
rawSetOrientation Ptr Shape
s (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Orientation -> Int) -> Orientation -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Orientation -> Int
forall a. Enum a => a -> Int
fromEnum (Orientation -> CInt) -> Orientation -> CInt
forall a b. (a -> b) -> a -> b
$ Orientation
o) 


-- oriented
--
foreign import capi unsafe "hs_TopoDS_Shape.h hs_TopoDS_Shape_Oriented" rawOriented :: Ptr Shape -> CInt -> IO (Ptr Shape)

oriented :: Ptr Shape -> TopAbs.Orientation -> Acquire (Ptr Shape)
oriented :: Ptr Shape -> Orientation -> Acquire (Ptr Shape)
oriented Ptr Shape
s Orientation
o = IO (Ptr Shape) -> (Ptr Shape -> IO ()) -> Acquire (Ptr Shape)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Shape -> CInt -> IO (Ptr Shape)
rawOriented Ptr Shape
s (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Orientation -> Int) -> Orientation -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Orientation -> Int
forall a. Enum a => a -> Int
fromEnum (Orientation -> CInt) -> Orientation -> CInt
forall a b. (a -> b) -> a -> b
$ Orientation
o)) Ptr Shape -> IO ()
deleteShape

-- shapeType 
--
foreign import capi unsafe "hs_TopoDS_Shape.h hs_TopoDS_Shape_ShapeType" rawShapeType :: Ptr Shape -> IO CInt

shapeType :: Ptr Shape -> IO TopAbs.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

-- free

foreign import capi unsafe "hs_TopoDS_Shape.h hs_TopoDS_Shape_Free" rawFree :: Ptr Shape -> IO CBool

free :: Ptr Shape -> IO Bool
free :: Ptr Shape -> IO Bool
free Ptr Shape
s = CBool -> Bool
cBoolToBool (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Shape -> IO CBool
rawFree Ptr Shape
s

--setFree 

foreign import capi unsafe "hs_TopoDS_Shape.h hs_TopoDS_Shape_SetFree" rawSetFree :: Ptr Shape -> CBool-> IO ()

setFree :: Ptr Shape -> Bool -> IO ()
setFree :: Ptr Shape -> Bool -> IO ()
setFree Ptr Shape
s Bool
b = Ptr Shape -> CBool -> IO ()
rawSetFree Ptr Shape
s (Bool -> CBool
boolToCBool Bool
b)

-- locked

foreign import capi unsafe "hs_TopoDS_Shape.h hs_TopoDS_Shape_Locked" rawLocked :: Ptr Shape -> IO CBool

locked :: Ptr Shape -> IO Bool
locked :: Ptr Shape -> IO Bool
locked Ptr Shape
s = CBool -> Bool
cBoolToBool (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Shape -> IO CBool
rawLocked Ptr Shape
s

--setLocked 

foreign import capi unsafe "hs_TopoDS_Shape.h hs_TopoDS_Shape_SetLocked" rawSetLocked :: Ptr Shape -> CBool-> IO ()

setLocked :: Ptr Shape -> Bool -> IO ()
setLocked :: Ptr Shape -> Bool -> IO ()
setLocked Ptr Shape
s Bool
b = Ptr Shape -> CBool -> IO ()
rawSetLocked Ptr Shape
s (Bool -> CBool
boolToCBool Bool
b)



-- modified

foreign import capi unsafe "hs_TopoDS_Shape.h hs_TopoDS_Shape_Modified" rawModified :: Ptr Shape -> IO CBool

modified :: Ptr Shape -> IO Bool
modified :: Ptr Shape -> IO Bool
modified Ptr Shape
s = CBool -> Bool
cBoolToBool (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Shape -> IO CBool
rawModified Ptr Shape
s

--setModified 

foreign import capi unsafe "hs_TopoDS_Shape.h hs_TopoDS_Shape_SetModified" rawSetModified :: Ptr Shape -> CBool-> IO ()

setModified :: Ptr Shape -> Bool -> IO ()
setModified :: Ptr Shape -> Bool -> IO ()
setModified Ptr Shape
s Bool
b = Ptr Shape -> CBool -> IO ()
rawSetModified Ptr Shape
s (Bool -> CBool
boolToCBool Bool
b)


-- checked

foreign import capi unsafe "hs_TopoDS_Shape.h hs_TopoDS_Shape_Checked" rawChecked :: Ptr Shape -> IO CBool

checked :: Ptr Shape -> IO Bool
checked :: Ptr Shape -> IO Bool
checked Ptr Shape
s = CBool -> Bool
cBoolToBool (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Shape -> IO CBool
rawChecked Ptr Shape
s

--setChecked 

foreign import capi unsafe "hs_TopoDS_Shape.h hs_TopoDS_Shape_SetChecked" rawSetChecked :: Ptr Shape -> CBool-> IO ()

setChecked :: Ptr Shape -> Bool -> IO ()
setChecked :: Ptr Shape -> Bool -> IO ()
setChecked Ptr Shape
s Bool
b = Ptr Shape -> CBool -> IO ()
rawSetChecked Ptr Shape
s (Bool -> CBool
boolToCBool Bool
b)

-- orientable

foreign import capi unsafe "hs_TopoDS_Shape.h hs_TopoDS_Shape_Orientable" rawOrientable :: Ptr Shape -> IO CBool

orientable :: Ptr Shape -> IO Bool
orientable :: Ptr Shape -> IO Bool
orientable Ptr Shape
s = CBool -> Bool
cBoolToBool (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Shape -> IO CBool
rawOrientable Ptr Shape
s

--setOrientable 

foreign import capi unsafe "hs_TopoDS_Shape.h hs_TopoDS_Shape_SetOrientable" rawSetOrientable :: Ptr Shape -> CBool-> IO ()

setOrientable :: Ptr Shape -> Bool -> IO ()
setOrientable :: Ptr Shape -> Bool -> IO ()
setOrientable Ptr Shape
s Bool
b = Ptr Shape -> CBool -> IO ()
rawSetOrientable Ptr Shape
s (Bool -> CBool
boolToCBool Bool
b)

-- closed

foreign import capi unsafe "hs_TopoDS_Shape.h hs_TopoDS_Shape_Closed" rawClosed :: Ptr Shape -> IO CBool

closed :: Ptr Shape -> IO Bool
closed :: Ptr Shape -> IO Bool
closed Ptr Shape
s = CBool -> Bool
cBoolToBool (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Shape -> IO CBool
rawClosed Ptr Shape
s

--setClosed 

foreign import capi unsafe "hs_TopoDS_Shape.h hs_TopoDS_Shape_SetClosed" rawSetClosed :: Ptr Shape -> CBool-> IO ()

setClosed :: Ptr Shape -> Bool -> IO ()
setClosed :: Ptr Shape -> Bool -> IO ()
setClosed Ptr Shape
s Bool
b = Ptr Shape -> CBool -> IO ()
rawSetClosed Ptr Shape
s (Bool -> CBool
boolToCBool Bool
b)


-- infinite

foreign import capi unsafe "hs_TopoDS_Shape.h hs_TopoDS_Shape_Infinite" rawInfinite :: Ptr Shape -> IO CBool

infinite :: Ptr Shape -> IO Bool
infinite :: Ptr Shape -> IO Bool
infinite Ptr Shape
s = CBool -> Bool
cBoolToBool (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Shape -> IO CBool
rawInfinite Ptr Shape
s

--setInfinite 

foreign import capi unsafe "hs_TopoDS_Shape.h hs_TopoDS_Shape_SetInfinite" rawSetInfinite :: Ptr Shape -> CBool-> IO ()

setInfinite :: Ptr Shape -> Bool -> IO ()
setInfinite :: Ptr Shape -> Bool -> IO ()
setInfinite Ptr Shape
s Bool
b = Ptr Shape -> CBool -> IO ()
rawSetInfinite Ptr Shape
s (Bool -> CBool
boolToCBool Bool
b)



-- convex

foreign import capi unsafe "hs_TopoDS_Shape.h hs_TopoDS_Shape_Convex" rawConvex :: Ptr Shape -> IO CBool

convex :: Ptr Shape -> IO Bool
convex :: Ptr Shape -> IO Bool
convex Ptr Shape
s = CBool -> Bool
cBoolToBool (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Shape -> IO CBool
rawConvex Ptr Shape
s

--setConvex 

foreign import capi unsafe "hs_TopoDS_Shape.h hs_TopoDS_Shape_SetConvex" rawSetConvex :: Ptr Shape -> CBool-> IO ()

setConvex :: Ptr Shape -> Bool -> IO ()
setConvex :: Ptr Shape -> Bool -> IO ()
setConvex Ptr Shape
s Bool
b = Ptr Shape -> CBool -> IO ()
rawSetConvex Ptr Shape
s (Bool -> CBool
boolToCBool Bool
b)


-- move
--

foreign import capi unsafe "hs_TopoDS_Shape.h hs_TopoDS_Shape_Move" move :: Ptr Shape -> Ptr TopLoc.Location -> IO ()

-- moved
--
foreign import capi unsafe "hs_TopoDS_Shape.h hs_TopoDS_Shape_Moved" rawMoved :: Ptr Shape -> Ptr TopLoc.Location -> IO (Ptr Shape)

moved :: Ptr Shape -> Ptr TopLoc.Location -> Acquire (Ptr Shape)
moved :: Ptr Shape -> Ptr Location -> Acquire (Ptr Shape)
moved Ptr Shape
s Ptr Location
l = IO (Ptr Shape) -> (Ptr Shape -> IO ()) -> Acquire (Ptr Shape)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Shape -> Ptr Location -> IO (Ptr Shape)
rawMoved Ptr Shape
s Ptr Location
l) Ptr Shape -> IO ()
deleteShape

-- nbChildren

foreign import capi unsafe "hs_TopoDS_Shape.h hs_TopoDS_Shape_NbChildren" rawNbChildren :: Ptr Shape -> IO (CInt)

nbChildren :: Ptr Shape -> IO Int
nbChildren :: Ptr Shape -> IO Int
nbChildren Ptr Shape
s = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Shape -> IO CInt
rawNbChildren Ptr Shape
s

-- reverse
--

foreign import capi unsafe "hs_TopoDS_Shape.h hs_TopoDS_Shape_Reverse" reverse :: Ptr Shape -> IO ()

-- reversed
--
foreign import capi unsafe "hs_TopoDS_Shape.h hs_TopoDS_Shape_Reversed" rawReversed :: Ptr Shape -> IO (Ptr Shape)

reversed :: Ptr Shape -> Acquire (Ptr Shape)
reversed :: Ptr Shape -> Acquire (Ptr Shape)
reversed Ptr Shape
s = IO (Ptr Shape) -> (Ptr Shape -> IO ()) -> Acquire (Ptr Shape)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Shape -> IO (Ptr Shape)
rawReversed Ptr Shape
s) Ptr Shape -> IO ()
deleteShape


-- complement
--

foreign import capi unsafe "hs_TopoDS_Shape.h hs_TopoDS_Shape_Complement" complement :: Ptr Shape -> IO ()

-- complemented
--
foreign import capi unsafe "hs_TopoDS_Shape.h hs_TopoDS_Shape_Complemented" rawComplemented :: Ptr Shape -> IO (Ptr Shape)

complemented :: Ptr Shape -> Acquire (Ptr Shape)
complemented :: Ptr Shape -> Acquire (Ptr Shape)
complemented Ptr Shape
s = IO (Ptr Shape) -> (Ptr Shape -> IO ()) -> Acquire (Ptr Shape)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Shape -> IO (Ptr Shape)
rawComplemented Ptr Shape
s) Ptr Shape -> IO ()
deleteShape

-- isEqual

foreign import capi unsafe "hs_TopoDS_Shape.h hs_TopoDS_Shape_IsEqual" rawIsEqual :: Ptr Shape -> Ptr Shape -> IO CBool

isEqual :: Ptr Shape -> Ptr Shape -> IO Bool
isEqual :: Ptr Shape -> Ptr Shape -> IO Bool
isEqual Ptr Shape
a Ptr Shape
b = CBool -> Bool
cBoolToBool (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Shape -> Ptr Shape -> IO CBool
rawIsEqual Ptr Shape
a Ptr Shape
b


-- isSame

foreign import capi unsafe "hs_TopoDS_Shape.h hs_TopoDS_Shape_IsSame" rawIsSame :: Ptr Shape -> Ptr Shape -> IO CBool

isSame :: Ptr Shape -> Ptr Shape -> IO Bool
isSame :: Ptr Shape -> Ptr Shape -> IO Bool
isSame Ptr Shape
a Ptr Shape
b = CBool -> Bool
cBoolToBool (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Shape -> Ptr Shape -> IO CBool
rawIsSame Ptr Shape
a Ptr Shape
b


-- isPartner

foreign import capi unsafe "hs_TopoDS_Shape.h hs_TopoDS_Shape_IsPartner" rawIsPartner :: Ptr Shape -> Ptr Shape -> IO CBool

isPartner :: Ptr Shape -> Ptr Shape -> IO Bool
isPartner :: Ptr Shape -> Ptr Shape -> IO Bool
isPartner Ptr Shape
a Ptr Shape
b = CBool -> Bool
cBoolToBool (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Shape -> Ptr Shape -> IO CBool
rawIsPartner Ptr Shape
a Ptr Shape
b

-- isNotEqual

foreign import capi unsafe "hs_TopoDS_Shape.h hs_TopoDS_Shape_IsNotEqual" rawIsNotEqual :: Ptr Shape -> Ptr Shape -> IO CBool

isNotEqual :: Ptr Shape -> Ptr Shape -> IO Bool
isNotEqual :: Ptr Shape -> Ptr Shape -> IO Bool
isNotEqual Ptr Shape
a Ptr Shape
b = CBool -> Bool
cBoolToBool (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Shape -> Ptr Shape -> IO CBool
rawIsNotEqual Ptr Shape
a Ptr Shape
b

-- emptyCopy
--

foreign import capi unsafe "hs_TopoDS_Shape.h hs_TopoDS_Shape_EmptyCopy" emptyCopy :: Ptr Shape -> IO ()

-- emptyCopied
--
foreign import capi unsafe "hs_TopoDS_Shape.h hs_TopoDS_Shape_EmptyCopied" rawEmptyCopied :: Ptr Shape -> IO (Ptr Shape)

emptyCopied :: Ptr Shape -> Acquire (Ptr Shape)
emptyCopied :: Ptr Shape -> Acquire (Ptr Shape)
emptyCopied Ptr Shape
s = IO (Ptr Shape) -> (Ptr Shape -> IO ()) -> Acquire (Ptr Shape)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Shape -> IO (Ptr Shape)
rawEmptyCopied Ptr Shape
s) Ptr Shape -> IO ()
deleteShape


foreign import capi unsafe "hs_TopoDS_Shape.h hs_TopoDS_Shape_hashCode" rawHashCode :: Ptr Shape -> CInt -> IO CInt

hashCode :: Ptr Shape -> Int -> IO Int
hashCode :: Ptr Shape -> Int -> IO Int
hashCode Ptr Shape
shape Int
upperBound = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Shape -> CInt -> IO CInt
rawHashCode Ptr Shape
shape (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
upperBound)