module Waterfall.IO
( WaterfallIOException (..)
, WaterfallIOExceptionCause (..)
  -- * Solid Writers
, writeSolid
, writeSTL
, writeAsciiSTL
, writeSTEP
, writeGLTF
, writeGLB
, writeOBJ
  -- * Solid Readers
  -- 
  -- | Load a `Waterfall.Solid` from a file
  --
  -- At present, the "read*" functions do slightly less validation on the loaded solid 
  -- than they arguably should  
  -- and may succeed when reading solids that may generate invalid geometry when processed
, readSolid
, readSTL
, readSTEP
, readGLTF
, readGLB
, readOBJ
) where 

import Waterfall.Internal.Solid (Solid(..))
import qualified Waterfall.Internal.Remesh as Remesh
import qualified OpenCascade.BRepMesh.IncrementalMesh as BRepMesh.IncrementalMesh
import qualified OpenCascade.StlAPI.Writer as StlWriter
import qualified OpenCascade.StlAPI.Reader as StlReader
import qualified OpenCascade.STEPControl.Writer as StepWriter
import qualified OpenCascade.STEPControl.StepModelType as StepModelType
import qualified OpenCascade.STEPControl.Reader as STEPReader
import qualified OpenCascade.XSControl.Reader as XSControl.Reader
import qualified OpenCascade.IFSelect.ReturnStatus as IFSelect.ReturnStatus
import qualified OpenCascade.TDocStd.Document as TDocStd.Document
import qualified OpenCascade.Message.Types as Message
import qualified OpenCascade.Message.ProgressRange as Message.ProgressRange
import qualified OpenCascade.TColStd.IndexedDataMapOfStringString as TColStd.IndexedDataMapOfStringString
import qualified OpenCascade.RWGltf.CafWriter as RWGltf.CafWriter
import qualified OpenCascade.RWGltf.CafReader as RWGltf.CafReader
import qualified OpenCascade.RWObj.CafWriter as RWObj.CafWriter
import qualified OpenCascade.RWObj.CafReader as RWObj.CafReader
import qualified OpenCascade.RWMesh.Types as RWMesh
import qualified OpenCascade.RWMesh.CafReader as RWMesh.CafReader
import qualified OpenCascade.TDocStd.Types as TDocStd
import qualified OpenCascade.TColStd.Types as TColStd
import qualified OpenCascade.XCAFDoc.DocumentTool as XCafDoc.DocumentTool
import qualified OpenCascade.XCAFDoc.ShapeTool as XCafDoc.ShapeTool
import qualified OpenCascade.TopoDS.Types as TopoDS
import qualified OpenCascade.TopoDS.Shape as TopoDS.Shape
import OpenCascade.Handle (Handle)
import OpenCascade.Inheritance (upcast)
import Control.Monad.IO.Class (liftIO)
import Control.Monad (unless, when)
import Waterfall.Internal.Finalizers (toAcquire, fromAcquire)
import Data.Acquire ( Acquire, withAcquire )
import Foreign.Ptr (Ptr)
import Data.Char (toLower)
import System.FilePath (takeExtension)
import Control.Exception (Exception, throwIO)

-- | The type of exceptions thrown by IO actions defined in `Waterfall.IO`
data WaterfallIOException = 
    WaterfallIOException 
      { WaterfallIOException -> WaterfallIOExceptionCause
ioExceptionCause :: WaterfallIOExceptionCause
      , WaterfallIOException -> FilePath
ioExceptionFilePath :: FilePath 
      }
    deriving Int -> WaterfallIOException -> ShowS
[WaterfallIOException] -> ShowS
WaterfallIOException -> FilePath
(Int -> WaterfallIOException -> ShowS)
-> (WaterfallIOException -> FilePath)
-> ([WaterfallIOException] -> ShowS)
-> Show WaterfallIOException
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WaterfallIOException -> ShowS
showsPrec :: Int -> WaterfallIOException -> ShowS
$cshow :: WaterfallIOException -> FilePath
show :: WaterfallIOException -> FilePath
$cshowList :: [WaterfallIOException] -> ShowS
showList :: [WaterfallIOException] -> ShowS
Show

instance Exception WaterfallIOException

-- | Reason for an IO action to have failed
data WaterfallIOExceptionCause = 
    -- | Something went wrong when accessing a file,
    -- eg. a write to a file path that is unreachable,
    -- or a read to a file in the wrong format 
    FileError  
    -- | The contents of a file could not be converted into a `Waterfall.Solid`
    -- e.g the file did not contain a solid object
    | BadGeometryError
    -- | The `readSolid`/`writeSolid` functions could not infer the correct file format from a filepath
    | UnrecognizedFormatError 
    deriving (Int -> WaterfallIOExceptionCause -> ShowS
[WaterfallIOExceptionCause] -> ShowS
WaterfallIOExceptionCause -> FilePath
(Int -> WaterfallIOExceptionCause -> ShowS)
-> (WaterfallIOExceptionCause -> FilePath)
-> ([WaterfallIOExceptionCause] -> ShowS)
-> Show WaterfallIOExceptionCause
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WaterfallIOExceptionCause -> ShowS
showsPrec :: Int -> WaterfallIOExceptionCause -> ShowS
$cshow :: WaterfallIOExceptionCause -> FilePath
show :: WaterfallIOExceptionCause -> FilePath
$cshowList :: [WaterfallIOExceptionCause] -> ShowS
showList :: [WaterfallIOExceptionCause] -> ShowS
Show, WaterfallIOExceptionCause -> WaterfallIOExceptionCause -> Bool
(WaterfallIOExceptionCause -> WaterfallIOExceptionCause -> Bool)
-> (WaterfallIOExceptionCause -> WaterfallIOExceptionCause -> Bool)
-> Eq WaterfallIOExceptionCause
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WaterfallIOExceptionCause -> WaterfallIOExceptionCause -> Bool
== :: WaterfallIOExceptionCause -> WaterfallIOExceptionCause -> Bool
$c/= :: WaterfallIOExceptionCause -> WaterfallIOExceptionCause -> Bool
/= :: WaterfallIOExceptionCause -> WaterfallIOExceptionCause -> Bool
Eq)


extensionToFormats :: String -> Maybe (Double -> FilePath -> Solid -> IO(), FilePath -> IO Solid)
extensionToFormats :: FilePath
-> Maybe
     (Double -> FilePath -> Solid -> IO (), FilePath -> IO Solid)
extensionToFormats FilePath
s =
    let ext :: FilePath
ext = (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toLower ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
takeExtension ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ FilePath
s 
     in case FilePath
ext of  
        FilePath
".stl" -> (Double -> FilePath -> Solid -> IO (), FilePath -> IO Solid)
-> Maybe
     (Double -> FilePath -> Solid -> IO (), FilePath -> IO Solid)
forall a. a -> Maybe a
Just (Double -> FilePath -> Solid -> IO ()
writeSTL, FilePath -> IO Solid
readSTL)
        FilePath
".step" -> (Double -> FilePath -> Solid -> IO (), FilePath -> IO Solid)
-> Maybe
     (Double -> FilePath -> Solid -> IO (), FilePath -> IO Solid)
forall a. a -> Maybe a
Just ((FilePath -> Solid -> IO ())
-> Double -> FilePath -> Solid -> IO ()
forall a b. a -> b -> a
const FilePath -> Solid -> IO ()
writeSTEP, FilePath -> IO Solid
readSTEP)
        FilePath
".gltf" -> (Double -> FilePath -> Solid -> IO (), FilePath -> IO Solid)
-> Maybe
     (Double -> FilePath -> Solid -> IO (), FilePath -> IO Solid)
forall a. a -> Maybe a
Just (Double -> FilePath -> Solid -> IO ()
writeGLTF, FilePath -> IO Solid
readGLTF)
        FilePath
".glb" -> (Double -> FilePath -> Solid -> IO (), FilePath -> IO Solid)
-> Maybe
     (Double -> FilePath -> Solid -> IO (), FilePath -> IO Solid)
forall a. a -> Maybe a
Just (Double -> FilePath -> Solid -> IO ()
writeGLB, FilePath -> IO Solid
readGLB)
        FilePath
".obj" -> (Double -> FilePath -> Solid -> IO (), FilePath -> IO Solid)
-> Maybe
     (Double -> FilePath -> Solid -> IO (), FilePath -> IO Solid)
forall a. a -> Maybe a
Just (Double -> FilePath -> Solid -> IO ()
writeOBJ, FilePath -> IO Solid
readOBJ)
        FilePath
_ -> Maybe (Double -> FilePath -> Solid -> IO (), FilePath -> IO Solid)
forall a. Maybe a
Nothing

-- | Write a `Solid` to a file, work out the format from the file extension
-- 
-- Errors if passed a filename with an unrecognized extension
--
-- Because BRep representations of objects can store arbitrary precision curves,
-- but some of the supported file formats store triangulated surfaces, 
-- this function takes a "deflection" argument used to discretize curves.
--
-- The deflection is the maximum allowable distance between a curve and the generated triangulation.
writeSolid :: Double -> FilePath -> Solid -> IO ()
writeSolid :: Double -> FilePath -> Solid -> IO ()
writeSolid Double
res FilePath
filepath = 
    case FilePath
-> Maybe
     (Double -> FilePath -> Solid -> IO (), FilePath -> IO Solid)
extensionToFormats FilePath
filepath of
        Just (Double -> FilePath -> Solid -> IO ()
writer, FilePath -> IO Solid
_) -> Double -> FilePath -> Solid -> IO ()
writer Double
res FilePath
filepath
        Maybe (Double -> FilePath -> Solid -> IO (), FilePath -> IO Solid)
Nothing -> IO () -> Solid -> IO ()
forall a b. a -> b -> a
const (IO () -> Solid -> IO ()) -> IO () -> Solid -> IO ()
forall a b. (a -> b) -> a -> b
$ WaterfallIOException -> IO ()
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO (WaterfallIOExceptionCause -> FilePath -> WaterfallIOException
WaterfallIOException WaterfallIOExceptionCause
UnrecognizedFormatError FilePath
filepath)

writeSTLAsciiOrBinary :: Bool -> Double -> FilePath -> Solid -> IO ()
writeSTLAsciiOrBinary :: Bool -> Double -> FilePath -> Solid -> IO ()
writeSTLAsciiOrBinary Bool
asciiMode Double
linDeflection FilePath
filepath (Solid Ptr Shape
ptr) = (Acquire () -> (() -> IO ()) -> IO ()
forall (m :: * -> *) a b.
MonadUnliftIO m =>
Acquire a -> (a -> m b) -> m b
`withAcquire` () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (Acquire () -> IO ()) -> Acquire () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    s <- Ptr Shape -> Acquire (Ptr Shape)
forall a. a -> Acquire a
toAcquire Ptr Shape
ptr
    mesh <- BRepMesh.IncrementalMesh.fromShapeAndLinDeflection s linDeflection
    liftIO $ BRepMesh.IncrementalMesh.perform mesh
    writer <- StlWriter.new
    liftIO $ do
            StlWriter.setAsciiMode writer asciiMode
            res <- StlWriter.write writer s filepath
            unless res (throwIO (WaterfallIOException FileError filepath))
    return ()

-- | Write a `Solid` to a (binary) STL file at a given path
--
-- Because BRep representations of objects can store arbitrary precision curves,
-- but STL files store triangulated surfaces, 
-- this function takes a "deflection" argument used to discretize curves.
--
-- The deflection is the maximum allowable distance between a curve and the generated triangulation.
writeSTL :: Double -> FilePath -> Solid -> IO ()
writeSTL :: Double -> FilePath -> Solid -> IO ()
writeSTL = Bool -> Double -> FilePath -> Solid -> IO ()
writeSTLAsciiOrBinary Bool
False

-- | Write a `Solid` to an Ascii STL file at a given path
--
-- Because BRep representations of objects can store arbitrary precision curves,
-- but STL files store triangulated surfaces, 
-- this function takes a "deflection" argument used to discretize curves.
--
-- The deflection is the maximum allowable distance between a curve and the generated triangulation.
writeAsciiSTL :: Double -> FilePath -> Solid -> IO ()
writeAsciiSTL :: Double -> FilePath -> Solid -> IO ()
writeAsciiSTL = Bool -> Double -> FilePath -> Solid -> IO ()
writeSTLAsciiOrBinary Bool
True

-- | Write a `Solid` to a STEP file at a given path
--
-- STEP files can be imported by [FreeCAD](https://www.freecad.org/)
writeSTEP :: FilePath -> Solid -> IO ()
writeSTEP :: FilePath -> Solid -> IO ()
writeSTEP FilePath
filepath (Solid Ptr Shape
ptr) = (Acquire () -> (() -> IO ()) -> IO ()
forall (m :: * -> *) a b.
MonadUnliftIO m =>
Acquire a -> (a -> m b) -> m b
`withAcquire` () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (Acquire () -> IO ()) -> Acquire () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    s <- Ptr Shape -> Acquire (Ptr Shape)
forall a. a -> Acquire a
toAcquire Ptr Shape
ptr
    writer <- StepWriter.new
    resTransfer <- liftIO $ StepWriter.transfer writer s StepModelType.Asls True
    unless (resTransfer == IFSelect.ReturnStatus.Done) (liftIO . throwIO $ WaterfallIOException BadGeometryError filepath)
    resWrite <- liftIO $ StepWriter.write writer filepath
    unless (resWrite == IFSelect.ReturnStatus.Done) (liftIO . throwIO $ WaterfallIOException FileError filepath)

cafWriter :: (FilePath -> Ptr (Handle TDocStd.Document) -> Ptr TColStd.IndexedDataMapOfStringString -> Ptr Message.ProgressRange -> Acquire ()) -> Double -> FilePath -> Solid-> IO ()
cafWriter :: (FilePath
 -> Ptr (Handle Document)
 -> Ptr IndexedDataMapOfStringString
 -> Ptr ProgressRange
 -> Acquire ())
-> Double -> FilePath -> Solid -> IO ()
cafWriter FilePath
-> Ptr (Handle Document)
-> Ptr IndexedDataMapOfStringString
-> Ptr ProgressRange
-> Acquire ()
write Double
linDeflection FilePath
filepath (Solid Ptr Shape
ptr) = (Acquire () -> (() -> IO ()) -> IO ()
forall (m :: * -> *) a b.
MonadUnliftIO m =>
Acquire a -> (a -> m b) -> m b
`withAcquire` () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (Acquire () -> IO ()) -> Acquire () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    s <- Ptr Shape -> Acquire (Ptr Shape)
forall a. a -> Acquire a
toAcquire Ptr Shape
ptr
    mesh <- BRepMesh.IncrementalMesh.fromShapeAndLinDeflection s linDeflection
    liftIO $ BRepMesh.IncrementalMesh.perform mesh
    doc <- TDocStd.Document.fromStorageFormat ""
    mainLabel <- TDocStd.Document.main doc
    shapeTool <- XCafDoc.DocumentTool.shapeTool mainLabel
    _ <- XCafDoc.ShapeTool.addShape shapeTool s True True
    meta <- TColStd.IndexedDataMapOfStringString.new
    progress <- Message.ProgressRange.new
    write filepath doc meta progress

writeGLTFOrGLB :: Bool -> Double -> FilePath -> Solid -> IO ()
writeGLTFOrGLB :: Bool -> Double -> FilePath -> Solid -> IO ()
writeGLTFOrGLB Bool
binary =
    let write :: FilePath
-> Ptr (Handle Document)
-> Ptr IndexedDataMapOfStringString
-> Ptr ProgressRange
-> Acquire ()
write FilePath
filepath Ptr (Handle Document)
doc Ptr IndexedDataMapOfStringString
meta Ptr ProgressRange
progress = do 
            writer <- FilePath -> Bool -> Acquire (Ptr CafWriter)
RWGltf.CafWriter.new FilePath
filepath Bool
binary
            liftIO $ RWGltf.CafWriter.perform writer doc meta progress
    in (FilePath
 -> Ptr (Handle Document)
 -> Ptr IndexedDataMapOfStringString
 -> Ptr ProgressRange
 -> Acquire ())
-> Double -> FilePath -> Solid -> IO ()
cafWriter FilePath
-> Ptr (Handle Document)
-> Ptr IndexedDataMapOfStringString
-> Ptr ProgressRange
-> Acquire ()
write

-- | Write a `Solid` to a glTF file at a given path
--
-- glTF, or Graphics Library Transmission Format is a JSON based format 
-- used for three-dimensional scenes and models
--
-- Because BRep representations of objects can store arbitrary precision curves,
-- but glTF files store triangulated surfaces, 
-- this function takes a "deflection" argument used to discretize curves.
--
-- The deflection is the maximum allowable distance between a curve and the generated triangulation.
writeGLTF :: Double -> FilePath -> Solid -> IO ()
writeGLTF :: Double -> FilePath -> Solid -> IO ()
writeGLTF = Bool -> Double -> FilePath -> Solid -> IO ()
writeGLTFOrGLB Bool
False

-- | Write a `Solid` to a glb file at a given path
--
-- glb is the binary variant of the glTF file format
--
-- Because BRep representations of objects can store arbitrary precision curves,
-- but glTF files store triangulated surfaces, 
-- this function takes a "deflection" argument used to discretize curves.
--
-- The deflection is the maximum allowable distance between a curve and the generated triangulation.
writeGLB :: Double -> FilePath -> Solid -> IO ()
writeGLB :: Double -> FilePath -> Solid -> IO ()
writeGLB = Bool -> Double -> FilePath -> Solid -> IO ()
writeGLTFOrGLB Bool
True

-- | Write a `Solid` to an obj file at a given path
--
-- Wavefront OBJ is a simple ascii file format that stores geometric data.
--
-- Because BRep representations of objects can store arbitrary precision curves,
-- but obj files store triangulated surfaces, 
-- this function takes a "deflection" argument used to discretize curves.
--
-- The deflection is the maximum allowable distance between a curve and the generated triangulation.
writeOBJ :: Double -> FilePath -> Solid -> IO ()
writeOBJ :: Double -> FilePath -> Solid -> IO ()
writeOBJ = 
    let write :: FilePath
-> Ptr (Handle Document)
-> Ptr IndexedDataMapOfStringString
-> Ptr ProgressRange
-> Acquire ()
write FilePath
filepath Ptr (Handle Document)
doc Ptr IndexedDataMapOfStringString
meta Ptr ProgressRange
progress = do 
            writer <- FilePath -> Acquire (Ptr CafWriter)
RWObj.CafWriter.new FilePath
filepath
            liftIO $ RWObj.CafWriter.perform writer doc meta progress
    in (FilePath
 -> Ptr (Handle Document)
 -> Ptr IndexedDataMapOfStringString
 -> Ptr ProgressRange
 -> Acquire ())
-> Double -> FilePath -> Solid -> IO ()
cafWriter FilePath
-> Ptr (Handle Document)
-> Ptr IndexedDataMapOfStringString
-> Ptr ProgressRange
-> Acquire ()
write

-- | Read a `Solid` from a file at a given path
-- 
-- Throws an error if loading fails, or if it's unable to work out
-- the intended file format from the path
readSolid :: FilePath -> IO Solid
readSolid :: FilePath -> IO Solid
readSolid FilePath
filepath = 
    case FilePath
-> Maybe
     (Double -> FilePath -> Solid -> IO (), FilePath -> IO Solid)
extensionToFormats FilePath
filepath of 
        Maybe (Double -> FilePath -> Solid -> IO (), FilePath -> IO Solid)
Nothing -> WaterfallIOException -> IO Solid
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO (WaterfallIOExceptionCause -> FilePath -> WaterfallIOException
WaterfallIOException WaterfallIOExceptionCause
UnrecognizedFormatError FilePath
filepath)
        Just (Double -> FilePath -> Solid -> IO ()
_, FilePath -> IO Solid
reader) -> FilePath -> IO Solid
reader FilePath
filepath

remeshOrThrow :: FilePath -> Ptr TopoDS.Shape -> Acquire (Ptr TopoDS.Shape)
remeshOrThrow :: FilePath -> Ptr Shape -> Acquire (Ptr Shape)
remeshOrThrow FilePath
filepath Ptr Shape
shape = do
    remeshed <- Ptr Shape -> Acquire (Maybe (Ptr Shape))
Remesh.remesh Ptr Shape
shape
    case remeshed of 
        Just Ptr Shape
solid -> Ptr Shape -> Acquire (Ptr Shape)
forall a. a -> Acquire a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr Shape
solid
        Maybe (Ptr Shape)
Nothing -> IO (Ptr Shape) -> Acquire (Ptr Shape)
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr Shape) -> Acquire (Ptr Shape))
-> (WaterfallIOException -> IO (Ptr Shape))
-> WaterfallIOException
-> Acquire (Ptr Shape)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WaterfallIOException -> IO (Ptr Shape)
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO (WaterfallIOException -> Acquire (Ptr Shape))
-> WaterfallIOException -> Acquire (Ptr Shape)
forall a b. (a -> b) -> a -> b
$ WaterfallIOExceptionCause -> FilePath -> WaterfallIOException
WaterfallIOException WaterfallIOExceptionCause
BadGeometryError FilePath
filepath

-- | Read a `Solid` from an STL file at a given path
readSTL :: FilePath -> IO Solid
readSTL :: FilePath -> IO Solid
readSTL FilePath
filepath = (Ptr Shape -> Solid) -> IO (Ptr Shape) -> IO Solid
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr Shape -> Solid
Solid (IO (Ptr Shape) -> IO Solid)
-> (Acquire (Ptr Shape) -> IO (Ptr Shape))
-> Acquire (Ptr Shape)
-> IO Solid
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Acquire (Ptr Shape) -> IO (Ptr Shape)
forall a. Acquire a -> IO a
fromAcquire (Acquire (Ptr Shape) -> IO Solid)
-> Acquire (Ptr Shape) -> IO Solid
forall a b. (a -> b) -> a -> b
$ do
    shape <- Acquire (Ptr Shape)
TopoDS.Shape.new
    reader <- StlReader.new
    res <- liftIO $ StlReader.read reader shape filepath
    unless res $ liftIO . throwIO $ WaterfallIOException FileError filepath
    remeshOrThrow filepath shape

-- | Read a `Solid` from a STEP file at a given path
readSTEP :: FilePath -> IO Solid
readSTEP :: FilePath -> IO Solid
readSTEP FilePath
filepath = (Ptr Shape -> Solid) -> IO (Ptr Shape) -> IO Solid
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr Shape -> Solid
Solid (IO (Ptr Shape) -> IO Solid)
-> (Acquire (Ptr Shape) -> IO (Ptr Shape))
-> Acquire (Ptr Shape)
-> IO Solid
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Acquire (Ptr Shape) -> IO (Ptr Shape)
forall a. Acquire a -> IO a
fromAcquire (Acquire (Ptr Shape) -> IO Solid)
-> Acquire (Ptr Shape) -> IO Solid
forall a b. (a -> b) -> a -> b
$ do
    reader <- Acquire (Ptr Reader)
STEPReader.new
    status <- liftIO $ XSControl.Reader.readFile (upcast reader) filepath
    _ <- liftIO $ XSControl.Reader.transferRoots (upcast reader)
    shape <- XSControl.Reader.oneShape (upcast reader)
    unless (status == IFSelect.ReturnStatus.Done) (liftIO . throwIO $ WaterfallIOException FileError filepath)
    shapeIsNull <- liftIO $ TopoDS.Shape.isNull shape
    when shapeIsNull (liftIO . throwIO $ WaterfallIOException BadGeometryError filepath)
    return shape

cafReader :: Acquire (Ptr RWMesh.CafReader) -> FilePath -> IO Solid
cafReader :: Acquire (Ptr CafReader) -> FilePath -> IO Solid
cafReader Acquire (Ptr CafReader)
mkReader FilePath
filepath = (Ptr Shape -> Solid) -> IO (Ptr Shape) -> IO Solid
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr Shape -> Solid
Solid (IO (Ptr Shape) -> IO Solid)
-> (Acquire (Ptr Shape) -> IO (Ptr Shape))
-> Acquire (Ptr Shape)
-> IO Solid
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Acquire (Ptr Shape) -> IO (Ptr Shape)
forall a. Acquire a -> IO a
fromAcquire (Acquire (Ptr Shape) -> IO Solid)
-> Acquire (Ptr Shape) -> IO Solid
forall a b. (a -> b) -> a -> b
$ do
    reader <- Acquire (Ptr CafReader)
mkReader
    doc <- TDocStd.Document.fromStorageFormat ""
    progress <- Message.ProgressRange.new
    _ <- liftIO $ RWMesh.CafReader.setDocument reader doc
    res <- liftIO $ RWMesh.CafReader.perform reader filepath progress
    unless res (liftIO . throwIO $ WaterfallIOException FileError filepath)
    remeshOrThrow filepath =<< RWMesh.CafReader.singleShape reader

-- | Read a `Solid` from a GLTF file at a given path
--
-- This should support reading both the GLTF (json) and GLB (binary) formats
readGLTF :: FilePath -> IO Solid
readGLTF :: FilePath -> IO Solid
readGLTF  = Acquire (Ptr CafReader) -> FilePath -> IO Solid
cafReader (Acquire (Ptr CafReader) -> FilePath -> IO Solid)
-> Acquire (Ptr CafReader) -> FilePath -> IO Solid
forall a b. (a -> b) -> a -> b
$ do
    reader <- Acquire (Ptr CafReader)
RWGltf.CafReader.new 
    liftIO $ RWGltf.CafReader.setDoublePrecision reader True
    liftIO $ RWMesh.CafReader.setFileLengthUnit (upcast reader) 1
    return (upcast reader)

-- | Alias for `readGLTF`
readGLB :: FilePath -> IO Solid
readGLB :: FilePath -> IO Solid
readGLB = FilePath -> IO Solid
readGLTF

-- | Read a `Solid` from an obj file at a given path
--
-- This should support reading both the GLTF (json) and GLB (binary) formats
readOBJ :: FilePath -> IO Solid
readOBJ :: FilePath -> IO Solid
readOBJ  = Acquire (Ptr CafReader) -> FilePath -> IO Solid
cafReader (Acquire (Ptr CafReader) -> FilePath -> IO Solid)
-> Acquire (Ptr CafReader) -> FilePath -> IO Solid
forall a b. (a -> b) -> a -> b
$ do
    reader <- Acquire (Ptr CafReader)
RWObj.CafReader.new 
    liftIO $ RWObj.CafReader.setSinglePrecision reader False
    liftIO $ RWMesh.CafReader.setFileLengthUnit (upcast reader) 1
    return (upcast reader)