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
(Location -> Location -> Bool)
-> (Location -> Location -> Bool) -> Eq Location
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
(Int -> Location -> ShowS)
-> (Location -> String) -> ([Location] -> ShowS) -> Show Location
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 = (Vector -> Location) -> Parser Vector -> Parser Location
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector -> Location
Location (Parser Vector -> Parser Location)
-> (Value -> Parser Vector) -> Value -> Parser Location
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Vector
forall a. FromJSON a => Value -> Parser a
Json.parseJSON

instance Json.ToJSON Location where
  toJSON :: Location -> Value
toJSON = Vector -> Value
forall a. ToJSON a => a -> Value
Json.toJSON (Vector -> Value) -> (Location -> Vector) -> Location -> Value
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" (Value -> Schema) -> Value -> Schema
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 = String -> BitGet Location -> BitGet Location
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"Location" (BitGet Location -> BitGet Location)
-> BitGet Location -> BitGet Location
forall a b. (a -> b) -> a -> b
$ do
  Vector
value <- String -> BitGet Vector -> BitGet Vector
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"value" (BitGet Vector -> BitGet Vector) -> BitGet Vector -> BitGet Vector
forall a b. (a -> b) -> a -> b
$ Version -> BitGet Vector
Vector.bitGet Version
version
  Location -> BitGet Location
forall (f :: * -> *) a. Applicative f => a -> f a
pure Location :: Vector -> Location
Location { Vector
value :: Vector
value :: Vector
value }