module Text.GLTF.Loader
  ( -- * Scene loading functions
    fromJsonFile,
    fromJsonByteString,
    fromBinaryFile,
    fromBinaryByteString,

    -- * GLTF Data Types
    module Text.GLTF.Loader.Gltf,
    module Text.GLTF.Loader.Glb,

    -- * Loading Errors
    module Text.GLTF.Loader.Errors
  ) where

import Text.GLTF.Loader.Internal.Adapter
import Text.GLTF.Loader.Internal.BufferAccessor
import Text.GLTF.Loader.Errors
import Text.GLTF.Loader.Glb
import Text.GLTF.Loader.Gltf

import Data.Binary.Get (ByteOffset)
import Data.Either
import Data.Maybe (fromJust)
import Lens.Micro
import RIO
import RIO.FilePath (takeDirectory)
import qualified Codec.GlTF as GlTF
import qualified Codec.GLB as GLB
import qualified RIO.Vector as Vector

-- | Load a glTF scene from a ByteString
fromJsonByteString :: MonadUnliftIO io => ByteString -> io (Either Errors Gltf)
fromJsonByteString :: forall (io :: * -> *).
MonadUnliftIO io =>
ByteString -> io (Either Errors Gltf)
fromJsonByteString ByteString
input = forall (io :: * -> *).
MonadUnliftIO io =>
FilePath
-> Maybe Chunk -> Either FilePath GlTF -> io (Either Errors Gltf)
toGltfResult FilePath
"." forall a. Maybe a
Nothing (ByteString -> Either FilePath GlTF
GlTF.fromByteString ByteString
input)

-- | Load a glTF scene from a file
fromJsonFile :: MonadUnliftIO io => FilePath -> io (Either Errors Gltf)
fromJsonFile :: forall (io :: * -> *).
MonadUnliftIO io =>
FilePath -> io (Either Errors Gltf)
fromJsonFile FilePath
path = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO (Either FilePath GlTF)
GlTF.fromFile FilePath
path) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (io :: * -> *).
MonadUnliftIO io =>
FilePath
-> Maybe Chunk -> Either FilePath GlTF -> io (Either Errors Gltf)
toGltfResult (FilePath -> FilePath
takeDirectory FilePath
path) forall a. Maybe a
Nothing

fromBinaryFile :: MonadUnliftIO io => FilePath -> io (Either Errors Glb)
fromBinaryFile :: forall (io :: * -> *).
MonadUnliftIO io =>
FilePath -> io (Either Errors Glb)
fromBinaryFile FilePath
path = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO (Either (ByteOffset, FilePath) GLB)
GLB.fromFile FilePath
path) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (io :: * -> *).
MonadUnliftIO io =>
FilePath
-> Either (ByteOffset, FilePath) GLB -> io (Either Errors Glb)
toGlbResult FilePath
"."
  
fromBinaryByteString :: MonadUnliftIO io => ByteString -> io (Either Errors Glb)
fromBinaryByteString :: forall (io :: * -> *).
MonadUnliftIO io =>
ByteString -> io (Either Errors Glb)
fromBinaryByteString ByteString
input = forall (io :: * -> *).
MonadUnliftIO io =>
FilePath
-> Either (ByteOffset, FilePath) GLB -> io (Either Errors Glb)
toGlbResult FilePath
"." (ByteString -> Either (ByteOffset, FilePath) GLB
GLB.fromByteString ByteString
input)

toGltfResult
  :: MonadUnliftIO io
  => FilePath
  -> Maybe GLB.Chunk
  -> Either String GlTF.GlTF
  -> io (Either Errors Gltf)
toGltfResult :: forall (io :: * -> *).
MonadUnliftIO io =>
FilePath
-> Maybe Chunk -> Either FilePath GlTF -> io (Either Errors Gltf)
toGltfResult FilePath
basePath Maybe Chunk
chunk Either FilePath GlTF
res = Either FilePath GlTF
res
  forall a b. a -> (a -> b) -> b
& forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall a b a'. Traversal (Either a b) (Either a' b) a a'
_Left (Text -> Errors
ReadError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => FilePath -> a
fromString)
  forall a b. a -> (a -> b) -> b
& forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf forall a b b'. Traversal (Either a b) (Either a b') b b'
_Right (forall (io :: * -> *).
MonadUnliftIO io =>
FilePath -> Maybe Chunk -> GlTF -> io Gltf
runGltfAdapter FilePath
basePath Maybe Chunk
chunk)

toGlbResult
  :: MonadUnliftIO io
  => FilePath
  -> Either (ByteOffset, String) GLB.GLB
  -> io (Either Errors Glb)
toGlbResult :: forall (io :: * -> *).
MonadUnliftIO io =>
FilePath
-> Either (ByteOffset, FilePath) GLB -> io (Either Errors Glb)
toGlbResult FilePath
basePath (Right GLB
res) = forall (io :: * -> *).
MonadUnliftIO io =>
FilePath -> GLB -> io (Either Errors Glb)
processGlb FilePath
basePath GLB
res
toGlbResult FilePath
_        (Left (ByteOffset
_, FilePath
err)) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Errors
ReadError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => FilePath -> a
fromString forall a b. (a -> b) -> a -> b
$ FilePath
err

runGltfAdapter
  :: MonadUnliftIO io
  => FilePath
  -> Maybe GLB.Chunk
  -> GlTF.GlTF
  -> io Gltf
runGltfAdapter :: forall (io :: * -> *).
MonadUnliftIO io =>
FilePath -> Maybe Chunk -> GlTF -> io Gltf
runGltfAdapter FilePath
basePath Maybe Chunk
chunk GlTF
gltf = GlTF -> Vector GltfBuffer -> Vector GltfImageData -> Gltf
runAdapter GlTF
gltf
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (io :: * -> *).
MonadUnliftIO io =>
GlTF -> Maybe Chunk -> FilePath -> io (Vector GltfBuffer)
loadBuffers GlTF
gltf Maybe Chunk
chunk FilePath
basePath
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (io :: * -> *).
MonadUnliftIO io =>
GlTF -> FilePath -> io (Vector GltfImageData)
loadImages GlTF
gltf FilePath
basePath

processGlb :: MonadUnliftIO io => FilePath -> GLB.GLB -> io (Either Errors Glb)
processGlb :: forall (io :: * -> *).
MonadUnliftIO io =>
FilePath -> GLB -> io (Either Errors Glb)
processGlb FilePath
basePath GLB.GLB{Header
Vector Chunk
$sel:header:GLB :: GLB -> Header
$sel:chunks:GLB :: GLB -> Vector Chunk
chunks :: Vector Chunk
header :: Header
..} = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall a b b'. Traversal (Either a b) (Either a b') b b'
_Right Gltf -> Glb
Glb forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> io (Either Errors Gltf)
res
  where gltfChunk :: Maybe Chunk
gltfChunk = Vector Chunk
chunks forall (v :: * -> *) a. Vector v a => v a -> Int -> Maybe a
Vector.!? Int
0
        bufferChunk :: Maybe Chunk
bufferChunk = Vector Chunk
chunks forall (v :: * -> *) a. Vector v a => v a -> Int -> Maybe a
Vector.!? Int
1
        gltf :: Either FilePath GlTF
gltf = Chunk -> Either FilePath GlTF
GlTF.fromChunk (forall a. HasCallStack => Maybe a -> a
fromJust Maybe Chunk
gltfChunk)
        res :: io (Either Errors Gltf)
res = forall (io :: * -> *).
MonadUnliftIO io =>
FilePath
-> Maybe Chunk -> Either FilePath GlTF -> io (Either Errors Gltf)
toGltfResult FilePath
basePath Maybe Chunk
bufferChunk Either FilePath GlTF
gltf