module Rattletrap.Type.Rotation where

import qualified Data.Foldable as Foldable
import qualified Rattletrap.BitGet as BitGet
import qualified Rattletrap.BitPut as BitPut
import qualified Rattletrap.Schema as Schema
import qualified Rattletrap.Type.CompressedWordVector as CompressedWordVector
import qualified Rattletrap.Type.Quaternion as Quaternion
import qualified Rattletrap.Type.Version as Version
import qualified Rattletrap.Utility.Json as Json

data Rotation
  = CompressedWordVector CompressedWordVector.CompressedWordVector
  | Quaternion Quaternion.Quaternion
  deriving (Rotation -> Rotation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Rotation -> Rotation -> Bool
$c/= :: Rotation -> Rotation -> Bool
== :: Rotation -> Rotation -> Bool
$c== :: Rotation -> Rotation -> Bool
Eq, Int -> Rotation -> ShowS
[Rotation] -> ShowS
Rotation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Rotation] -> ShowS
$cshowList :: [Rotation] -> ShowS
show :: Rotation -> String
$cshow :: Rotation -> String
showsPrec :: Int -> Rotation -> ShowS
$cshowsPrec :: Int -> Rotation -> ShowS
Show)

instance Json.FromJSON Rotation where
  parseJSON :: Value -> Parser Rotation
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
Json.withObject String
"Rotation" forall a b. (a -> b) -> a -> b
$ \Object
object ->
    forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
Foldable.asum
      [ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompressedWordVector -> Rotation
CompressedWordVector forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"compressed_word_vector",
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Quaternion -> Rotation
Quaternion forall a b. (a -> b) -> a -> b
$ forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"quaternion"
      ]

instance Json.ToJSON Rotation where
  toJSON :: Rotation -> Value
toJSON Rotation
x = case Rotation
x of
    CompressedWordVector CompressedWordVector
y ->
      [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"compressed_word_vector" CompressedWordVector
y]
    Quaternion Quaternion
y -> [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"quaternion" Quaternion
y]

schema :: Schema.Schema
schema :: Schema
schema =
  String -> Value -> Schema
Schema.named String
"rotation" forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Value
Schema.oneOf forall a b. (a -> b) -> a -> b
$
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
      (\(String
k, Schema
v) -> [((Key, Value), Bool)] -> Value
Schema.object [(forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
k forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
v, Bool
True)])
      [ (String
"compressed_word_vector", Schema
CompressedWordVector.schema),
        (String
"quaternion", Schema
Quaternion.schema)
      ]

bitPut :: Rotation -> BitPut.BitPut
bitPut :: Rotation -> BitPut
bitPut Rotation
r = case Rotation
r of
  CompressedWordVector CompressedWordVector
cwv -> CompressedWordVector -> BitPut
CompressedWordVector.bitPut CompressedWordVector
cwv
  Quaternion Quaternion
q -> Quaternion -> BitPut
Quaternion.bitPut Quaternion
q

bitGet :: Version.Version -> BitGet.BitGet Rotation
bitGet :: Version -> BitGet Rotation
bitGet Version
version =
  if Int -> Int -> Int -> Version -> Bool
Version.atLeast Int
868 Int
22 Int
7 Version
version
    then forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Quaternion -> Rotation
Quaternion BitGet Quaternion
Quaternion.bitGet
    else forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompressedWordVector -> Rotation
CompressedWordVector BitGet CompressedWordVector
CompressedWordVector.bitGet