module Rattletrap.Type.Attribute.Location where

import qualified Rattletrap.BitGet as BitGet
import qualified Rattletrap.BitPut as BitPut
import qualified Rattletrap.Schema as Schema
import qualified Rattletrap.Type.Vector as Vector
import qualified Rattletrap.Type.Version as Version
import qualified Rattletrap.Utility.Json as Json

newtype Location = Location
  { Location -> Vector
value :: Vector.Vector
  }
  deriving (Location -> Location -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Location -> Location -> Bool
$c/= :: Location -> Location -> Bool
== :: Location -> Location -> Bool
$c== :: Location -> Location -> Bool
Eq, Int -> Location -> ShowS
[Location] -> ShowS
Location -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Location] -> ShowS
$cshowList :: [Location] -> ShowS
show :: Location -> String
$cshow :: Location -> String
showsPrec :: Int -> Location -> ShowS
$cshowsPrec :: Int -> Location -> ShowS
Show)

instance Json.FromJSON Location where
  parseJSON :: Value -> Parser Location
parseJSON = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector -> Location
Location forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => Value -> Parser a
Json.parseJSON

instance Json.ToJSON Location where
  toJSON :: Location -> Value
toJSON = forall a. ToJSON a => a -> Value
Json.toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. Location -> Vector
value

schema :: Schema.Schema
schema :: Schema
schema = String -> Value -> Schema
Schema.named String
"attribute-location" forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Vector.schema

bitPut :: Location -> BitPut.BitPut
bitPut :: Location -> BitPut
bitPut Location
locationAttribute = Vector -> BitPut
Vector.bitPut (Location -> Vector
value Location
locationAttribute)

bitGet :: Version.Version -> BitGet.BitGet Location
bitGet :: Version -> BitGet Location
bitGet Version
version = forall a. String -> BitGet a -> BitGet a
BitGet.label String
"Location" forall a b. (a -> b) -> a -> b
$ do
  Vector
value <- forall a. String -> BitGet a -> BitGet a
BitGet.label String
"value" forall a b. (a -> b) -> a -> b
$ Version -> BitGet Vector
Vector.bitGet Version
version
  forall (f :: * -> *) a. Applicative f => a -> f a
pure Location {Vector
value :: Vector
value :: Vector
value}