module Rattletrap.Decode.Content
  ( decodeContent
  )
where

import Rattletrap.Decode.Cache
import Rattletrap.Decode.ClassMapping
import Rattletrap.Decode.Common
import Rattletrap.Decode.Frame
import Rattletrap.Decode.KeyFrame
import Rattletrap.Decode.List
import Rattletrap.Decode.Mark
import Rattletrap.Decode.Message
import Rattletrap.Decode.Str
import Rattletrap.Decode.Word32le
import Rattletrap.Type.ClassAttributeMap
import Rattletrap.Type.Content
import Rattletrap.Type.Word32le
import Rattletrap.Utility.Bytes

import qualified Control.Monad.Trans.State as State
import qualified Data.Binary.Get as Binary
import qualified Data.ByteString.Lazy as LazyBytes

decodeContent
  :: (Int, Int, Int)
  -- ^ Version numbers, usually from 'Rattletrap.Header.getVersion'.
  -> Int
  -- ^ The number of frames in the stream, usually from
  -- 'Rattletrap.Header.getNumFrames'.
  -> Word
  -- ^ The maximum number of channels in the stream, usually from
  -- 'Rattletrap.Header.getMaxChannels'.
  -> Decode Content
decodeContent :: (Int, Int, Int) -> Int -> Word -> Decode Content
decodeContent (Int, Int, Int)
version Int
numFrames Word
maxChannels = do
  (List Str
levels, List KeyFrame
keyFrames, Word32le
streamSize) <-
    (,,)
    (List Str
 -> List KeyFrame
 -> Word32le
 -> (List Str, List KeyFrame, Word32le))
-> Get (List Str)
-> Get
     (List KeyFrame -> Word32le -> (List Str, List KeyFrame, Word32le))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decode Str -> Get (List Str)
forall a. Decode a -> Decode (List a)
decodeList Decode Str
decodeStr
    Get
  (List KeyFrame -> Word32le -> (List Str, List KeyFrame, Word32le))
-> Get (List KeyFrame)
-> Get (Word32le -> (List Str, List KeyFrame, Word32le))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decode KeyFrame -> Get (List KeyFrame)
forall a. Decode a -> Decode (List a)
decodeList Decode KeyFrame
decodeKeyFrame
    Get (Word32le -> (List Str, List KeyFrame, Word32le))
-> Get Word32le -> Get (List Str, List KeyFrame, Word32le)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word32le
decodeWord32le
  (ByteString
stream, List Message
messages, List Mark
marks, List Str
packages, List Str
objects, List Str
names, List ClassMapping
classMappings, List Cache
caches) <-
    (,,,,,,,)
    (ByteString
 -> List Message
 -> List Mark
 -> List Str
 -> List Str
 -> List Str
 -> List ClassMapping
 -> List Cache
 -> (ByteString, List Message, List Mark, List Str, List Str,
     List Str, List ClassMapping, List Cache))
-> Get ByteString
-> Get
     (List Message
      -> List Mark
      -> List Str
      -> List Str
      -> List Str
      -> List ClassMapping
      -> List Cache
      -> (ByteString, List Message, List Mark, List Str, List Str,
          List Str, List ClassMapping, List Cache))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32le -> Word32
word32leValue Word32le
streamSize))
    Get
  (List Message
   -> List Mark
   -> List Str
   -> List Str
   -> List Str
   -> List ClassMapping
   -> List Cache
   -> (ByteString, List Message, List Mark, List Str, List Str,
       List Str, List ClassMapping, List Cache))
-> Get (List Message)
-> Get
     (List Mark
      -> List Str
      -> List Str
      -> List Str
      -> List ClassMapping
      -> List Cache
      -> (ByteString, List Message, List Mark, List Str, List Str,
          List Str, List ClassMapping, List Cache))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decode Message -> Get (List Message)
forall a. Decode a -> Decode (List a)
decodeList Decode Message
decodeMessage
    Get
  (List Mark
   -> List Str
   -> List Str
   -> List Str
   -> List ClassMapping
   -> List Cache
   -> (ByteString, List Message, List Mark, List Str, List Str,
       List Str, List ClassMapping, List Cache))
-> Get (List Mark)
-> Get
     (List Str
      -> List Str
      -> List Str
      -> List ClassMapping
      -> List Cache
      -> (ByteString, List Message, List Mark, List Str, List Str,
          List Str, List ClassMapping, List Cache))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decode Mark -> Get (List Mark)
forall a. Decode a -> Decode (List a)
decodeList Decode Mark
decodeMark
    Get
  (List Str
   -> List Str
   -> List Str
   -> List ClassMapping
   -> List Cache
   -> (ByteString, List Message, List Mark, List Str, List Str,
       List Str, List ClassMapping, List Cache))
-> Get (List Str)
-> Get
     (List Str
      -> List Str
      -> List ClassMapping
      -> List Cache
      -> (ByteString, List Message, List Mark, List Str, List Str,
          List Str, List ClassMapping, List Cache))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decode Str -> Get (List Str)
forall a. Decode a -> Decode (List a)
decodeList Decode Str
decodeStr
    Get
  (List Str
   -> List Str
   -> List ClassMapping
   -> List Cache
   -> (ByteString, List Message, List Mark, List Str, List Str,
       List Str, List ClassMapping, List Cache))
-> Get (List Str)
-> Get
     (List Str
      -> List ClassMapping
      -> List Cache
      -> (ByteString, List Message, List Mark, List Str, List Str,
          List Str, List ClassMapping, List Cache))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decode Str -> Get (List Str)
forall a. Decode a -> Decode (List a)
decodeList Decode Str
decodeStr
    Get
  (List Str
   -> List ClassMapping
   -> List Cache
   -> (ByteString, List Message, List Mark, List Str, List Str,
       List Str, List ClassMapping, List Cache))
-> Get (List Str)
-> Get
     (List ClassMapping
      -> List Cache
      -> (ByteString, List Message, List Mark, List Str, List Str,
          List Str, List ClassMapping, List Cache))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decode Str -> Get (List Str)
forall a. Decode a -> Decode (List a)
decodeList Decode Str
decodeStr
    Get
  (List ClassMapping
   -> List Cache
   -> (ByteString, List Message, List Mark, List Str, List Str,
       List Str, List ClassMapping, List Cache))
-> Get (List ClassMapping)
-> Get
     (List Cache
      -> (ByteString, List Message, List Mark, List Str, List Str,
          List Str, List ClassMapping, List Cache))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decode ClassMapping -> Get (List ClassMapping)
forall a. Decode a -> Decode (List a)
decodeList Decode ClassMapping
decodeClassMapping
    Get
  (List Cache
   -> (ByteString, List Message, List Mark, List Str, List Str,
       List Str, List ClassMapping, List Cache))
-> Get (List Cache)
-> Get
     (ByteString, List Message, List Mark, List Str, List Str, List Str,
      List ClassMapping, List Cache)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decode Cache -> Get (List Cache)
forall a. Decode a -> Decode (List a)
decodeList Decode Cache
decodeCache
  let
    classAttributeMap :: ClassAttributeMap
classAttributeMap =
      List Str
-> List ClassMapping -> List Cache -> List Str -> ClassAttributeMap
makeClassAttributeMap List Str
objects List ClassMapping
classMappings List Cache
caches List Str
names
    bitGet :: DecodeBits [Frame]
bitGet = StateT (Map CompressedWord Word32le) DecodeBits [Frame]
-> Map CompressedWord Word32le -> DecodeBits [Frame]
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
State.evalStateT
      ((Int, Int, Int)
-> Int
-> Word
-> ClassAttributeMap
-> StateT (Map CompressedWord Word32le) DecodeBits [Frame]
decodeFramesBits (Int, Int, Int)
version Int
numFrames Word
maxChannels ClassAttributeMap
classAttributeMap)
      Map CompressedWord Word32le
forall a. Monoid a => a
mempty
  [Frame]
frames <- (String -> Get [Frame])
-> ([Frame] -> Get [Frame]) -> Either String [Frame] -> Get [Frame]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Get [Frame]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail [Frame] -> Get [Frame]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DecodeBits [Frame] -> ByteString -> Either String [Frame]
forall a. DecodeBits a -> ByteString -> Either String a
runDecodeBits DecodeBits [Frame]
bitGet (ByteString -> ByteString
reverseBytes ByteString
stream))
  List Str
-> List KeyFrame
-> Word32le
-> [Frame]
-> List Message
-> List Mark
-> List Str
-> List Str
-> List Str
-> List ClassMapping
-> List Cache
-> [Word8]
-> Content
Content
      List Str
levels
      List KeyFrame
keyFrames
      Word32le
streamSize
      [Frame]
frames
      List Message
messages
      List Mark
marks
      List Str
packages
      List Str
objects
      List Str
names
      List ClassMapping
classMappings
      List Cache
caches
    ([Word8] -> Content)
-> (ByteString -> [Word8]) -> ByteString -> Content
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
LazyBytes.unpack
    (ByteString -> Content) -> Get ByteString -> Decode Content
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
Binary.getRemainingLazyByteString