module Rattletrap.Type.List where

import qualified Control.Monad as Monad
import qualified Rattletrap.ByteGet as ByteGet
import qualified Rattletrap.BytePut as BytePut
import qualified Rattletrap.Schema as Schema
import qualified Rattletrap.Type.U32 as U32
import qualified Rattletrap.Utility.Json as Json

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

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

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

schema :: Schema.Schema -> Schema.Schema
schema :: Schema -> Schema
schema = Schema -> Schema
Schema.array

fromList :: [a] -> List a
fromList :: [a] -> List a
fromList = [a] -> List a
forall a. [a] -> List a
List

empty :: List a
empty :: List a
empty = [a] -> List a
forall a. [a] -> List a
fromList []

toList :: List a -> [a]
toList :: List a -> [a]
toList (List [a]
x) = [a]
x

bytePut :: (a -> BytePut.BytePut) -> List a -> BytePut.BytePut
bytePut :: (a -> BytePut) -> List a -> BytePut
bytePut a -> BytePut
f List a
x =
  let v :: [a]
v = List a -> [a]
forall a. List a -> [a]
toList List a
x
  in (U32 -> BytePut
U32.bytePut (U32 -> BytePut) -> (Int -> U32) -> Int -> BytePut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> U32
U32.fromWord32 (Word32 -> U32) -> (Int -> Word32) -> Int -> U32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> BytePut) -> Int -> BytePut
forall a b. (a -> b) -> a -> b
$ [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
v) BytePut -> BytePut -> BytePut
forall a. Semigroup a => a -> a -> a
<> (a -> BytePut) -> [a] -> BytePut
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> BytePut
f [a]
v

byteGet :: ByteGet.ByteGet a -> ByteGet.ByteGet (List a)
byteGet :: ByteGet a -> ByteGet (List a)
byteGet ByteGet a
f = String -> ByteGet (List a) -> ByteGet (List a)
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"List" (ByteGet (List a) -> ByteGet (List a))
-> ByteGet (List a) -> ByteGet (List a)
forall a b. (a -> b) -> a -> b
$ do
  U32
size <- String -> ByteGet U32 -> ByteGet U32
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"size" ByteGet U32
U32.byteGet
  Int -> (Int -> ByteGet a) -> ByteGet (List a)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (List a)
generateM (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ U32 -> Word32
U32.toWord32 U32
size)
    ((Int -> ByteGet a) -> ByteGet (List a))
-> (Int -> ByteGet a) -> ByteGet (List a)
forall a b. (a -> b) -> a -> b
$ \Int
i -> String -> ByteGet a -> ByteGet a
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label (String
"element (" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
i String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")") ByteGet a
f

generateM :: Monad m => Int -> (Int -> m a) -> m (List a)
generateM :: Int -> (Int -> m a) -> m (List a)
generateM Int
n Int -> m a
f = ([a] -> List a) -> m [a] -> m (List a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> List a
forall a. [a] -> List a
fromList (m [a] -> m (List a)) -> m [a] -> m (List a)
forall a b. (a -> b) -> a -> b
$ (Int -> m a) -> [Int] -> m [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Int -> m a
f [Int
0 .. Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]

replicateM :: Monad m => Int -> m a -> m (List a)
replicateM :: Int -> m a -> m (List a)
replicateM Int
n = ([a] -> List a) -> m [a] -> m (List a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> List a
forall a. [a] -> List a
fromList (m [a] -> m (List a)) -> (m a -> m [a]) -> m a -> m (List a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> m a -> m [a]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
Monad.replicateM Int
n

untilM :: Monad m => m (Maybe a) -> m (List a)
untilM :: m (Maybe a) -> m (List a)
untilM m (Maybe a)
f = m (Maybe a) -> Int -> [(Int, a)] -> m (List a)
forall (m :: * -> *) a.
Monad m =>
m (Maybe a) -> Int -> [(Int, a)] -> m (List a)
untilMWith m (Maybe a)
f Int
0 []

untilMWith :: Monad m => m (Maybe a) -> Int -> [(Int, a)] -> m (List a)
untilMWith :: m (Maybe a) -> Int -> [(Int, a)] -> m (List a)
untilMWith m (Maybe a)
f Int
i [(Int, a)]
xs = do
  Maybe a
m <- m (Maybe a)
f
  case Maybe a
m of
    Maybe a
Nothing -> List a -> m (List a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (List a -> m (List a)) -> ([a] -> List a) -> [a] -> m (List a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> List a
forall a. [a] -> List a
fromList ([a] -> List a) -> ([a] -> [a]) -> [a] -> List a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> m (List a)) -> [a] -> m (List a)
forall a b. (a -> b) -> a -> b
$ ((Int, a) -> a) -> [(Int, a)] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, a) -> a
forall a b. (a, b) -> b
snd [(Int, a)]
xs
    Just a
x -> m (Maybe a) -> Int -> [(Int, a)] -> m (List a)
forall (m :: * -> *) a.
Monad m =>
m (Maybe a) -> Int -> [(Int, a)] -> m (List a)
untilMWith m (Maybe a)
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ((Int
i, a
x) (Int, a) -> [(Int, a)] -> [(Int, a)]
forall a. a -> [a] -> [a]
: [(Int, a)]
xs)