{-# LANGUAGE StrictData #-}
module Network.Tox.SaveData.Util where

import           Control.Monad   (when)
import           Data.Binary     (Binary (get))
import           Data.Binary.Get (Get)
import qualified Data.Binary.Get as Get
import           Data.Binary.Put (Put)
import qualified Data.Binary.Put as Put
import           Data.Word       (Word16, Word32)


-- | Consumes the entire stream and parses some Binary out of it in a loop.
getList :: (Binary a, Show a) => Get [a]
getList :: Get [a]
getList = [a] -> Get [a]
forall a. Binary a => [a] -> Get [a]
go []
  where
    go :: [a] -> Get [a]
go [a]
xs = do
        Bool
isEmpty <- Get Bool
Get.isEmpty
        if Bool
isEmpty
            then [a] -> Get [a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> Get [a]) -> [a] -> Get [a]
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
forall a. [a] -> [a]
reverse [a]
xs
            else [a] -> Get [a]
go ([a] -> Get [a]) -> Get [a] -> Get [a]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs) (a -> [a]) -> Get a -> Get [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get a
forall t. Binary t => Get t
get

getSectionHeader :: Word16 -> Get (Int, Word16)
getSectionHeader :: Word16 -> Get (Int, Word16)
getSectionHeader Word16
sectionMagic = do
    Word32
len   <- Get Word32
Get.getWord32le
    Word16
ty    <- Get Word16
Get.getWord16le
    Word16
magic <- Get Word16
Get.getWord16le
    Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word16
magic Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word16
sectionMagic) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$
        String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ()) -> String -> Get ()
forall a b. (a -> b) -> a -> b
$ String
"wrong magic number for section: "
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word16 -> String
forall a. Show a => a -> String
show Word16
magic String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" != " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word16 -> String
forall a. Show a => a -> String
show Word16
sectionMagic

    (Int, Word16) -> Get (Int, Word16)
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
len, Word16
ty)

putSectionHeader :: Word16 -> Word32 -> Word16 -> Put
putSectionHeader :: Word16 -> Word32 -> Word16 -> Put
putSectionHeader Word16
sectionMagic Word32
len Word16
ty = do
    Word32 -> Put
Put.putWord32le Word32
len
    Word16 -> Put
Put.putWord16le Word16
ty
    Word16 -> Put
Put.putWord16le Word16
sectionMagic