{-# OPTIONS_GHC -fplugin Foreign.Storable.Generic.Plugin #-}

module Resource.Mesh.Types
  ( AxisAligned(..)

  , Meta(..)

  , NodeGroup(..)
  , NodePartitions(..)

  , Nodes
  , Node(..)
  , TexturedNodes
  , TexturedNode(..)
  , TextureParams(..) -- XXX: copypasta from LitTextured

  , Measurements(..)
  , measureAa
  , measureAaWith
  , middle
  , middleAa
  , size
  , sizeAa

  , HasRange(..)

  , encodeStorable
  , decodeStorable
  ) where

import RIO

import Codec.Serialise qualified as CBOR
import Codec.Serialise.Decoding qualified as CBOR (Decoder, decodeBytes)
import Codec.Serialise.Encoding qualified as CBOR (Encoding)
import Control.Foldl qualified as L
import Data.ByteString.Unsafe qualified as BS
import Data.Typeable (typeRep, typeRepTyCon)
import Foreign (Storable(..), castPtr)
import Foreign qualified
import Foreign.Storable.Generic (GStorable)
import Geomancy (Transform(..), Vec2, Vec4, withVec3)
import Geomancy.Mat4 qualified as Mat4
import Geomancy.Vec3 qualified as Vec3
import RIO.Vector.Storable qualified as Storable
import System.IO.Unsafe (unsafePerformIO)
import Vulkan.Zero (Zero(..))

import Resource.Model (IndexRange(..))

data AxisAligned a = AxisAligned
  { forall a. AxisAligned a -> a
aaX :: a
  , forall a. AxisAligned a -> a
aaY :: a
  , forall a. AxisAligned a -> a
aaZ :: a
  }
  deriving (AxisAligned a -> AxisAligned a -> Bool
(AxisAligned a -> AxisAligned a -> Bool)
-> (AxisAligned a -> AxisAligned a -> Bool) -> Eq (AxisAligned a)
forall a. Eq a => AxisAligned a -> AxisAligned a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AxisAligned a -> AxisAligned a -> Bool
$c/= :: forall a. Eq a => AxisAligned a -> AxisAligned a -> Bool
== :: AxisAligned a -> AxisAligned a -> Bool
$c== :: forall a. Eq a => AxisAligned a -> AxisAligned a -> Bool
Eq, Eq (AxisAligned a)
Eq (AxisAligned a)
-> (AxisAligned a -> AxisAligned a -> Ordering)
-> (AxisAligned a -> AxisAligned a -> Bool)
-> (AxisAligned a -> AxisAligned a -> Bool)
-> (AxisAligned a -> AxisAligned a -> Bool)
-> (AxisAligned a -> AxisAligned a -> Bool)
-> (AxisAligned a -> AxisAligned a -> AxisAligned a)
-> (AxisAligned a -> AxisAligned a -> AxisAligned a)
-> Ord (AxisAligned a)
AxisAligned a -> AxisAligned a -> Bool
AxisAligned a -> AxisAligned a -> Ordering
AxisAligned a -> AxisAligned a -> AxisAligned a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (AxisAligned a)
forall a. Ord a => AxisAligned a -> AxisAligned a -> Bool
forall a. Ord a => AxisAligned a -> AxisAligned a -> Ordering
forall a. Ord a => AxisAligned a -> AxisAligned a -> AxisAligned a
min :: AxisAligned a -> AxisAligned a -> AxisAligned a
$cmin :: forall a. Ord a => AxisAligned a -> AxisAligned a -> AxisAligned a
max :: AxisAligned a -> AxisAligned a -> AxisAligned a
$cmax :: forall a. Ord a => AxisAligned a -> AxisAligned a -> AxisAligned a
>= :: AxisAligned a -> AxisAligned a -> Bool
$c>= :: forall a. Ord a => AxisAligned a -> AxisAligned a -> Bool
> :: AxisAligned a -> AxisAligned a -> Bool
$c> :: forall a. Ord a => AxisAligned a -> AxisAligned a -> Bool
<= :: AxisAligned a -> AxisAligned a -> Bool
$c<= :: forall a. Ord a => AxisAligned a -> AxisAligned a -> Bool
< :: AxisAligned a -> AxisAligned a -> Bool
$c< :: forall a. Ord a => AxisAligned a -> AxisAligned a -> Bool
compare :: AxisAligned a -> AxisAligned a -> Ordering
$ccompare :: forall a. Ord a => AxisAligned a -> AxisAligned a -> Ordering
Ord, Int -> AxisAligned a -> ShowS
[AxisAligned a] -> ShowS
AxisAligned a -> String
(Int -> AxisAligned a -> ShowS)
-> (AxisAligned a -> String)
-> ([AxisAligned a] -> ShowS)
-> Show (AxisAligned a)
forall a. Show a => Int -> AxisAligned a -> ShowS
forall a. Show a => [AxisAligned a] -> ShowS
forall a. Show a => AxisAligned a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AxisAligned a] -> ShowS
$cshowList :: forall a. Show a => [AxisAligned a] -> ShowS
show :: AxisAligned a -> String
$cshow :: forall a. Show a => AxisAligned a -> String
showsPrec :: Int -> AxisAligned a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> AxisAligned a -> ShowS
Show, (forall a b. (a -> b) -> AxisAligned a -> AxisAligned b)
-> (forall a b. a -> AxisAligned b -> AxisAligned a)
-> Functor AxisAligned
forall a b. a -> AxisAligned b -> AxisAligned a
forall a b. (a -> b) -> AxisAligned a -> AxisAligned b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> AxisAligned b -> AxisAligned a
$c<$ :: forall a b. a -> AxisAligned b -> AxisAligned a
fmap :: forall a b. (a -> b) -> AxisAligned a -> AxisAligned b
$cfmap :: forall a b. (a -> b) -> AxisAligned a -> AxisAligned b
Functor, (forall m. Monoid m => AxisAligned m -> m)
-> (forall m a. Monoid m => (a -> m) -> AxisAligned a -> m)
-> (forall m a. Monoid m => (a -> m) -> AxisAligned a -> m)
-> (forall a b. (a -> b -> b) -> b -> AxisAligned a -> b)
-> (forall a b. (a -> b -> b) -> b -> AxisAligned a -> b)
-> (forall b a. (b -> a -> b) -> b -> AxisAligned a -> b)
-> (forall b a. (b -> a -> b) -> b -> AxisAligned a -> b)
-> (forall a. (a -> a -> a) -> AxisAligned a -> a)
-> (forall a. (a -> a -> a) -> AxisAligned a -> a)
-> (forall a. AxisAligned a -> [a])
-> (forall a. AxisAligned a -> Bool)
-> (forall a. AxisAligned a -> Int)
-> (forall a. Eq a => a -> AxisAligned a -> Bool)
-> (forall a. Ord a => AxisAligned a -> a)
-> (forall a. Ord a => AxisAligned a -> a)
-> (forall a. Num a => AxisAligned a -> a)
-> (forall a. Num a => AxisAligned a -> a)
-> Foldable AxisAligned
forall a. Eq a => a -> AxisAligned a -> Bool
forall a. Num a => AxisAligned a -> a
forall a. Ord a => AxisAligned a -> a
forall m. Monoid m => AxisAligned m -> m
forall a. AxisAligned a -> Bool
forall a. AxisAligned a -> Int
forall a. AxisAligned a -> [a]
forall a. (a -> a -> a) -> AxisAligned a -> a
forall m a. Monoid m => (a -> m) -> AxisAligned a -> m
forall b a. (b -> a -> b) -> b -> AxisAligned a -> b
forall a b. (a -> b -> b) -> b -> AxisAligned a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => AxisAligned a -> a
$cproduct :: forall a. Num a => AxisAligned a -> a
sum :: forall a. Num a => AxisAligned a -> a
$csum :: forall a. Num a => AxisAligned a -> a
minimum :: forall a. Ord a => AxisAligned a -> a
$cminimum :: forall a. Ord a => AxisAligned a -> a
maximum :: forall a. Ord a => AxisAligned a -> a
$cmaximum :: forall a. Ord a => AxisAligned a -> a
elem :: forall a. Eq a => a -> AxisAligned a -> Bool
$celem :: forall a. Eq a => a -> AxisAligned a -> Bool
length :: forall a. AxisAligned a -> Int
$clength :: forall a. AxisAligned a -> Int
null :: forall a. AxisAligned a -> Bool
$cnull :: forall a. AxisAligned a -> Bool
toList :: forall a. AxisAligned a -> [a]
$ctoList :: forall a. AxisAligned a -> [a]
foldl1 :: forall a. (a -> a -> a) -> AxisAligned a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> AxisAligned a -> a
foldr1 :: forall a. (a -> a -> a) -> AxisAligned a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> AxisAligned a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> AxisAligned a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> AxisAligned a -> b
foldl :: forall b a. (b -> a -> b) -> b -> AxisAligned a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> AxisAligned a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> AxisAligned a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> AxisAligned a -> b
foldr :: forall a b. (a -> b -> b) -> b -> AxisAligned a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> AxisAligned a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> AxisAligned a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> AxisAligned a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> AxisAligned a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> AxisAligned a -> m
fold :: forall m. Monoid m => AxisAligned m -> m
$cfold :: forall m. Monoid m => AxisAligned m -> m
Foldable, Functor AxisAligned
Foldable AxisAligned
Functor AxisAligned
-> Foldable AxisAligned
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> AxisAligned a -> f (AxisAligned b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    AxisAligned (f a) -> f (AxisAligned a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> AxisAligned a -> m (AxisAligned b))
-> (forall (m :: * -> *) a.
    Monad m =>
    AxisAligned (m a) -> m (AxisAligned a))
-> Traversable AxisAligned
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
AxisAligned (m a) -> m (AxisAligned a)
forall (f :: * -> *) a.
Applicative f =>
AxisAligned (f a) -> f (AxisAligned a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> AxisAligned a -> m (AxisAligned b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> AxisAligned a -> f (AxisAligned b)
sequence :: forall (m :: * -> *) a.
Monad m =>
AxisAligned (m a) -> m (AxisAligned a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
AxisAligned (m a) -> m (AxisAligned a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> AxisAligned a -> m (AxisAligned b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> AxisAligned a -> m (AxisAligned b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
AxisAligned (f a) -> f (AxisAligned a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
AxisAligned (f a) -> f (AxisAligned a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> AxisAligned a -> f (AxisAligned b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> AxisAligned a -> f (AxisAligned b)
Traversable, (forall x. AxisAligned a -> Rep (AxisAligned a) x)
-> (forall x. Rep (AxisAligned a) x -> AxisAligned a)
-> Generic (AxisAligned a)
forall x. Rep (AxisAligned a) x -> AxisAligned a
forall x. AxisAligned a -> Rep (AxisAligned a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (AxisAligned a) x -> AxisAligned a
forall a x. AxisAligned a -> Rep (AxisAligned a) x
$cto :: forall a x. Rep (AxisAligned a) x -> AxisAligned a
$cfrom :: forall a x. AxisAligned a -> Rep (AxisAligned a) x
Generic)

instance Applicative AxisAligned where
  pure :: forall a. a -> AxisAligned a
pure a
x = AxisAligned :: forall a. a -> a -> a -> AxisAligned a
AxisAligned
    { $sel:aaX:AxisAligned :: a
aaX = a
x
    , $sel:aaY:AxisAligned :: a
aaY = a
x
    , $sel:aaZ:AxisAligned :: a
aaZ = a
x
    }

  AxisAligned (a -> b)
funcs <*> :: forall a b. AxisAligned (a -> b) -> AxisAligned a -> AxisAligned b
<*> AxisAligned a
args = AxisAligned :: forall a. a -> a -> a -> AxisAligned a
AxisAligned
    { $sel:aaX:AxisAligned :: b
aaX = AxisAligned (a -> b) -> a -> b
forall a. AxisAligned a -> a
aaX AxisAligned (a -> b)
funcs (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ AxisAligned a -> a
forall a. AxisAligned a -> a
aaX AxisAligned a
args
    , $sel:aaY:AxisAligned :: b
aaY = AxisAligned (a -> b) -> a -> b
forall a. AxisAligned a -> a
aaY AxisAligned (a -> b)
funcs (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ AxisAligned a -> a
forall a. AxisAligned a -> a
aaY AxisAligned a
args
    , $sel:aaZ:AxisAligned :: b
aaZ = AxisAligned (a -> b) -> a -> b
forall a. AxisAligned a -> a
aaZ AxisAligned (a -> b)
funcs (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ AxisAligned a -> a
forall a. AxisAligned a -> a
aaZ AxisAligned a
args
    }

instance Storable a => Storable (AxisAligned a) where
  alignment :: AxisAligned a -> Int
alignment ~AxisAligned a
_ = a -> Int
forall a. Storable a => a -> Int
alignment (String -> a
forall a. HasCallStack => String -> a
error String
"AxisAligned.alignment" :: a)

  sizeOf :: AxisAligned a -> Int
sizeOf ~AxisAligned a
_ = Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* a -> Int
forall a. Storable a => a -> Int
sizeOf (String -> a
forall a. HasCallStack => String -> a
error String
"AxisAligned.sizeOf" :: a)

  peek :: Ptr (AxisAligned a) -> IO (AxisAligned a)
peek Ptr (AxisAligned a)
ptr = do
    a
aaX <- Ptr a -> Int -> IO a
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff (Ptr (AxisAligned a) -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr Ptr (AxisAligned a)
ptr) Int
0
    a
aaY <- Ptr a -> Int -> IO a
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff (Ptr (AxisAligned a) -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr Ptr (AxisAligned a)
ptr) Int
1
    a
aaZ <- Ptr a -> Int -> IO a
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff (Ptr (AxisAligned a) -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr Ptr (AxisAligned a)
ptr) Int
2
    pure AxisAligned :: forall a. a -> a -> a -> AxisAligned a
AxisAligned{a
aaZ :: a
aaY :: a
aaX :: a
$sel:aaZ:AxisAligned :: a
$sel:aaY:AxisAligned :: a
$sel:aaX:AxisAligned :: a
..}

  poke :: Ptr (AxisAligned a) -> AxisAligned a -> IO ()
poke Ptr (AxisAligned a)
ptr AxisAligned{a
aaZ :: a
aaY :: a
aaX :: a
$sel:aaZ:AxisAligned :: forall a. AxisAligned a -> a
$sel:aaY:AxisAligned :: forall a. AxisAligned a -> a
$sel:aaX:AxisAligned :: forall a. AxisAligned a -> a
..} = do
    Ptr a -> Int -> a -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff (Ptr (AxisAligned a) -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr Ptr (AxisAligned a)
ptr) Int
0 a
aaX
    Ptr a -> Int -> a -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff (Ptr (AxisAligned a) -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr Ptr (AxisAligned a)
ptr) Int
1 a
aaY
    Ptr a -> Int -> a -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff (Ptr (AxisAligned a) -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr Ptr (AxisAligned a)
ptr) Int
2 a
aaZ

instance (CBOR.Serialise a) => CBOR.Serialise (AxisAligned a)

-- * Whole-scene metadata

data Meta = Meta
  { -- XXX: full-scene draws
    Meta -> IndexRange
mOpaqueIndices  :: IndexRange
  , Meta -> IndexRange
mBlendedIndices :: IndexRange

    -- XXX: per-node draws
  , Meta -> IndexRange
mOpaqueNodes    :: IndexRange
  , Meta -> IndexRange
mBlendedNodes   :: IndexRange

  , Meta -> Vec4
mBoundingSphere :: Vec4
  , Meta -> Transform
mTransformBB    :: Transform
  , Meta -> AxisAligned Measurements
mMeasurements   :: AxisAligned Measurements
  }
  deriving (Int -> Meta -> ShowS
[Meta] -> ShowS
Meta -> String
(Int -> Meta -> ShowS)
-> (Meta -> String) -> ([Meta] -> ShowS) -> Show Meta
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Meta] -> ShowS
$cshowList :: [Meta] -> ShowS
show :: Meta -> String
$cshow :: Meta -> String
showsPrec :: Int -> Meta -> ShowS
$cshowsPrec :: Int -> Meta -> ShowS
Show, (forall x. Meta -> Rep Meta x)
-> (forall x. Rep Meta x -> Meta) -> Generic Meta
forall x. Rep Meta x -> Meta
forall x. Meta -> Rep Meta x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Meta x -> Meta
$cfrom :: forall x. Meta -> Rep Meta x
Generic)

instance GStorable Meta

instance Eq Meta where
  Meta
a == :: Meta -> Meta -> Bool
== Meta
b = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
    [ Meta -> Vec4
mBoundingSphere Meta
a Vec4 -> Vec4 -> Bool
forall a. Eq a => a -> a -> Bool
== Meta -> Vec4
mBoundingSphere Meta
b
    , Meta -> IndexRange
mOpaqueIndices  Meta
a IndexRange -> IndexRange -> Bool
forall a. Eq a => a -> a -> Bool
== Meta -> IndexRange
mOpaqueIndices  Meta
b
    , Meta -> IndexRange
mBlendedIndices Meta
a IndexRange -> IndexRange -> Bool
forall a. Eq a => a -> a -> Bool
== Meta -> IndexRange
mBlendedIndices Meta
b
    , Meta -> IndexRange
mOpaqueNodes    Meta
a IndexRange -> IndexRange -> Bool
forall a. Eq a => a -> a -> Bool
== Meta -> IndexRange
mOpaqueNodes    Meta
b
    , Meta -> IndexRange
mBlendedNodes   Meta
a IndexRange -> IndexRange -> Bool
forall a. Eq a => a -> a -> Bool
== Meta -> IndexRange
mBlendedNodes   Meta
b
    , Meta -> AxisAligned Measurements
mMeasurements   Meta
a AxisAligned Measurements -> AxisAligned Measurements -> Bool
forall a. Eq a => a -> a -> Bool
== Meta -> AxisAligned Measurements
mMeasurements   Meta
b

    , Transform -> [Float]
forall a. Coercible a Mat4 => a -> [Float]
Mat4.toListRowMajor (Meta -> Transform
mTransformBB Meta
a) [Float] -> [Float] -> Bool
forall a. Eq a => a -> a -> Bool
==
      Transform -> [Float]
forall a. Coercible a Mat4 => a -> [Float]
Mat4.toListRowMajor (Meta -> Transform
mTransformBB Meta
b)
    ]

instance CBOR.Serialise Meta where
  encode :: Meta -> Encoding
encode Meta{Transform
Vec4
IndexRange
AxisAligned Measurements
mMeasurements :: AxisAligned Measurements
mTransformBB :: Transform
mBoundingSphere :: Vec4
mBlendedNodes :: IndexRange
mOpaqueNodes :: IndexRange
mBlendedIndices :: IndexRange
mOpaqueIndices :: IndexRange
$sel:mMeasurements:Meta :: Meta -> AxisAligned Measurements
$sel:mTransformBB:Meta :: Meta -> Transform
$sel:mBoundingSphere:Meta :: Meta -> Vec4
$sel:mBlendedNodes:Meta :: Meta -> IndexRange
$sel:mOpaqueNodes:Meta :: Meta -> IndexRange
$sel:mBlendedIndices:Meta :: Meta -> IndexRange
$sel:mOpaqueIndices:Meta :: Meta -> IndexRange
..} = [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat
    [ IndexRange -> Encoding
forall a. Serialise a => a -> Encoding
CBOR.encode    IndexRange
mOpaqueIndices
    , IndexRange -> Encoding
forall a. Serialise a => a -> Encoding
CBOR.encode    IndexRange
mBlendedIndices
    , IndexRange -> Encoding
forall a. Serialise a => a -> Encoding
CBOR.encode    IndexRange
mOpaqueNodes
    , IndexRange -> Encoding
forall a. Serialise a => a -> Encoding
CBOR.encode    IndexRange
mBlendedNodes
    , Vec4 -> Encoding
forall a. Storable a => a -> Encoding
encodeStorable Vec4
mBoundingSphere
    , Transform -> Encoding
forall a. Storable a => a -> Encoding
encodeStorable Transform
mTransformBB
    , AxisAligned Measurements -> Encoding
forall a. Serialise a => a -> Encoding
CBOR.encode    AxisAligned Measurements
mMeasurements
    ]

  decode :: forall s. Decoder s Meta
decode = do
    IndexRange
mOpaqueIndices  <- Decoder s IndexRange
forall a s. Serialise a => Decoder s a
CBOR.decode
    IndexRange
mBlendedIndices <- Decoder s IndexRange
forall a s. Serialise a => Decoder s a
CBOR.decode
    IndexRange
mOpaqueNodes    <- Decoder s IndexRange
forall a s. Serialise a => Decoder s a
CBOR.decode
    IndexRange
mBlendedNodes   <- Decoder s IndexRange
forall a s. Serialise a => Decoder s a
CBOR.decode
    Vec4
mBoundingSphere <- Decoder s Vec4
forall a s. (Storable a, Typeable a) => Decoder s a
decodeStorable
    Transform
mTransformBB    <- Decoder s Transform
forall a s. (Storable a, Typeable a) => Decoder s a
decodeStorable
    AxisAligned Measurements
mMeasurements   <- Decoder s (AxisAligned Measurements)
forall a s. Serialise a => Decoder s a
CBOR.decode
    pure Meta :: IndexRange
-> IndexRange
-> IndexRange
-> IndexRange
-> Vec4
-> Transform
-> AxisAligned Measurements
-> Meta
Meta{Transform
Vec4
IndexRange
AxisAligned Measurements
mMeasurements :: AxisAligned Measurements
mTransformBB :: Transform
mBoundingSphere :: Vec4
mBlendedNodes :: IndexRange
mOpaqueNodes :: IndexRange
mBlendedIndices :: IndexRange
mOpaqueIndices :: IndexRange
$sel:mMeasurements:Meta :: AxisAligned Measurements
$sel:mTransformBB:Meta :: Transform
$sel:mBoundingSphere:Meta :: Vec4
$sel:mBlendedNodes:Meta :: IndexRange
$sel:mOpaqueNodes:Meta :: IndexRange
$sel:mBlendedIndices:Meta :: IndexRange
$sel:mOpaqueIndices:Meta :: IndexRange
..}

-- * Scene parts

data NodeGroup
  = NodeOpaque
  | NodeBlended
  -- TODO: NodeCutout
  deriving (NodeGroup -> NodeGroup -> Bool
(NodeGroup -> NodeGroup -> Bool)
-> (NodeGroup -> NodeGroup -> Bool) -> Eq NodeGroup
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeGroup -> NodeGroup -> Bool
$c/= :: NodeGroup -> NodeGroup -> Bool
== :: NodeGroup -> NodeGroup -> Bool
$c== :: NodeGroup -> NodeGroup -> Bool
Eq, Eq NodeGroup
Eq NodeGroup
-> (NodeGroup -> NodeGroup -> Ordering)
-> (NodeGroup -> NodeGroup -> Bool)
-> (NodeGroup -> NodeGroup -> Bool)
-> (NodeGroup -> NodeGroup -> Bool)
-> (NodeGroup -> NodeGroup -> Bool)
-> (NodeGroup -> NodeGroup -> NodeGroup)
-> (NodeGroup -> NodeGroup -> NodeGroup)
-> Ord NodeGroup
NodeGroup -> NodeGroup -> Bool
NodeGroup -> NodeGroup -> Ordering
NodeGroup -> NodeGroup -> NodeGroup
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NodeGroup -> NodeGroup -> NodeGroup
$cmin :: NodeGroup -> NodeGroup -> NodeGroup
max :: NodeGroup -> NodeGroup -> NodeGroup
$cmax :: NodeGroup -> NodeGroup -> NodeGroup
>= :: NodeGroup -> NodeGroup -> Bool
$c>= :: NodeGroup -> NodeGroup -> Bool
> :: NodeGroup -> NodeGroup -> Bool
$c> :: NodeGroup -> NodeGroup -> Bool
<= :: NodeGroup -> NodeGroup -> Bool
$c<= :: NodeGroup -> NodeGroup -> Bool
< :: NodeGroup -> NodeGroup -> Bool
$c< :: NodeGroup -> NodeGroup -> Bool
compare :: NodeGroup -> NodeGroup -> Ordering
$ccompare :: NodeGroup -> NodeGroup -> Ordering
Ord, Int -> NodeGroup -> ShowS
[NodeGroup] -> ShowS
NodeGroup -> String
(Int -> NodeGroup -> ShowS)
-> (NodeGroup -> String)
-> ([NodeGroup] -> ShowS)
-> Show NodeGroup
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeGroup] -> ShowS
$cshowList :: [NodeGroup] -> ShowS
show :: NodeGroup -> String
$cshow :: NodeGroup -> String
showsPrec :: Int -> NodeGroup -> ShowS
$cshowsPrec :: Int -> NodeGroup -> ShowS
Show, Int -> NodeGroup
NodeGroup -> Int
NodeGroup -> [NodeGroup]
NodeGroup -> NodeGroup
NodeGroup -> NodeGroup -> [NodeGroup]
NodeGroup -> NodeGroup -> NodeGroup -> [NodeGroup]
(NodeGroup -> NodeGroup)
-> (NodeGroup -> NodeGroup)
-> (Int -> NodeGroup)
-> (NodeGroup -> Int)
-> (NodeGroup -> [NodeGroup])
-> (NodeGroup -> NodeGroup -> [NodeGroup])
-> (NodeGroup -> NodeGroup -> [NodeGroup])
-> (NodeGroup -> NodeGroup -> NodeGroup -> [NodeGroup])
-> Enum NodeGroup
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: NodeGroup -> NodeGroup -> NodeGroup -> [NodeGroup]
$cenumFromThenTo :: NodeGroup -> NodeGroup -> NodeGroup -> [NodeGroup]
enumFromTo :: NodeGroup -> NodeGroup -> [NodeGroup]
$cenumFromTo :: NodeGroup -> NodeGroup -> [NodeGroup]
enumFromThen :: NodeGroup -> NodeGroup -> [NodeGroup]
$cenumFromThen :: NodeGroup -> NodeGroup -> [NodeGroup]
enumFrom :: NodeGroup -> [NodeGroup]
$cenumFrom :: NodeGroup -> [NodeGroup]
fromEnum :: NodeGroup -> Int
$cfromEnum :: NodeGroup -> Int
toEnum :: Int -> NodeGroup
$ctoEnum :: Int -> NodeGroup
pred :: NodeGroup -> NodeGroup
$cpred :: NodeGroup -> NodeGroup
succ :: NodeGroup -> NodeGroup
$csucc :: NodeGroup -> NodeGroup
Enum, NodeGroup
NodeGroup -> NodeGroup -> Bounded NodeGroup
forall a. a -> a -> Bounded a
maxBound :: NodeGroup
$cmaxBound :: NodeGroup
minBound :: NodeGroup
$cminBound :: NodeGroup
Bounded)

data NodePartitions a = NodePartitions
  { forall a. NodePartitions a -> a
npOpaque  :: a
  , forall a. NodePartitions a -> a
npBlended :: a
  }
  deriving (NodePartitions a -> NodePartitions a -> Bool
(NodePartitions a -> NodePartitions a -> Bool)
-> (NodePartitions a -> NodePartitions a -> Bool)
-> Eq (NodePartitions a)
forall a. Eq a => NodePartitions a -> NodePartitions a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodePartitions a -> NodePartitions a -> Bool
$c/= :: forall a. Eq a => NodePartitions a -> NodePartitions a -> Bool
== :: NodePartitions a -> NodePartitions a -> Bool
$c== :: forall a. Eq a => NodePartitions a -> NodePartitions a -> Bool
Eq, Int -> NodePartitions a -> ShowS
[NodePartitions a] -> ShowS
NodePartitions a -> String
(Int -> NodePartitions a -> ShowS)
-> (NodePartitions a -> String)
-> ([NodePartitions a] -> ShowS)
-> Show (NodePartitions a)
forall a. Show a => Int -> NodePartitions a -> ShowS
forall a. Show a => [NodePartitions a] -> ShowS
forall a. Show a => NodePartitions a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodePartitions a] -> ShowS
$cshowList :: forall a. Show a => [NodePartitions a] -> ShowS
show :: NodePartitions a -> String
$cshow :: forall a. Show a => NodePartitions a -> String
showsPrec :: Int -> NodePartitions a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> NodePartitions a -> ShowS
Show, (forall a b. (a -> b) -> NodePartitions a -> NodePartitions b)
-> (forall a b. a -> NodePartitions b -> NodePartitions a)
-> Functor NodePartitions
forall a b. a -> NodePartitions b -> NodePartitions a
forall a b. (a -> b) -> NodePartitions a -> NodePartitions b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> NodePartitions b -> NodePartitions a
$c<$ :: forall a b. a -> NodePartitions b -> NodePartitions a
fmap :: forall a b. (a -> b) -> NodePartitions a -> NodePartitions b
$cfmap :: forall a b. (a -> b) -> NodePartitions a -> NodePartitions b
Functor, (forall m. Monoid m => NodePartitions m -> m)
-> (forall m a. Monoid m => (a -> m) -> NodePartitions a -> m)
-> (forall m a. Monoid m => (a -> m) -> NodePartitions a -> m)
-> (forall a b. (a -> b -> b) -> b -> NodePartitions a -> b)
-> (forall a b. (a -> b -> b) -> b -> NodePartitions a -> b)
-> (forall b a. (b -> a -> b) -> b -> NodePartitions a -> b)
-> (forall b a. (b -> a -> b) -> b -> NodePartitions a -> b)
-> (forall a. (a -> a -> a) -> NodePartitions a -> a)
-> (forall a. (a -> a -> a) -> NodePartitions a -> a)
-> (forall a. NodePartitions a -> [a])
-> (forall a. NodePartitions a -> Bool)
-> (forall a. NodePartitions a -> Int)
-> (forall a. Eq a => a -> NodePartitions a -> Bool)
-> (forall a. Ord a => NodePartitions a -> a)
-> (forall a. Ord a => NodePartitions a -> a)
-> (forall a. Num a => NodePartitions a -> a)
-> (forall a. Num a => NodePartitions a -> a)
-> Foldable NodePartitions
forall a. Eq a => a -> NodePartitions a -> Bool
forall a. Num a => NodePartitions a -> a
forall a. Ord a => NodePartitions a -> a
forall m. Monoid m => NodePartitions m -> m
forall a. NodePartitions a -> Bool
forall a. NodePartitions a -> Int
forall a. NodePartitions a -> [a]
forall a. (a -> a -> a) -> NodePartitions a -> a
forall m a. Monoid m => (a -> m) -> NodePartitions a -> m
forall b a. (b -> a -> b) -> b -> NodePartitions a -> b
forall a b. (a -> b -> b) -> b -> NodePartitions a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => NodePartitions a -> a
$cproduct :: forall a. Num a => NodePartitions a -> a
sum :: forall a. Num a => NodePartitions a -> a
$csum :: forall a. Num a => NodePartitions a -> a
minimum :: forall a. Ord a => NodePartitions a -> a
$cminimum :: forall a. Ord a => NodePartitions a -> a
maximum :: forall a. Ord a => NodePartitions a -> a
$cmaximum :: forall a. Ord a => NodePartitions a -> a
elem :: forall a. Eq a => a -> NodePartitions a -> Bool
$celem :: forall a. Eq a => a -> NodePartitions a -> Bool
length :: forall a. NodePartitions a -> Int
$clength :: forall a. NodePartitions a -> Int
null :: forall a. NodePartitions a -> Bool
$cnull :: forall a. NodePartitions a -> Bool
toList :: forall a. NodePartitions a -> [a]
$ctoList :: forall a. NodePartitions a -> [a]
foldl1 :: forall a. (a -> a -> a) -> NodePartitions a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> NodePartitions a -> a
foldr1 :: forall a. (a -> a -> a) -> NodePartitions a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> NodePartitions a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> NodePartitions a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> NodePartitions a -> b
foldl :: forall b a. (b -> a -> b) -> b -> NodePartitions a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> NodePartitions a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> NodePartitions a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> NodePartitions a -> b
foldr :: forall a b. (a -> b -> b) -> b -> NodePartitions a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> NodePartitions a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> NodePartitions a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> NodePartitions a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> NodePartitions a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> NodePartitions a -> m
fold :: forall m. Monoid m => NodePartitions m -> m
$cfold :: forall m. Monoid m => NodePartitions m -> m
Foldable, Functor NodePartitions
Foldable NodePartitions
Functor NodePartitions
-> Foldable NodePartitions
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> NodePartitions a -> f (NodePartitions b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    NodePartitions (f a) -> f (NodePartitions a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> NodePartitions a -> m (NodePartitions b))
-> (forall (m :: * -> *) a.
    Monad m =>
    NodePartitions (m a) -> m (NodePartitions a))
-> Traversable NodePartitions
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
NodePartitions (m a) -> m (NodePartitions a)
forall (f :: * -> *) a.
Applicative f =>
NodePartitions (f a) -> f (NodePartitions a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NodePartitions a -> m (NodePartitions b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NodePartitions a -> f (NodePartitions b)
sequence :: forall (m :: * -> *) a.
Monad m =>
NodePartitions (m a) -> m (NodePartitions a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
NodePartitions (m a) -> m (NodePartitions a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NodePartitions a -> m (NodePartitions b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NodePartitions a -> m (NodePartitions b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
NodePartitions (f a) -> f (NodePartitions a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
NodePartitions (f a) -> f (NodePartitions a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NodePartitions a -> f (NodePartitions b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NodePartitions a -> f (NodePartitions b)
Traversable)

type Nodes = Storable.Vector Node

data Node = Node
  { Node -> Vec4
nBoundingSphere :: Vec4
  , Node -> Transform
nTransformBB    :: Transform
  , Node -> IndexRange
nRange          :: IndexRange
  , Node -> AxisAligned Measurements
nMeasurements   :: AxisAligned Measurements
  }
  deriving (Int -> Node -> ShowS
[Node] -> ShowS
Node -> String
(Int -> Node -> ShowS)
-> (Node -> String) -> ([Node] -> ShowS) -> Show Node
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Node] -> ShowS
$cshowList :: [Node] -> ShowS
show :: Node -> String
$cshow :: Node -> String
showsPrec :: Int -> Node -> ShowS
$cshowsPrec :: Int -> Node -> ShowS
Show, (forall x. Node -> Rep Node x)
-> (forall x. Rep Node x -> Node) -> Generic Node
forall x. Rep Node x -> Node
forall x. Node -> Rep Node x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Node x -> Node
$cfrom :: forall x. Node -> Rep Node x
Generic)

instance Eq Node where
  Node
a == :: Node -> Node -> Bool
== Node
b = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
    [ Node -> Vec4
nBoundingSphere Node
a Vec4 -> Vec4 -> Bool
forall a. Eq a => a -> a -> Bool
== Node -> Vec4
nBoundingSphere Node
b
    , Node -> AxisAligned Measurements
nMeasurements   Node
a AxisAligned Measurements -> AxisAligned Measurements -> Bool
forall a. Eq a => a -> a -> Bool
== Node -> AxisAligned Measurements
nMeasurements   Node
b
    , Node -> IndexRange
nRange          Node
a IndexRange -> IndexRange -> Bool
forall a. Eq a => a -> a -> Bool
== Node -> IndexRange
nRange          Node
b

    , Transform -> [Float]
forall a. Coercible a Mat4 => a -> [Float]
Mat4.toListRowMajor (Node -> Transform
nTransformBB Node
a) [Float] -> [Float] -> Bool
forall a. Eq a => a -> a -> Bool
==
      Transform -> [Float]
forall a. Coercible a Mat4 => a -> [Float]
Mat4.toListRowMajor (Node -> Transform
nTransformBB Node
b)
    ]

instance GStorable Node

type TexturedNodes = Storable.Vector TexturedNode

data TexturedNode = TexturedNode
  { TexturedNode -> Node
tnNode              :: Node
  , TexturedNode -> TextureParams
tnBase              :: TextureParams
  , TexturedNode -> TextureParams
tnEmissive          :: TextureParams
  , TexturedNode -> TextureParams
tnNormal            :: TextureParams
  , TexturedNode -> TextureParams
tnOcclusion         :: TextureParams
  , TexturedNode -> TextureParams
tnMetallicRoughness :: TextureParams
  }
  deriving (TexturedNode -> TexturedNode -> Bool
(TexturedNode -> TexturedNode -> Bool)
-> (TexturedNode -> TexturedNode -> Bool) -> Eq TexturedNode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TexturedNode -> TexturedNode -> Bool
$c/= :: TexturedNode -> TexturedNode -> Bool
== :: TexturedNode -> TexturedNode -> Bool
$c== :: TexturedNode -> TexturedNode -> Bool
Eq, Int -> TexturedNode -> ShowS
[TexturedNode] -> ShowS
TexturedNode -> String
(Int -> TexturedNode -> ShowS)
-> (TexturedNode -> String)
-> ([TexturedNode] -> ShowS)
-> Show TexturedNode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TexturedNode] -> ShowS
$cshowList :: [TexturedNode] -> ShowS
show :: TexturedNode -> String
$cshow :: TexturedNode -> String
showsPrec :: Int -> TexturedNode -> ShowS
$cshowsPrec :: Int -> TexturedNode -> ShowS
Show, (forall x. TexturedNode -> Rep TexturedNode x)
-> (forall x. Rep TexturedNode x -> TexturedNode)
-> Generic TexturedNode
forall x. Rep TexturedNode x -> TexturedNode
forall x. TexturedNode -> Rep TexturedNode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TexturedNode x -> TexturedNode
$cfrom :: forall x. TexturedNode -> Rep TexturedNode x
Generic)

instance GStorable TexturedNode

-- XXX: copypasta from LitTextured.Model
data TextureParams = TextureParams
  { TextureParams -> Vec2
tpScale     :: Vec2
  , TextureParams -> Vec2
tpOffset    :: Vec2
  , TextureParams -> Vec4
tpGamma     :: Vec4
  , TextureParams -> Int32
tpSamplerId :: Int32
  , TextureParams -> Int32
tpTextureId :: Int32
  }
  deriving (TextureParams -> TextureParams -> Bool
(TextureParams -> TextureParams -> Bool)
-> (TextureParams -> TextureParams -> Bool) -> Eq TextureParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextureParams -> TextureParams -> Bool
$c/= :: TextureParams -> TextureParams -> Bool
== :: TextureParams -> TextureParams -> Bool
$c== :: TextureParams -> TextureParams -> Bool
Eq, Int -> TextureParams -> ShowS
[TextureParams] -> ShowS
TextureParams -> String
(Int -> TextureParams -> ShowS)
-> (TextureParams -> String)
-> ([TextureParams] -> ShowS)
-> Show TextureParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextureParams] -> ShowS
$cshowList :: [TextureParams] -> ShowS
show :: TextureParams -> String
$cshow :: TextureParams -> String
showsPrec :: Int -> TextureParams -> ShowS
$cshowsPrec :: Int -> TextureParams -> ShowS
Show, (forall x. TextureParams -> Rep TextureParams x)
-> (forall x. Rep TextureParams x -> TextureParams)
-> Generic TextureParams
forall x. Rep TextureParams x -> TextureParams
forall x. TextureParams -> Rep TextureParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TextureParams x -> TextureParams
$cfrom :: forall x. TextureParams -> Rep TextureParams x
Generic)

instance Zero TextureParams where
  zero :: TextureParams
zero = TextureParams :: Vec2 -> Vec2 -> Vec4 -> Int32 -> Int32 -> TextureParams
TextureParams
    { $sel:tpScale:TextureParams :: Vec2
tpScale     = Vec2
1
    , $sel:tpOffset:TextureParams :: Vec2
tpOffset    = Vec2
0
    , $sel:tpGamma:TextureParams :: Vec4
tpGamma     = Vec4
1.0
    , $sel:tpSamplerId:TextureParams :: Int32
tpSamplerId = Int32
forall a. Bounded a => a
minBound
    , $sel:tpTextureId:TextureParams :: Int32
tpTextureId = Int32
forall a. Bounded a => a
minBound
    }

instance Storable TextureParams where
  alignment :: TextureParams -> Int
alignment ~TextureParams
_ = Int
4

  sizeOf :: TextureParams -> Int
sizeOf ~TextureParams
_ = Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4

  poke :: Ptr TextureParams -> TextureParams -> IO ()
poke Ptr TextureParams
ptr TextureParams{Int32
Vec2
Vec4
tpTextureId :: Int32
tpSamplerId :: Int32
tpGamma :: Vec4
tpOffset :: Vec2
tpScale :: Vec2
$sel:tpTextureId:TextureParams :: TextureParams -> Int32
$sel:tpSamplerId:TextureParams :: TextureParams -> Int32
$sel:tpGamma:TextureParams :: TextureParams -> Vec4
$sel:tpOffset:TextureParams :: TextureParams -> Vec2
$sel:tpScale:TextureParams :: TextureParams -> Vec2
..} = do
    Ptr TextureParams -> Int -> Vec2 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr TextureParams
ptr  Int
0 Vec2
tpScale
    Ptr TextureParams -> Int -> Vec2 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr TextureParams
ptr  Int
8 Vec2
tpOffset
    Ptr TextureParams -> Int -> Vec4 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr TextureParams
ptr Int
16 Vec4
tpGamma
    Ptr TextureParams -> Int -> Int32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr TextureParams
ptr Int
32 Int32
tpSamplerId
    Ptr TextureParams -> Int -> Int32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr TextureParams
ptr Int
36 Int32
tpTextureId

  peek :: Ptr TextureParams -> IO TextureParams
peek Ptr TextureParams
ptr = do
    Vec2
tpScale     <- Ptr TextureParams -> Int -> IO Vec2
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr TextureParams
ptr  Int
0
    Vec2
tpOffset    <- Ptr TextureParams -> Int -> IO Vec2
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr TextureParams
ptr  Int
8
    Vec4
tpGamma     <- Ptr TextureParams -> Int -> IO Vec4
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr TextureParams
ptr Int
16
    Int32
tpSamplerId <- Ptr TextureParams -> Int -> IO Int32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr TextureParams
ptr Int
32
    Int32
tpTextureId <- Ptr TextureParams -> Int -> IO Int32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr TextureParams
ptr Int
36
    pure TextureParams :: Vec2 -> Vec2 -> Vec4 -> Int32 -> Int32 -> TextureParams
TextureParams{Int32
Vec2
Vec4
tpTextureId :: Int32
tpSamplerId :: Int32
tpGamma :: Vec4
tpOffset :: Vec2
tpScale :: Vec2
$sel:tpTextureId:TextureParams :: Int32
$sel:tpSamplerId:TextureParams :: Int32
$sel:tpGamma:TextureParams :: Vec4
$sel:tpOffset:TextureParams :: Vec2
$sel:tpScale:TextureParams :: Vec2
..}

-- * Measurements

data Measurements = Measurements
  { Measurements -> Float
mMin  :: Float
  , Measurements -> Float
mMax  :: Float
  , Measurements -> Float
mMean :: Float
  , Measurements -> Float
mStd  :: Float
  }
  deriving (Measurements -> Measurements -> Bool
(Measurements -> Measurements -> Bool)
-> (Measurements -> Measurements -> Bool) -> Eq Measurements
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Measurements -> Measurements -> Bool
$c/= :: Measurements -> Measurements -> Bool
== :: Measurements -> Measurements -> Bool
$c== :: Measurements -> Measurements -> Bool
Eq, Eq Measurements
Eq Measurements
-> (Measurements -> Measurements -> Ordering)
-> (Measurements -> Measurements -> Bool)
-> (Measurements -> Measurements -> Bool)
-> (Measurements -> Measurements -> Bool)
-> (Measurements -> Measurements -> Bool)
-> (Measurements -> Measurements -> Measurements)
-> (Measurements -> Measurements -> Measurements)
-> Ord Measurements
Measurements -> Measurements -> Bool
Measurements -> Measurements -> Ordering
Measurements -> Measurements -> Measurements
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Measurements -> Measurements -> Measurements
$cmin :: Measurements -> Measurements -> Measurements
max :: Measurements -> Measurements -> Measurements
$cmax :: Measurements -> Measurements -> Measurements
>= :: Measurements -> Measurements -> Bool
$c>= :: Measurements -> Measurements -> Bool
> :: Measurements -> Measurements -> Bool
$c> :: Measurements -> Measurements -> Bool
<= :: Measurements -> Measurements -> Bool
$c<= :: Measurements -> Measurements -> Bool
< :: Measurements -> Measurements -> Bool
$c< :: Measurements -> Measurements -> Bool
compare :: Measurements -> Measurements -> Ordering
$ccompare :: Measurements -> Measurements -> Ordering
Ord, Int -> Measurements -> ShowS
[Measurements] -> ShowS
Measurements -> String
(Int -> Measurements -> ShowS)
-> (Measurements -> String)
-> ([Measurements] -> ShowS)
-> Show Measurements
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Measurements] -> ShowS
$cshowList :: [Measurements] -> ShowS
show :: Measurements -> String
$cshow :: Measurements -> String
showsPrec :: Int -> Measurements -> ShowS
$cshowsPrec :: Int -> Measurements -> ShowS
Show, (forall x. Measurements -> Rep Measurements x)
-> (forall x. Rep Measurements x -> Measurements)
-> Generic Measurements
forall x. Rep Measurements x -> Measurements
forall x. Measurements -> Rep Measurements x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Measurements x -> Measurements
$cfrom :: forall x. Measurements -> Rep Measurements x
Generic)

instance Storable Measurements where
  alignment :: Measurements -> Int
alignment ~Measurements
_ = Int
4 -- XXX: 16?

  sizeOf :: Measurements -> Int
sizeOf ~Measurements
_ = Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4

  peek :: Ptr Measurements -> IO Measurements
peek Ptr Measurements
ptr = do
    Float
mMin  <- Ptr Measurements -> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Measurements
ptr  Int
0
    Float
mMax  <- Ptr Measurements -> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Measurements
ptr  Int
4
    Float
mMean <- Ptr Measurements -> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Measurements
ptr  Int
8
    Float
mStd  <- Ptr Measurements -> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Measurements
ptr Int
12
    pure Measurements :: Float -> Float -> Float -> Float -> Measurements
Measurements{Float
mStd :: Float
mMean :: Float
mMax :: Float
mMin :: Float
$sel:mStd:Measurements :: Float
$sel:mMean:Measurements :: Float
$sel:mMax:Measurements :: Float
$sel:mMin:Measurements :: Float
..}

  poke :: Ptr Measurements -> Measurements -> IO ()
poke Ptr Measurements
ptr Measurements{Float
mStd :: Float
mMean :: Float
mMax :: Float
mMin :: Float
$sel:mStd:Measurements :: Measurements -> Float
$sel:mMean:Measurements :: Measurements -> Float
$sel:mMax:Measurements :: Measurements -> Float
$sel:mMin:Measurements :: Measurements -> Float
..} = do
    Ptr Measurements -> Int -> Float -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Measurements
ptr  Int
0 Float
mMin
    Ptr Measurements -> Int -> Float -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Measurements
ptr  Int
4 Float
mMax
    Ptr Measurements -> Int -> Float -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Measurements
ptr  Int
8 Float
mMean
    Ptr Measurements -> Int -> Float -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Measurements
ptr Int
12 Float
mStd

instance CBOR.Serialise Measurements

{-# INLINEABLE middleAa #-}
middleAa :: AxisAligned Measurements -> AxisAligned Float
middleAa :: AxisAligned Measurements -> AxisAligned Float
middleAa = (Measurements -> Float)
-> AxisAligned Measurements -> AxisAligned Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Measurements -> Float
middle

{-# INLINEABLE middle #-}
middle :: Measurements -> Float
middle :: Measurements -> Float
middle Measurements{Float
mMax :: Float
$sel:mMax:Measurements :: Measurements -> Float
mMax, Float
mMin :: Float
$sel:mMin:Measurements :: Measurements -> Float
mMin} = Float
mMin Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
0.5 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
mMax Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
0.5

{-# INLINEABLE sizeAa #-}
sizeAa :: AxisAligned Measurements -> AxisAligned Float
sizeAa :: AxisAligned Measurements -> AxisAligned Float
sizeAa = (Measurements -> Float)
-> AxisAligned Measurements -> AxisAligned Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Measurements -> Float
size

{-# INLINEABLE size #-}
size :: Measurements -> Float
size :: Measurements -> Float
size Measurements{Float
mMax :: Float
$sel:mMax:Measurements :: Measurements -> Float
mMax, Float
mMin :: Float
$sel:mMin:Measurements :: Measurements -> Float
mMin} = Float
mMax Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
mMin

measureAaWith
  :: (Foldable outer, Foldable inner)
  => (a -> inner Vec3.Packed)
  -> outer a
  -> AxisAligned Measurements
measureAaWith :: forall (outer :: * -> *) (inner :: * -> *) a.
(Foldable outer, Foldable inner) =>
(a -> inner Packed) -> outer a -> AxisAligned Measurements
measureAaWith a -> inner Packed
f = Fold a (AxisAligned Measurements)
-> outer a -> AxisAligned Measurements
forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
L.fold ((a -> inner Packed) -> Fold a (AxisAligned Measurements)
forall (t :: * -> *) a.
Foldable t =>
(a -> t Packed) -> Fold a (AxisAligned Measurements)
measureAaWithF a -> inner Packed
f)

measureAaWithF :: (Foldable t) => (a -> (t Vec3.Packed)) -> L.Fold a (AxisAligned Measurements)
measureAaWithF :: forall (t :: * -> *) a.
Foldable t =>
(a -> t Packed) -> Fold a (AxisAligned Measurements)
measureAaWithF a -> t Packed
f = (a -> t Packed)
-> Fold (t Packed) (AxisAligned Measurements)
-> Fold a (AxisAligned Measurements)
forall a b r. (a -> b) -> Fold b r -> Fold a r
L.premap a -> t Packed
f (Handler (t Packed) Packed
-> Fold Packed (AxisAligned Measurements)
-> Fold (t Packed) (AxisAligned Measurements)
forall a b r. Handler a b -> Fold b r -> Fold a r
L.handles Handler (t Packed) Packed
forall (f :: * -> *) (t :: * -> *) a.
(Contravariant f, Applicative f, Foldable t) =>
(a -> f a) -> t a -> f (t a)
L.folded Fold Packed (AxisAligned Measurements)
measureAaF)

measureAa :: Foldable t => t Vec3.Packed -> AxisAligned Measurements
measureAa :: forall (t :: * -> *).
Foldable t =>
t Packed -> AxisAligned Measurements
measureAa = Fold Packed (AxisAligned Measurements)
-> t Packed -> AxisAligned Measurements
forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
L.fold Fold Packed (AxisAligned Measurements)
measureAaF

measureAaF :: L.Fold Vec3.Packed (AxisAligned Measurements)
measureAaF :: Fold Packed (AxisAligned Measurements)
measureAaF = Measurements
-> Measurements -> Measurements -> AxisAligned Measurements
forall a. a -> a -> a -> AxisAligned a
AxisAligned
  (Measurements
 -> Measurements -> Measurements -> AxisAligned Measurements)
-> Fold Packed Measurements
-> Fold
     Packed (Measurements -> Measurements -> AxisAligned Measurements)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Packed -> Float)
-> Fold Float Measurements -> Fold Packed Measurements
forall a b r. (a -> b) -> Fold b r -> Fold a r
L.premap Packed -> Float
packedX Fold Float Measurements
measureF
  Fold
  Packed (Measurements -> Measurements -> AxisAligned Measurements)
-> Fold Packed Measurements
-> Fold Packed (Measurements -> AxisAligned Measurements)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Packed -> Float)
-> Fold Float Measurements -> Fold Packed Measurements
forall a b r. (a -> b) -> Fold b r -> Fold a r
L.premap Packed -> Float
packedY Fold Float Measurements
measureF
  Fold Packed (Measurements -> AxisAligned Measurements)
-> Fold Packed Measurements
-> Fold Packed (AxisAligned Measurements)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Packed -> Float)
-> Fold Float Measurements -> Fold Packed Measurements
forall a b r. (a -> b) -> Fold b r -> Fold a r
L.premap Packed -> Float
packedZ Fold Float Measurements
measureF

measureF :: L.Fold Float Measurements
measureF :: Fold Float Measurements
measureF = do
  Float
mMin  <- (Maybe Float -> Float)
-> Fold Float (Maybe Float) -> Fold Float Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Float -> Maybe Float -> Float
forall a. a -> Maybe a -> a
fromMaybe Float
0) Fold Float (Maybe Float)
forall a. Ord a => Fold a (Maybe a)
L.minimum
  Float
mMax  <- (Maybe Float -> Float)
-> Fold Float (Maybe Float) -> Fold Float Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Float -> Maybe Float -> Float
forall a. a -> Maybe a -> a
fromMaybe Float
0) Fold Float (Maybe Float)
forall a. Ord a => Fold a (Maybe a)
L.maximum
  Float
mMean <- Fold Float Float
forall a. Fractional a => Fold a a
L.mean
  Float
mStd  <- Fold Float Float
forall a. Floating a => Fold a a
L.std
  pure Measurements :: Float -> Float -> Float -> Float -> Measurements
Measurements{Float
mStd :: Float
mMean :: Float
mMax :: Float
mMin :: Float
$sel:mStd:Measurements :: Float
$sel:mMean:Measurements :: Float
$sel:mMax:Measurements :: Float
$sel:mMin:Measurements :: Float
..}

-- * Utils

{-# INLINE packedX #-}
packedX :: Vec3.Packed -> Float
packedX :: Packed -> Float
packedX (Vec3.Packed Vec3
pos) = Vec3 -> (Float -> Float -> Float -> Float) -> Float
forall r. Vec3 -> (Float -> Float -> Float -> r) -> r
withVec3 Vec3
pos \Float
x Float
_y Float
_z -> Float
x

{-# INLINE packedY #-}
packedY :: Vec3.Packed -> Float
packedY :: Packed -> Float
packedY (Vec3.Packed Vec3
pos) = Vec3 -> (Float -> Float -> Float -> Float) -> Float
forall r. Vec3 -> (Float -> Float -> Float -> r) -> r
withVec3 Vec3
pos \Float
_x Float
y Float
_z -> Float
y

{-# INLINE packedZ #-}
packedZ :: Vec3.Packed -> Float
packedZ :: Packed -> Float
packedZ (Vec3.Packed Vec3
pos) = Vec3 -> (Float -> Float -> Float -> Float) -> Float
forall r. Vec3 -> (Float -> Float -> Float -> r) -> r
withVec3 Vec3
pos \Float
_x Float
_y Float
z -> Float
z

class HasRange a where
  getRange :: a -> IndexRange
  adjustRange :: a -> Word32 -> a

instance HasRange Node where
  {-# INLINEABLE getRange #-}
  getRange :: Node -> IndexRange
getRange = Node -> IndexRange
nRange

  {-# INLINEABLE adjustRange #-}
  adjustRange :: Node -> Word32 -> Node
adjustRange node :: Node
node@Node{IndexRange
nRange :: IndexRange
$sel:nRange:Node :: Node -> IndexRange
nRange} Word32
newFirstIndex = Node
node
    { $sel:nRange:Node :: IndexRange
nRange = IndexRange
nRange
        { $sel:irFirstIndex:IndexRange :: Word32
irFirstIndex = Word32
newFirstIndex
        }
    }

instance HasRange TexturedNode where
  {-# INLINE getRange #-}
  getRange :: TexturedNode -> IndexRange
getRange = Node -> IndexRange
forall a. HasRange a => a -> IndexRange
getRange (Node -> IndexRange)
-> (TexturedNode -> Node) -> TexturedNode -> IndexRange
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TexturedNode -> Node
tnNode

  {-# INLINE adjustRange #-}
  adjustRange :: TexturedNode -> Word32 -> TexturedNode
adjustRange tn :: TexturedNode
tn@TexturedNode{Node
tnNode :: Node
$sel:tnNode:TexturedNode :: TexturedNode -> Node
tnNode} Word32
newFirstIndex = TexturedNode
tn
    { $sel:tnNode:TexturedNode :: Node
tnNode = Node -> Word32 -> Node
forall a. HasRange a => a -> Word32 -> a
adjustRange Node
tnNode Word32
newFirstIndex
    }

-- | CBOR.encode helper for storable types (vectors, etc.)
{-# NOINLINE encodeStorable #-}
encodeStorable :: forall a . Storable a => a -> CBOR.Encoding
encodeStorable :: forall a. Storable a => a -> Encoding
encodeStorable a
x = IO Encoding -> Encoding
forall a. IO a -> a
unsafePerformIO do
  Ptr a
ptr <- forall a. Storable a => IO (Ptr a)
Foreign.malloc @a
  Ptr a -> a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr a
ptr a
x
  ByteString
buf <- CStringLen -> IO ByteString
BS.unsafePackMallocCStringLen
    ( Ptr a -> Ptr CChar
forall a b. Ptr a -> Ptr b
Foreign.castPtr Ptr a
ptr
    , a -> Int
forall a. Storable a => a -> Int
Foreign.sizeOf (a
forall a. HasCallStack => a
undefined :: a)
    )
  pure $ ByteString -> Encoding
forall a. Serialise a => a -> Encoding
CBOR.encode ByteString
buf

-- | CBOR.decode helper for storable types (vectors, etc.)
decodeStorable :: forall a s . (Storable a, Typeable a) => CBOR.Decoder s a
decodeStorable :: forall a s. (Storable a, Typeable a) => Decoder s a
decodeStorable = do
  ByteString
buf <- Decoder s ByteString
forall s. Decoder s ByteString
CBOR.decodeBytes
  case ByteString -> Either String a
fromBuf ByteString
buf of
    Left String
err ->
      String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
    Right !a
res ->
      a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
res
  where
    expected :: Int
expected =
      a -> Int
forall a. Storable a => a -> Int
Foreign.sizeOf (a
forall a. HasCallStack => a
undefined :: a)

    {-# NOINLINE fromBuf #-}
    fromBuf :: ByteString -> Either String a
    fromBuf :: ByteString -> Either String a
fromBuf ByteString
buf =
      IO (Either String a) -> Either String a
forall a. IO a -> a
unsafePerformIO (IO (Either String a) -> Either String a)
-> IO (Either String a) -> Either String a
forall a b. (a -> b) -> a -> b
$
        ByteString
-> (CStringLen -> IO (Either String a)) -> IO (Either String a)
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.unsafeUseAsCStringLen ByteString
buf \(Ptr CChar
ptr, Int
len) ->
          if Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
expected then do
            !a
res <- Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
Foreign.peek (Ptr CChar -> Ptr a
forall a b. Ptr a -> Ptr b
Foreign.castPtr Ptr CChar
ptr)
            Either String a -> IO (Either String a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String a -> IO (Either String a))
-> Either String a -> IO (Either String a)
forall a b. (a -> b) -> a -> b
$ a -> Either String a
forall a b. b -> Either a b
Right a
res
          else
            Either String a -> IO (Either String a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String a -> IO (Either String a))
-> (String -> Either String a) -> String -> IO (Either String a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String a
forall a b. a -> Either a b
Left (String -> IO (Either String a)) -> String -> IO (Either String a)
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. Monoid a => [a] -> a
mconcat
              [ String
"Storable size mismatch for "
              , TyCon -> String
forall a. Show a => a -> String
show (TypeRep -> TyCon
typeRepTyCon (TypeRep -> TyCon) -> (Proxy a -> TypeRep) -> Proxy a -> TyCon
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy a -> TyCon) -> Proxy a -> TyCon
forall a b. (a -> b) -> a -> b
$ forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)
              , String
" (expected: ", Int -> String
forall a. Show a => a -> String
show Int
expected
              , String
", got: ", Int -> String
forall a. Show a => a -> String
show Int
len
              , String
")"
              ]