{-# LANGUAGE CPP #-}

module Codec.GlTF.TextureInfo
  ( TextureInfo(..)
  , TextureInfo_
  , Basic(..)
  ) where

import Codec.GlTF.Prelude

import Data.Foldable (toList)
import Data.Aeson

#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.KeyMap as KeyMap
#else
import qualified Data.HashMap.Strict as KeyMap
#endif

-- | Reference to a texture.
data TextureInfo a = TextureInfo
  { TextureInfo a -> Int
index      :: Int
  , TextureInfo a -> Int
texCoord   :: Int
    -- ^ This integer value is used to construct a string
    -- in the format @TEXCOORD_<set index>@ which is a reference
    -- to a key in @mesh.primitives.attributes@
    -- (e.g. A value of 0 corresponds to @TEXCOORD_0@).
    --
    -- Mesh must have corresponding texture coordinate attributes
    -- for the material to be applicable to it.

  , TextureInfo a -> a
subtype    :: a

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

instance (FromJSON a) => FromJSON (TextureInfo a) where
  parseJSON :: Value -> Parser (TextureInfo a)
parseJSON = String
-> (Object -> Parser (TextureInfo a))
-> Value
-> Parser (TextureInfo a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"TextureInfo" \Object
o -> do
    Int
index      <- Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"index" Parser (Maybe Int) -> Int -> Parser Int
forall a. Parser (Maybe a) -> a -> Parser a
.!= Int
0
    Int
texCoord   <- Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"texCoord" Parser (Maybe Int) -> Int -> Parser Int
forall a. Parser (Maybe a) -> a -> Parser a
.!= Int
0
    a
subtype    <- Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
    Maybe Object
extensions <- Object
o Object -> Key -> Parser (Maybe Object)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"extensions"
    Maybe Value
extras     <- Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"extras"
    pure TextureInfo :: forall a.
Int -> Int -> a -> Maybe Object -> Maybe Value -> TextureInfo a
TextureInfo{a
Int
Maybe Value
Maybe Object
extras :: Maybe Value
extensions :: Maybe Object
subtype :: a
texCoord :: Int
index :: Int
$sel:extras:TextureInfo :: Maybe Value
$sel:extensions:TextureInfo :: Maybe Object
$sel:subtype:TextureInfo :: a
$sel:texCoord:TextureInfo :: Int
$sel:index:TextureInfo :: Int
..}

instance (ToJSON a) => ToJSON (TextureInfo a) where
  toJSON :: TextureInfo a -> Value
toJSON TextureInfo{a
Int
Maybe Value
Maybe Object
extras :: Maybe Value
extensions :: Maybe Object
subtype :: a
texCoord :: Int
index :: Int
$sel:extras:TextureInfo :: forall a. TextureInfo a -> Maybe Value
$sel:extensions:TextureInfo :: forall a. TextureInfo a -> Maybe Object
$sel:subtype:TextureInfo :: forall a. TextureInfo a -> a
$sel:texCoord:TextureInfo :: forall a. TextureInfo a -> Int
$sel:index:TextureInfo :: forall a. TextureInfo a -> Int
..} = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [[Pair]] -> [Pair]
forall a. Monoid a => [a] -> a
mconcat
    [ [ Key
"index" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
index, Key
"texCoord" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
texCoord]
    , case a -> Value
forall a. ToJSON a => a -> Value
toJSON a
subtype of
        Value
Null ->
          []
        Object Object
sub ->
          Object -> [Pair]
forall v. KeyMap v -> [(Key, v)]
KeyMap.toList Object
sub
        Value
_ ->
          String -> [Pair]
forall a. HasCallStack => String -> a
error String
"assert: subtype of TextureInfo encodes to Object"
    , [ Key
"extensions" Key -> Object -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Object
extensions' | Object
extensions' <- Maybe Object -> [Object]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Maybe Object
extensions ]
    , [ Key
"extras" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
extras' | Value
extras' <- Maybe Value -> [Value]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Maybe Value
extras ]
    ]

-- | "TextureInfo" without extra fields.
type TextureInfo_ = TextureInfo Basic

-- | Placeholder for "TextureInfo" objects without extra fields.
data Basic = Basic
  deriving (Basic -> Basic -> Bool
(Basic -> Basic -> Bool) -> (Basic -> Basic -> Bool) -> Eq Basic
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Basic -> Basic -> Bool
$c/= :: Basic -> Basic -> Bool
== :: Basic -> Basic -> Bool
$c== :: Basic -> Basic -> Bool
Eq, Eq Basic
Eq Basic
-> (Basic -> Basic -> Ordering)
-> (Basic -> Basic -> Bool)
-> (Basic -> Basic -> Bool)
-> (Basic -> Basic -> Bool)
-> (Basic -> Basic -> Bool)
-> (Basic -> Basic -> Basic)
-> (Basic -> Basic -> Basic)
-> Ord Basic
Basic -> Basic -> Bool
Basic -> Basic -> Ordering
Basic -> Basic -> Basic
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 :: Basic -> Basic -> Basic
$cmin :: Basic -> Basic -> Basic
max :: Basic -> Basic -> Basic
$cmax :: Basic -> Basic -> Basic
>= :: Basic -> Basic -> Bool
$c>= :: Basic -> Basic -> Bool
> :: Basic -> Basic -> Bool
$c> :: Basic -> Basic -> Bool
<= :: Basic -> Basic -> Bool
$c<= :: Basic -> Basic -> Bool
< :: Basic -> Basic -> Bool
$c< :: Basic -> Basic -> Bool
compare :: Basic -> Basic -> Ordering
$ccompare :: Basic -> Basic -> Ordering
$cp1Ord :: Eq Basic
Ord, Int -> Basic -> ShowS
[Basic] -> ShowS
Basic -> String
(Int -> Basic -> ShowS)
-> (Basic -> String) -> ([Basic] -> ShowS) -> Show Basic
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Basic] -> ShowS
$cshowList :: [Basic] -> ShowS
show :: Basic -> String
$cshow :: Basic -> String
showsPrec :: Int -> Basic -> ShowS
$cshowsPrec :: Int -> Basic -> ShowS
Show, (forall x. Basic -> Rep Basic x)
-> (forall x. Rep Basic x -> Basic) -> Generic Basic
forall x. Rep Basic x -> Basic
forall x. Basic -> Rep Basic x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Basic x -> Basic
$cfrom :: forall x. Basic -> Rep Basic x
Generic)

instance FromJSON Basic where
  parseJSON :: Value -> Parser Basic
parseJSON Value
_value = Basic -> Parser Basic
forall (f :: * -> *) a. Applicative f => a -> f a
pure Basic
Basic

instance ToJSON Basic where
  toJSON :: Basic -> Value
toJSON Basic
Basic = Value
Null