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
(Rotation -> Rotation -> Bool)
-> (Rotation -> Rotation -> Bool) -> Eq Rotation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Rotation -> Rotation -> Bool
== :: Rotation -> Rotation -> Bool
$c/= :: Rotation -> Rotation -> Bool
/= :: Rotation -> Rotation -> Bool
Eq, Int -> Rotation -> ShowS
[Rotation] -> ShowS
Rotation -> String
(Int -> Rotation -> ShowS)
-> (Rotation -> String) -> ([Rotation] -> ShowS) -> Show Rotation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Rotation -> ShowS
showsPrec :: Int -> Rotation -> ShowS
$cshow :: Rotation -> String
show :: Rotation -> String
$cshowList :: [Rotation] -> ShowS
showList :: [Rotation] -> ShowS
Show)

instance Json.FromJSON Rotation where
  parseJSON :: Value -> Parser Rotation
parseJSON = String -> (Object -> Parser Rotation) -> Value -> Parser Rotation
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Json.withObject String
"Rotation" ((Object -> Parser Rotation) -> Value -> Parser Rotation)
-> (Object -> Parser Rotation) -> Value -> Parser Rotation
forall a b. (a -> b) -> a -> b
$ \Object
object ->
    [Parser Rotation] -> Parser Rotation
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
Foldable.asum
      [ (CompressedWordVector -> Rotation)
-> Parser CompressedWordVector -> Parser Rotation
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompressedWordVector -> Rotation
CompressedWordVector (Parser CompressedWordVector -> Parser Rotation)
-> Parser CompressedWordVector -> Parser Rotation
forall a b. (a -> b) -> a -> b
$ Object -> String -> Parser CompressedWordVector
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"compressed_word_vector",
        (Quaternion -> Rotation) -> Parser Quaternion -> Parser Rotation
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Quaternion -> Rotation
Quaternion (Parser Quaternion -> Parser Rotation)
-> Parser Quaternion -> Parser Rotation
forall a b. (a -> b) -> a -> b
$ Object -> String -> Parser Quaternion
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 [String -> CompressedWordVector -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"compressed_word_vector" CompressedWordVector
y]
    Quaternion Quaternion
y -> [(Key, Value)] -> Value
Json.object [String -> Quaternion -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"quaternion" Quaternion
y]

schema :: Schema.Schema
schema :: Schema
schema =
  String -> Value -> Schema
Schema.named String
"rotation" (Value -> Schema) -> ([Value] -> Value) -> [Value] -> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Value
Schema.oneOf ([Value] -> Schema) -> [Value] -> Schema
forall a b. (a -> b) -> a -> b
$
    ((String, Schema) -> Value) -> [(String, Schema)] -> [Value]
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 [(String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
k (Value -> (Key, Value)) -> Value -> (Key, Value)
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 (Quaternion -> Rotation)
-> Get BitString Identity Quaternion -> BitGet Rotation
forall a b.
(a -> b) -> Get BitString Identity a -> Get BitString Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Quaternion -> Rotation
Quaternion Get BitString Identity Quaternion
Quaternion.bitGet
    else (CompressedWordVector -> Rotation)
-> Get BitString Identity CompressedWordVector -> BitGet Rotation
forall a b.
(a -> b) -> Get BitString Identity a -> Get BitString Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompressedWordVector -> Rotation
CompressedWordVector Get BitString Identity CompressedWordVector
CompressedWordVector.bitGet