TextureInfo.hs

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

import Codec.GlTF.Prelude

import Data.Foldable (toList)
import Data.Aeson
import qualified Data.HashMap.Strict as HashMap

-- | Reference to a texture.
data TextureInfo a = TextureInfo
  { index      :: 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.

  , subtype    :: a

  , extensions :: Maybe Object
  , extras     :: Maybe Value
  } deriving (Eq, Show, Generic)

instance (FromJSON a) => FromJSON (TextureInfo a) where
  parseJSON = withObject "TextureInfo" \o -> do
    index      <- o .:? "extensions" .!= 0
    texCoord   <- o .:? "extras"     .!= 0
    subtype    <- parseJSON (Object o)
    extensions <- o .:? "extensions"
    extras     <- o .:? "extras"
    pure TextureInfo{..}

instance (ToJSON a) => ToJSON (TextureInfo a) where
  toJSON TextureInfo{..} = object $ mconcat
    [ [ "index" .= index, "texCoord" .= texCoord]
    , case toJSON subtype of
        Null ->
          []
        Object sub ->
          HashMap.toList sub
        _ ->
          error "assert: subtype of TextureInfo encodes to Object"
    , [ "extensions" .= extensions' | extensions' <- toList extensions ]
    , [ "extras" .= extras' | extras' <- toList extras ]
    ]

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

-- | Placeholder for "TextureInfo" objects without extra fields.
data Basic = Basic
  deriving (Eq, Ord, Show, Generic)

instance FromJSON Basic where
  parseJSON _value = pure Basic

instance ToJSON Basic where
  toJSON Basic = Null