module Rattletrap.Type.Property.Array where

import qualified Rattletrap.ByteGet as ByteGet
import qualified Rattletrap.BytePut as BytePut
import qualified Rattletrap.Schema as Schema
import qualified Rattletrap.Type.Dictionary as Dictionary
import qualified Rattletrap.Type.List as List
import qualified Rattletrap.Utility.Json as Json

newtype Array a
  = Array (List.List (Dictionary.Dictionary a))
  deriving (Array a -> Array a -> Bool
(Array a -> Array a -> Bool)
-> (Array a -> Array a -> Bool) -> Eq (Array a)
forall a. Eq a => Array a -> Array a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Array a -> Array a -> Bool
$c/= :: forall a. Eq a => Array a -> Array a -> Bool
== :: Array a -> Array a -> Bool
$c== :: forall a. Eq a => Array a -> Array a -> Bool
Eq, Int -> Array a -> ShowS
[Array a] -> ShowS
Array a -> String
(Int -> Array a -> ShowS)
-> (Array a -> String) -> ([Array a] -> ShowS) -> Show (Array a)
forall a. Show a => Int -> Array a -> ShowS
forall a. Show a => [Array a] -> ShowS
forall a. Show a => Array a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Array a] -> ShowS
$cshowList :: forall a. Show a => [Array a] -> ShowS
show :: Array a -> String
$cshow :: forall a. Show a => Array a -> String
showsPrec :: Int -> Array a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Array a -> ShowS
Show)

fromList :: List.List (Dictionary.Dictionary a) -> Array a
fromList :: List (Dictionary a) -> Array a
fromList = List (Dictionary a) -> Array a
forall a. List (Dictionary a) -> Array a
Array

toList :: Array a -> List.List (Dictionary.Dictionary a)
toList :: Array a -> List (Dictionary a)
toList (Array List (Dictionary a)
x) = List (Dictionary a)
x

instance Json.FromJSON a => Json.FromJSON (Array a) where
  parseJSON :: Value -> Parser (Array a)
parseJSON = (List (Dictionary a) -> Array a)
-> Parser (List (Dictionary a)) -> Parser (Array a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap List (Dictionary a) -> Array a
forall a. List (Dictionary a) -> Array a
fromList (Parser (List (Dictionary a)) -> Parser (Array a))
-> (Value -> Parser (List (Dictionary a)))
-> Value
-> Parser (Array a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser (List (Dictionary a))
forall a. FromJSON a => Value -> Parser a
Json.parseJSON

instance Json.ToJSON a => Json.ToJSON (Array a) where
  toJSON :: Array a -> Value
toJSON = List (Dictionary a) -> Value
forall a. ToJSON a => a -> Value
Json.toJSON (List (Dictionary a) -> Value)
-> (Array a -> List (Dictionary a)) -> Array a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array a -> List (Dictionary a)
forall a. Array a -> List (Dictionary a)
toList

schema :: Schema.Schema -> Schema.Schema
schema :: Schema -> Schema
schema Schema
s =
  String -> Value -> Schema
Schema.named String
"property-array" (Value -> Schema) -> (Schema -> Value) -> Schema -> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json (Schema -> Value) -> (Schema -> Schema) -> Schema -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Schema
List.schema (Schema -> Schema) -> Schema -> Schema
forall a b. (a -> b) -> a -> b
$ Schema -> Schema
Dictionary.schema
    Schema
s

bytePut :: (a -> BytePut.BytePut) -> Array a -> BytePut.BytePut
bytePut :: (a -> BytePut) -> Array a -> BytePut
bytePut a -> BytePut
f = (Dictionary a -> BytePut) -> List (Dictionary a) -> BytePut
forall a. (a -> BytePut) -> List a -> BytePut
List.bytePut ((a -> BytePut) -> Dictionary a -> BytePut
forall a. (a -> BytePut) -> Dictionary a -> BytePut
Dictionary.bytePut a -> BytePut
f) (List (Dictionary a) -> BytePut)
-> (Array a -> List (Dictionary a)) -> Array a -> BytePut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array a -> List (Dictionary a)
forall a. Array a -> List (Dictionary a)
toList

byteGet :: ByteGet.ByteGet a -> ByteGet.ByteGet (Array a)
byteGet :: ByteGet a -> ByteGet (Array a)
byteGet =
  String -> ByteGet (Array a) -> ByteGet (Array a)
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"Array" (ByteGet (Array a) -> ByteGet (Array a))
-> (ByteGet a -> ByteGet (Array a))
-> ByteGet a
-> ByteGet (Array a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (List (Dictionary a) -> Array a)
-> Get ByteString Identity (List (Dictionary a))
-> ByteGet (Array a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap List (Dictionary a) -> Array a
forall a. List (Dictionary a) -> Array a
fromList (Get ByteString Identity (List (Dictionary a))
 -> ByteGet (Array a))
-> (ByteGet a -> Get ByteString Identity (List (Dictionary a)))
-> ByteGet a
-> ByteGet (Array a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteGet (Dictionary a)
-> Get ByteString Identity (List (Dictionary a))
forall a. ByteGet a -> ByteGet (List a)
List.byteGet (ByteGet (Dictionary a)
 -> Get ByteString Identity (List (Dictionary a)))
-> (ByteGet a -> ByteGet (Dictionary a))
-> ByteGet a
-> Get ByteString Identity (List (Dictionary a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteGet a -> ByteGet (Dictionary a)
forall a. ByteGet a -> ByteGet (Dictionary a)
Dictionary.byteGet