module Codec.GlTF.Scene
  ( SceneIx(..)
  , Scene(..)
  ) where

import Codec.GlTF.Prelude

import Codec.GlTF.Node (NodeIx)

newtype SceneIx = SceneIx { SceneIx -> Int
unSceneIx :: Int }
  deriving (SceneIx -> SceneIx -> Bool
(SceneIx -> SceneIx -> Bool)
-> (SceneIx -> SceneIx -> Bool) -> Eq SceneIx
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SceneIx -> SceneIx -> Bool
$c/= :: SceneIx -> SceneIx -> Bool
== :: SceneIx -> SceneIx -> Bool
$c== :: SceneIx -> SceneIx -> Bool
Eq, Eq SceneIx
Eq SceneIx
-> (SceneIx -> SceneIx -> Ordering)
-> (SceneIx -> SceneIx -> Bool)
-> (SceneIx -> SceneIx -> Bool)
-> (SceneIx -> SceneIx -> Bool)
-> (SceneIx -> SceneIx -> Bool)
-> (SceneIx -> SceneIx -> SceneIx)
-> (SceneIx -> SceneIx -> SceneIx)
-> Ord SceneIx
SceneIx -> SceneIx -> Bool
SceneIx -> SceneIx -> Ordering
SceneIx -> SceneIx -> SceneIx
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 :: SceneIx -> SceneIx -> SceneIx
$cmin :: SceneIx -> SceneIx -> SceneIx
max :: SceneIx -> SceneIx -> SceneIx
$cmax :: SceneIx -> SceneIx -> SceneIx
>= :: SceneIx -> SceneIx -> Bool
$c>= :: SceneIx -> SceneIx -> Bool
> :: SceneIx -> SceneIx -> Bool
$c> :: SceneIx -> SceneIx -> Bool
<= :: SceneIx -> SceneIx -> Bool
$c<= :: SceneIx -> SceneIx -> Bool
< :: SceneIx -> SceneIx -> Bool
$c< :: SceneIx -> SceneIx -> Bool
compare :: SceneIx -> SceneIx -> Ordering
$ccompare :: SceneIx -> SceneIx -> Ordering
$cp1Ord :: Eq SceneIx
Ord, Int -> SceneIx -> ShowS
[SceneIx] -> ShowS
SceneIx -> String
(Int -> SceneIx -> ShowS)
-> (SceneIx -> String) -> ([SceneIx] -> ShowS) -> Show SceneIx
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SceneIx] -> ShowS
$cshowList :: [SceneIx] -> ShowS
show :: SceneIx -> String
$cshow :: SceneIx -> String
showsPrec :: Int -> SceneIx -> ShowS
$cshowsPrec :: Int -> SceneIx -> ShowS
Show, Value -> Parser [SceneIx]
Value -> Parser SceneIx
(Value -> Parser SceneIx)
-> (Value -> Parser [SceneIx]) -> FromJSON SceneIx
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [SceneIx]
$cparseJSONList :: Value -> Parser [SceneIx]
parseJSON :: Value -> Parser SceneIx
$cparseJSON :: Value -> Parser SceneIx
FromJSON, [SceneIx] -> Encoding
[SceneIx] -> Value
SceneIx -> Encoding
SceneIx -> Value
(SceneIx -> Value)
-> (SceneIx -> Encoding)
-> ([SceneIx] -> Value)
-> ([SceneIx] -> Encoding)
-> ToJSON SceneIx
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [SceneIx] -> Encoding
$ctoEncodingList :: [SceneIx] -> Encoding
toJSONList :: [SceneIx] -> Value
$ctoJSONList :: [SceneIx] -> Value
toEncoding :: SceneIx -> Encoding
$ctoEncoding :: SceneIx -> Encoding
toJSON :: SceneIx -> Value
$ctoJSON :: SceneIx -> Value
ToJSON, (forall x. SceneIx -> Rep SceneIx x)
-> (forall x. Rep SceneIx x -> SceneIx) -> Generic SceneIx
forall x. Rep SceneIx x -> SceneIx
forall x. SceneIx -> Rep SceneIx x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SceneIx x -> SceneIx
$cfrom :: forall x. SceneIx -> Rep SceneIx x
Generic)

data Scene = Scene
  { Scene -> Maybe (Vector NodeIx)
nodes       :: Maybe (Vector NodeIx)
  , Scene -> Maybe Text
name        :: Maybe Text
  , Scene -> Maybe Object
extensions  :: Maybe Object
  , Scene -> Maybe Value
extras      :: Maybe Value
  } deriving (Scene -> Scene -> Bool
(Scene -> Scene -> Bool) -> (Scene -> Scene -> Bool) -> Eq Scene
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Scene -> Scene -> Bool
$c/= :: Scene -> Scene -> Bool
== :: Scene -> Scene -> Bool
$c== :: Scene -> Scene -> Bool
Eq, Int -> Scene -> ShowS
[Scene] -> ShowS
Scene -> String
(Int -> Scene -> ShowS)
-> (Scene -> String) -> ([Scene] -> ShowS) -> Show Scene
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Scene] -> ShowS
$cshowList :: [Scene] -> ShowS
show :: Scene -> String
$cshow :: Scene -> String
showsPrec :: Int -> Scene -> ShowS
$cshowsPrec :: Int -> Scene -> ShowS
Show, (forall x. Scene -> Rep Scene x)
-> (forall x. Rep Scene x -> Scene) -> Generic Scene
forall x. Rep Scene x -> Scene
forall x. Scene -> Rep Scene x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Scene x -> Scene
$cfrom :: forall x. Scene -> Rep Scene x
Generic)

instance FromJSON Scene
instance ToJSON Scene