module Text.GLTF.Loader.Gltf
  ( -- * Data constructors
    Gltf(..),
    Asset(..),
    Mesh(..),
    Node(..),
    MeshPrimitive(..),
    MeshPrimitiveMode(..),
    -- * Lenses
    _asset,
    _meshes,
    _nodes,
    _assetVersion,
    _assetCopyright,
    _assetGenerator,
    _assetMinVersion,
    _meshPrimitives,
    _meshPrimitiveMode,
    _meshPrimitiveIndices,
    _meshPrimitivePositions,
    _meshPrimitiveNormals,
    _meshWeights,
    _meshName,
    _nodeMeshId,
    _nodeName,
    _nodeRotation,
    _nodeScale,
    _nodeTranslation,
    _nodeWeights
  ) where

import Linear.V3 (V3(..))
import Linear.V4 (V4(..))
import RIO

data Gltf = Gltf
  { Gltf -> Asset
gltfAsset :: Asset,
    Gltf -> [Mesh]
gltfMeshes :: [Mesh],
    Gltf -> [Node]
gltfNodes :: [Node] }
  deriving (Gltf -> Gltf -> Bool
(Gltf -> Gltf -> Bool) -> (Gltf -> Gltf -> Bool) -> Eq Gltf
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Gltf -> Gltf -> Bool
$c/= :: Gltf -> Gltf -> Bool
== :: Gltf -> Gltf -> Bool
$c== :: Gltf -> Gltf -> Bool
Eq, Int -> Gltf -> ShowS
[Gltf] -> ShowS
Gltf -> String
(Int -> Gltf -> ShowS)
-> (Gltf -> String) -> ([Gltf] -> ShowS) -> Show Gltf
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Gltf] -> ShowS
$cshowList :: [Gltf] -> ShowS
show :: Gltf -> String
$cshow :: Gltf -> String
showsPrec :: Int -> Gltf -> ShowS
$cshowsPrec :: Int -> Gltf -> ShowS
Show)

data Asset = Asset
  { Asset -> Text
assetVersion :: Text,
    Asset -> Maybe Text
assetCopyright :: Maybe Text,
    Asset -> Maybe Text
assetGenerator :: Maybe Text,
    Asset -> Maybe Text
assetMinVersion :: Maybe Text
  } deriving (Asset -> Asset -> Bool
(Asset -> Asset -> Bool) -> (Asset -> Asset -> Bool) -> Eq Asset
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Asset -> Asset -> Bool
$c/= :: Asset -> Asset -> Bool
== :: Asset -> Asset -> Bool
$c== :: Asset -> Asset -> Bool
Eq, Int -> Asset -> ShowS
[Asset] -> ShowS
Asset -> String
(Int -> Asset -> ShowS)
-> (Asset -> String) -> ([Asset] -> ShowS) -> Show Asset
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Asset] -> ShowS
$cshowList :: [Asset] -> ShowS
show :: Asset -> String
$cshow :: Asset -> String
showsPrec :: Int -> Asset -> ShowS
$cshowsPrec :: Int -> Asset -> ShowS
Show)

data Mesh = Mesh
  { Mesh -> [MeshPrimitive]
meshPrimitives :: [MeshPrimitive],
    Mesh -> [Float]
meshWeights :: [Float],
    Mesh -> Maybe Text
meshName :: Maybe Text
  } deriving (Mesh -> Mesh -> Bool
(Mesh -> Mesh -> Bool) -> (Mesh -> Mesh -> Bool) -> Eq Mesh
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mesh -> Mesh -> Bool
$c/= :: Mesh -> Mesh -> Bool
== :: Mesh -> Mesh -> Bool
$c== :: Mesh -> Mesh -> Bool
Eq, Int -> Mesh -> ShowS
[Mesh] -> ShowS
Mesh -> String
(Int -> Mesh -> ShowS)
-> (Mesh -> String) -> ([Mesh] -> ShowS) -> Show Mesh
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mesh] -> ShowS
$cshowList :: [Mesh] -> ShowS
show :: Mesh -> String
$cshow :: Mesh -> String
showsPrec :: Int -> Mesh -> ShowS
$cshowsPrec :: Int -> Mesh -> ShowS
Show)

data Node = Node
  { Node -> Maybe Int
nodeMeshId :: Maybe Int,
    Node -> Maybe Text
nodeName :: Maybe Text,
    Node -> Maybe (V4 Float)
nodeRotation :: Maybe (V4 Float),
    Node -> Maybe (V3 Float)
nodeScale :: Maybe (V3 Float),
    Node -> Maybe (V3 Float)
nodeTranslation :: Maybe (V3 Float),
    Node -> [Float]
nodeWeights :: [Float]
  } deriving (Node -> Node -> Bool
(Node -> Node -> Bool) -> (Node -> Node -> Bool) -> Eq Node
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Node -> Node -> Bool
$c/= :: Node -> Node -> Bool
== :: Node -> Node -> Bool
$c== :: Node -> Node -> Bool
Eq, 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)

data MeshPrimitive = MeshPrimitive
  { MeshPrimitive -> MeshPrimitiveMode
meshPrimitiveMode :: MeshPrimitiveMode,
    MeshPrimitive -> [Int]
meshPrimitiveIndices :: [Int],
    MeshPrimitive -> [V3 Float]
meshPrimitivePositions :: [V3 Float],
    MeshPrimitive -> [V3 Float]
meshPrimitiveNormals :: [V3 Float]
  } deriving (MeshPrimitive -> MeshPrimitive -> Bool
(MeshPrimitive -> MeshPrimitive -> Bool)
-> (MeshPrimitive -> MeshPrimitive -> Bool) -> Eq MeshPrimitive
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MeshPrimitive -> MeshPrimitive -> Bool
$c/= :: MeshPrimitive -> MeshPrimitive -> Bool
== :: MeshPrimitive -> MeshPrimitive -> Bool
$c== :: MeshPrimitive -> MeshPrimitive -> Bool
Eq, Int -> MeshPrimitive -> ShowS
[MeshPrimitive] -> ShowS
MeshPrimitive -> String
(Int -> MeshPrimitive -> ShowS)
-> (MeshPrimitive -> String)
-> ([MeshPrimitive] -> ShowS)
-> Show MeshPrimitive
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MeshPrimitive] -> ShowS
$cshowList :: [MeshPrimitive] -> ShowS
show :: MeshPrimitive -> String
$cshow :: MeshPrimitive -> String
showsPrec :: Int -> MeshPrimitive -> ShowS
$cshowsPrec :: Int -> MeshPrimitive -> ShowS
Show)

data MeshPrimitiveMode
  = Points
  | Lines
  | LineLoop
  | LineStrip
  | Triangles
  | TriangleStrip
  | TriangleFan
  deriving (MeshPrimitiveMode -> MeshPrimitiveMode -> Bool
(MeshPrimitiveMode -> MeshPrimitiveMode -> Bool)
-> (MeshPrimitiveMode -> MeshPrimitiveMode -> Bool)
-> Eq MeshPrimitiveMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MeshPrimitiveMode -> MeshPrimitiveMode -> Bool
$c/= :: MeshPrimitiveMode -> MeshPrimitiveMode -> Bool
== :: MeshPrimitiveMode -> MeshPrimitiveMode -> Bool
$c== :: MeshPrimitiveMode -> MeshPrimitiveMode -> Bool
Eq, Int -> MeshPrimitiveMode
MeshPrimitiveMode -> Int
MeshPrimitiveMode -> [MeshPrimitiveMode]
MeshPrimitiveMode -> MeshPrimitiveMode
MeshPrimitiveMode -> MeshPrimitiveMode -> [MeshPrimitiveMode]
MeshPrimitiveMode
-> MeshPrimitiveMode -> MeshPrimitiveMode -> [MeshPrimitiveMode]
(MeshPrimitiveMode -> MeshPrimitiveMode)
-> (MeshPrimitiveMode -> MeshPrimitiveMode)
-> (Int -> MeshPrimitiveMode)
-> (MeshPrimitiveMode -> Int)
-> (MeshPrimitiveMode -> [MeshPrimitiveMode])
-> (MeshPrimitiveMode -> MeshPrimitiveMode -> [MeshPrimitiveMode])
-> (MeshPrimitiveMode -> MeshPrimitiveMode -> [MeshPrimitiveMode])
-> (MeshPrimitiveMode
    -> MeshPrimitiveMode -> MeshPrimitiveMode -> [MeshPrimitiveMode])
-> Enum MeshPrimitiveMode
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 :: MeshPrimitiveMode
-> MeshPrimitiveMode -> MeshPrimitiveMode -> [MeshPrimitiveMode]
$cenumFromThenTo :: MeshPrimitiveMode
-> MeshPrimitiveMode -> MeshPrimitiveMode -> [MeshPrimitiveMode]
enumFromTo :: MeshPrimitiveMode -> MeshPrimitiveMode -> [MeshPrimitiveMode]
$cenumFromTo :: MeshPrimitiveMode -> MeshPrimitiveMode -> [MeshPrimitiveMode]
enumFromThen :: MeshPrimitiveMode -> MeshPrimitiveMode -> [MeshPrimitiveMode]
$cenumFromThen :: MeshPrimitiveMode -> MeshPrimitiveMode -> [MeshPrimitiveMode]
enumFrom :: MeshPrimitiveMode -> [MeshPrimitiveMode]
$cenumFrom :: MeshPrimitiveMode -> [MeshPrimitiveMode]
fromEnum :: MeshPrimitiveMode -> Int
$cfromEnum :: MeshPrimitiveMode -> Int
toEnum :: Int -> MeshPrimitiveMode
$ctoEnum :: Int -> MeshPrimitiveMode
pred :: MeshPrimitiveMode -> MeshPrimitiveMode
$cpred :: MeshPrimitiveMode -> MeshPrimitiveMode
succ :: MeshPrimitiveMode -> MeshPrimitiveMode
$csucc :: MeshPrimitiveMode -> MeshPrimitiveMode
Enum, Int -> MeshPrimitiveMode -> ShowS
[MeshPrimitiveMode] -> ShowS
MeshPrimitiveMode -> String
(Int -> MeshPrimitiveMode -> ShowS)
-> (MeshPrimitiveMode -> String)
-> ([MeshPrimitiveMode] -> ShowS)
-> Show MeshPrimitiveMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MeshPrimitiveMode] -> ShowS
$cshowList :: [MeshPrimitiveMode] -> ShowS
show :: MeshPrimitiveMode -> String
$cshow :: MeshPrimitiveMode -> String
showsPrec :: Int -> MeshPrimitiveMode -> ShowS
$cshowsPrec :: Int -> MeshPrimitiveMode -> ShowS
Show)

_asset :: Lens' Gltf Asset
_asset :: (Asset -> f Asset) -> Gltf -> f Gltf
_asset = (Gltf -> Asset)
-> (Gltf -> Asset -> Gltf) -> Lens Gltf Gltf Asset Asset
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Gltf -> Asset
gltfAsset (\Gltf
gltf Asset
asset -> Gltf
gltf { gltfAsset :: Asset
gltfAsset = Asset
asset })

_meshes :: Lens' Gltf [Mesh]
_meshes :: ([Mesh] -> f [Mesh]) -> Gltf -> f Gltf
_meshes = (Gltf -> [Mesh])
-> (Gltf -> [Mesh] -> Gltf) -> Lens Gltf Gltf [Mesh] [Mesh]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Gltf -> [Mesh]
gltfMeshes (\Gltf
gltf [Mesh]
meshes -> Gltf
gltf { gltfMeshes :: [Mesh]
gltfMeshes = [Mesh]
meshes })

_nodes :: Lens' Gltf [Node]
_nodes :: ([Node] -> f [Node]) -> Gltf -> f Gltf
_nodes = (Gltf -> [Node])
-> (Gltf -> [Node] -> Gltf) -> Lens Gltf Gltf [Node] [Node]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Gltf -> [Node]
gltfNodes (\Gltf
gltf [Node]
nodes -> Gltf
gltf { gltfNodes :: [Node]
gltfNodes = [Node]
nodes })

_assetVersion :: Lens' Asset Text
_assetVersion :: (Text -> f Text) -> Asset -> f Asset
_assetVersion = (Asset -> Text)
-> (Asset -> Text -> Asset) -> Lens Asset Asset Text Text
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Asset -> Text
assetVersion (\Asset
asset Text
version' -> Asset
asset { assetVersion :: Text
assetVersion = Text
version' })

_assetCopyright :: Lens' Asset (Maybe Text)
_assetCopyright :: (Maybe Text -> f (Maybe Text)) -> Asset -> f Asset
_assetCopyright = (Asset -> Maybe Text)
-> (Asset -> Maybe Text -> Asset)
-> Lens Asset Asset (Maybe Text) (Maybe Text)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
  Asset -> Maybe Text
assetCopyright
  (\Asset
asset Maybe Text
copyright' -> Asset
asset { assetCopyright :: Maybe Text
assetCopyright = Maybe Text
copyright' })

_assetGenerator :: Lens' Asset (Maybe Text)
_assetGenerator :: (Maybe Text -> f (Maybe Text)) -> Asset -> f Asset
_assetGenerator = (Asset -> Maybe Text)
-> (Asset -> Maybe Text -> Asset)
-> Lens Asset Asset (Maybe Text) (Maybe Text)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
  Asset -> Maybe Text
assetGenerator
  (\Asset
asset Maybe Text
generator' -> Asset
asset { assetGenerator :: Maybe Text
assetGenerator = Maybe Text
generator' })

_assetMinVersion :: Lens' Asset (Maybe Text)
_assetMinVersion :: (Maybe Text -> f (Maybe Text)) -> Asset -> f Asset
_assetMinVersion = (Asset -> Maybe Text)
-> (Asset -> Maybe Text -> Asset)
-> Lens Asset Asset (Maybe Text) (Maybe Text)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
  Asset -> Maybe Text
assetMinVersion
  (\Asset
asset Maybe Text
minVersion' -> Asset
asset { assetMinVersion :: Maybe Text
assetMinVersion = Maybe Text
minVersion' })

_meshPrimitives :: Lens' Mesh [MeshPrimitive]
_meshPrimitives :: ([MeshPrimitive] -> f [MeshPrimitive]) -> Mesh -> f Mesh
_meshPrimitives = (Mesh -> [MeshPrimitive])
-> (Mesh -> [MeshPrimitive] -> Mesh)
-> Lens Mesh Mesh [MeshPrimitive] [MeshPrimitive]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
  Mesh -> [MeshPrimitive]
meshPrimitives
  (\Mesh
mesh [MeshPrimitive]
primitives -> Mesh
mesh { meshPrimitives :: [MeshPrimitive]
meshPrimitives = [MeshPrimitive]
primitives })

_meshPrimitiveMode :: Lens' MeshPrimitive MeshPrimitiveMode
_meshPrimitiveMode :: (MeshPrimitiveMode -> f MeshPrimitiveMode)
-> MeshPrimitive -> f MeshPrimitive
_meshPrimitiveMode = (MeshPrimitive -> MeshPrimitiveMode)
-> (MeshPrimitive -> MeshPrimitiveMode -> MeshPrimitive)
-> Lens
     MeshPrimitive MeshPrimitive MeshPrimitiveMode MeshPrimitiveMode
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
  MeshPrimitive -> MeshPrimitiveMode
meshPrimitiveMode
  (\MeshPrimitive
primitive' MeshPrimitiveMode
mode -> MeshPrimitive
primitive' { meshPrimitiveMode :: MeshPrimitiveMode
meshPrimitiveMode = MeshPrimitiveMode
mode })

_meshPrimitiveIndices :: Lens' MeshPrimitive [Int]
_meshPrimitiveIndices :: ([Int] -> f [Int]) -> MeshPrimitive -> f MeshPrimitive
_meshPrimitiveIndices = (MeshPrimitive -> [Int])
-> (MeshPrimitive -> [Int] -> MeshPrimitive)
-> Lens MeshPrimitive MeshPrimitive [Int] [Int]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
  MeshPrimitive -> [Int]
meshPrimitiveIndices
  (\MeshPrimitive
primitive' [Int]
indices -> MeshPrimitive
primitive' { meshPrimitiveIndices :: [Int]
meshPrimitiveIndices = [Int]
indices })

_meshPrimitivePositions :: Lens' MeshPrimitive [V3 Float]
_meshPrimitivePositions :: ([V3 Float] -> f [V3 Float]) -> MeshPrimitive -> f MeshPrimitive
_meshPrimitivePositions = (MeshPrimitive -> [V3 Float])
-> (MeshPrimitive -> [V3 Float] -> MeshPrimitive)
-> Lens MeshPrimitive MeshPrimitive [V3 Float] [V3 Float]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
  MeshPrimitive -> [V3 Float]
meshPrimitivePositions
  (\MeshPrimitive
primitive' [V3 Float]
positions -> MeshPrimitive
primitive' { meshPrimitivePositions :: [V3 Float]
meshPrimitivePositions = [V3 Float]
positions })

_meshPrimitiveNormals :: Lens' MeshPrimitive [V3 Float]
_meshPrimitiveNormals :: ([V3 Float] -> f [V3 Float]) -> MeshPrimitive -> f MeshPrimitive
_meshPrimitiveNormals = (MeshPrimitive -> [V3 Float])
-> (MeshPrimitive -> [V3 Float] -> MeshPrimitive)
-> Lens MeshPrimitive MeshPrimitive [V3 Float] [V3 Float]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
  MeshPrimitive -> [V3 Float]
meshPrimitiveNormals
  (\MeshPrimitive
primitive' [V3 Float]
normals -> MeshPrimitive
primitive' { meshPrimitiveNormals :: [V3 Float]
meshPrimitiveNormals = [V3 Float]
normals })
  
_meshWeights :: Lens' Mesh [Float]
_meshWeights :: ([Float] -> f [Float]) -> Mesh -> f Mesh
_meshWeights = (Mesh -> [Float])
-> (Mesh -> [Float] -> Mesh) -> Lens Mesh Mesh [Float] [Float]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Mesh -> [Float]
meshWeights (\Mesh
mesh [Float]
weights -> Mesh
mesh { meshWeights :: [Float]
meshWeights = [Float]
weights })

_meshName :: Lens' Mesh (Maybe Text)
_meshName :: (Maybe Text -> f (Maybe Text)) -> Mesh -> f Mesh
_meshName = (Mesh -> Maybe Text)
-> (Mesh -> Maybe Text -> Mesh)
-> Lens Mesh Mesh (Maybe Text) (Maybe Text)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Mesh -> Maybe Text
meshName (\Mesh
mesh Maybe Text
name -> Mesh
mesh { meshName :: Maybe Text
meshName = Maybe Text
name })

_nodeMeshId :: Lens' Node (Maybe Int)
_nodeMeshId :: (Maybe Int -> f (Maybe Int)) -> Node -> f Node
_nodeMeshId = (Node -> Maybe Int)
-> (Node -> Maybe Int -> Node)
-> Lens Node Node (Maybe Int) (Maybe Int)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Node -> Maybe Int
nodeMeshId (\Node
node Maybe Int
meshId -> Node
node { nodeMeshId :: Maybe Int
nodeMeshId = Maybe Int
meshId })

_nodeName :: Lens' Node (Maybe Text)
_nodeName :: (Maybe Text -> f (Maybe Text)) -> Node -> f Node
_nodeName = (Node -> Maybe Text)
-> (Node -> Maybe Text -> Node)
-> Lens Node Node (Maybe Text) (Maybe Text)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Node -> Maybe Text
nodeName (\Node
node Maybe Text
name' -> Node
node { nodeName :: Maybe Text
nodeName = Maybe Text
name' })

_nodeRotation :: Lens' Node (Maybe (V4 Float))
_nodeRotation :: (Maybe (V4 Float) -> f (Maybe (V4 Float))) -> Node -> f Node
_nodeRotation = (Node -> Maybe (V4 Float))
-> (Node -> Maybe (V4 Float) -> Node)
-> Lens Node Node (Maybe (V4 Float)) (Maybe (V4 Float))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Node -> Maybe (V4 Float)
nodeRotation (\Node
node Maybe (V4 Float)
rotation' -> Node
node { nodeRotation :: Maybe (V4 Float)
nodeRotation = Maybe (V4 Float)
rotation' })

_nodeScale :: Lens' Node (Maybe (V3 Float))
_nodeScale :: (Maybe (V3 Float) -> f (Maybe (V3 Float))) -> Node -> f Node
_nodeScale = (Node -> Maybe (V3 Float))
-> (Node -> Maybe (V3 Float) -> Node)
-> Lens Node Node (Maybe (V3 Float)) (Maybe (V3 Float))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Node -> Maybe (V3 Float)
nodeScale (\Node
node Maybe (V3 Float)
scale' -> Node
node { nodeScale :: Maybe (V3 Float)
nodeScale = Maybe (V3 Float)
scale' })

_nodeTranslation :: Lens' Node (Maybe (V3 Float))
_nodeTranslation :: (Maybe (V3 Float) -> f (Maybe (V3 Float))) -> Node -> f Node
_nodeTranslation = (Node -> Maybe (V3 Float))
-> (Node -> Maybe (V3 Float) -> Node)
-> Lens Node Node (Maybe (V3 Float)) (Maybe (V3 Float))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
  Node -> Maybe (V3 Float)
nodeTranslation
  (\Node
node Maybe (V3 Float)
translation' -> Node
node { nodeTranslation :: Maybe (V3 Float)
nodeTranslation = Maybe (V3 Float)
translation' })

_nodeWeights :: Lens' Node [Float]
_nodeWeights :: ([Float] -> f [Float]) -> Node -> f Node
_nodeWeights = (Node -> [Float])
-> (Node -> [Float] -> Node) -> Lens Node Node [Float] [Float]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Node -> [Float]
nodeWeights (\Node
node [Float]
weights' -> Node
node { nodeWeights :: [Float]
nodeWeights = [Float]
weights' })