{-# LANGUAGE DeriveGeneric #-}

module Octane.Parser (parseFrames) where

import Data.Function ((&))

import qualified Control.Newtype as Newtype
import qualified Data.Binary.Bits.Get as Bits
import qualified Data.Binary.IEEE754 as IEEE754
import qualified Data.Binary.Get as Binary
import qualified Data.Bits as Bits
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import qualified Data.IntMap as IntMap
import qualified Data.List as List
import qualified Data.Map as Map
import qualified Data.Maybe as Maybe
import qualified Data.Set as Set
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Encoding
import qualified Data.Word as Word
import qualified GHC.Generics as Generics
import qualified Octane.Type as Type
import qualified Text.Regex as Regex

parseFrames :: Type.Replay -> [Frame]
parseFrames replay = let
    get = replay & extractContext & getFrames & Bits.runBitGet
    stream = replay & Type.replayStream & Newtype.unpack & BSL.fromStrict
    (_context, frames) = Binary.runGet get stream
    in frames

getFrames :: Context -> Bits.BitGet (Context, [Frame])
getFrames context = do
    maybeFrame <- getMaybeFrame context
    case maybeFrame of
        Nothing -> return (context, [])
        Just (newContext, frame) -> do
            (newerContext, frames) <- getFrames newContext
            return (newerContext, (frame : frames))

getMaybeFrame :: Context -> Bits.BitGet (Maybe (Context, Frame))
getMaybeFrame context = do
    time <- getFloat32
    delta <- getFloat32
    if time == 0 && delta == 0
        then return Nothing
        else do
            (newContext, frame) <- getFrame context time delta
            return (Just (newContext, frame))

getFrame :: Context -> Time -> Delta -> Bits.BitGet (Context, Frame)
getFrame context time delta = do
    (newContext, replications) <- getReplications context
    let frame =
            Frame
            { frameTime = time
            , frameDelta = delta
            , frameReplications = replications
            }
    return (newContext, frame)

getReplications :: Context -> Bits.BitGet (Context, [Replication])
getReplications context = do
    maybeReplication <- getMaybeReplication context
    case maybeReplication of
        Nothing -> return (context, [])
        Just (newContext, replication) -> do
            (newerContext, replications) <- getReplications newContext
            return (newerContext, replication : replications)

getMaybeReplication :: Context -> Bits.BitGet (Maybe (Context, Replication))
getMaybeReplication context = do
    hasReplication <- Bits.getBool
    if not hasReplication
        then return Nothing
        else do
            (newContext,replication) <- getReplication context
            return (Just (newContext, replication))

getReplication :: Context -> Bits.BitGet (Context, Replication)
getReplication context = do
    actorId <- getInt maxChannels
    isOpen <- Bits.getBool
    let go =
            if isOpen
                then getOpenReplication
                else getClosedReplication
    go context actorId

getOpenReplication :: Context
                   -> ActorId
                   -> Bits.BitGet (Context, Replication)
getOpenReplication context actorId = do
    isNew <- Bits.getBool
    let go =
            if isNew
                then getNewReplication
                else getExistingReplication
    go context actorId

getNewReplication :: Context
                  -> ActorId
                  -> Bits.BitGet (Context, Replication)
getNewReplication context actorId = do
    unknownFlag <- Bits.getBool
    objectId <- getInt32
    let objectName = case context & contextObjectMap & IntMap.lookup objectId of
            Nothing -> error ("could not find object name for id " ++ show objectId)
            Just x -> x
    let (classId,className) = case getClass context objectId of
            Nothing -> error ("could not find class for object id " ++ show objectId)
            Just x -> x
    classInit <- getClassInit className
    let thing = Thing
            { thingFlag = unknownFlag
            , thingObjectId = objectId
            , thingObjectName = objectName
            , thingClassId = classId
            , thingClassName = className
            , thingClassInit = classInit
            }
    let things = contextThings context
    let newThings = IntMap.insert actorId thing things
    let newContext = context { contextThings = newThings }
    return
        ( newContext
        , Replication
          { replicationActorId = actorId
          , replicationIsOpen = True
          , replicationIsNew = Just True
          , replicationProps = []
          })

getExistingReplication :: Context
                       -> ActorId
                       -> Bits.BitGet (Context, Replication)
getExistingReplication context actorId = do
    let thing = case context & contextThings & IntMap.lookup actorId of
            Nothing -> error ("could not find thing for actor id " ++ show actorId)
            Just x -> x
    props <- getProps context thing
    return (context, Replication
        { replicationActorId = actorId
        , replicationIsOpen = True
        , replicationIsNew = Just False
        , replicationProps = props
        })

getClosedReplication :: Context
                     -> ActorId
                     -> Bits.BitGet (Context, Replication)
getClosedReplication context actorId = do
    let newThings = context & contextThings & IntMap.delete actorId
    let newContext = context { contextThings = newThings }
    return
        ( newContext
        , Replication
          { replicationActorId = actorId
          , replicationIsOpen = False
          , replicationIsNew = Nothing
          , replicationProps = []
          })

getProps :: Context -> Thing -> Bits.BitGet [Prop]
getProps context thing = do
    maybeProp <- getMaybeProp context thing
    case maybeProp of
        Nothing -> return []
        Just prop -> do
            props <- getProps context thing
            return (prop : props)

getMaybeProp :: Context -> Thing -> Bits.BitGet (Maybe Prop)
getMaybeProp context thing = do
    hasProp <- Bits.getBool
    if hasProp
    then do
        prop <- getProp context thing
        return (Just prop)
    else return Nothing

getProp :: Context -> Thing -> Bits.BitGet Prop
getProp context thing = do
    let classId = thing & thingClassId
    let props = case context & contextClassPropertyMap & IntMap.lookup classId of
            Nothing -> error ("could not find property map for class id " ++ show classId)
            Just x -> x
    let maxId = props & IntMap.keys & maximum
    pid <- getInt maxId
    let propName = case props & IntMap.lookup pid of
            Nothing -> error ("could not find property name for property id " ++ show pid)
            Just x -> x
    value <- getPropValue propName
    return (Prop { propId = pid, propValue = value })

getPropValue :: Text.Text -> Bits.BitGet PropValue
getPropValue name = case Text.unpack name of
    _ | Set.member name propsWithRigidBodyState -> do
        flag <- Bits.getBool
        position <- getVector
        rotation <- getFloatVector
        x <- if flag then return Nothing else fmap Just getVector
        y <- if flag then return Nothing else fmap Just getVector
        return (PRigidBodyState flag position rotation x y)
    _ | Set.member name propsWithFlaggedInt -> do
        flag <- Bits.getBool
        int <- getInt32
        return (PFlaggedInt flag (fromIntegral int))
    _ | Set.member name propsWithString -> do
        string <- getString
        return (PString string)
    _ | Set.member name propsWithBoolean -> do
        bool <- Bits.getBool
        return (PBoolean bool)
    _ | Set.member name propsWithQWord -> do
        x <- getInt32
        y <- getInt32
        return (PQWord x y)
    _ | Set.member name propsWithInt -> do
        int <- getInt32
        return (PInt int)
    _ | Set.member name propsWithByte -> do
        int <- getInt8
        return (PByte int)
    _ | Set.member name propsWithUniqueId -> do
        (systemId, remoteId, localId) <- getUniqueId
        return (PUniqueId systemId remoteId localId)
    _ | Set.member name propsWithCamSettings -> do
        fov <- getFloat32
        height <- getFloat32
        pitch <- getFloat32
        dist <- getFloat32
        stiff <- getFloat32
        swiv <- getFloat32
        return (PCamSettings fov height pitch dist stiff swiv)
    _ | Set.member name propsWithLocation -> do
        vector <- getVector
        return (PLocation vector)
    "ProjectX.GRI_X:Reservations" -> do
        -- I think this is the connection order. The first player to connect
        -- gets number 0, and it goes up from there. The maximum is 8, which
        -- would be a full 4x4 game.
        number <- getInt 8
        (systemId, remoteId, localId) <- getUniqueId
        playerName <- if systemId == 0 then return Nothing else do
            string <- getString
            return (Just string)
        -- No idea what these two flags are. Might be for bots?
        a <- Bits.getBool
        b <- Bits.getBool
        return (PReservation number systemId remoteId localId playerName a b)
    "TAGame.PRI_TA:ClientLoadoutOnline" -> do
        version <- getInt32
        x <- getInt32
        y <- getInt32
        z <- if version >= 12
            then do
                value <- getInt8
                return (Just value)
            else return Nothing
        return (PLoadoutOnline version x y z)
    "TAGame.PRI_TA:ClientLoadout" -> do
        version <- getInt8
        a <- getInt32
        b <- getInt32
        c <- getInt32
        d <- getInt32
        e <- getInt32
        f <- getInt32
        g <- getInt32
        h <- if version > 10
            then do
                value <- getInt32
                return (Just value)
            else return Nothing
        return (PLoadout version a b c d e f g h)
    "TAGame.Car_TA:TeamPaint" -> do
        team <- getInt8
        teamColor <- getInt8
        customColor <- getInt8
        teamFinish <- getInt32
        customFinish <- getInt32
        return (PTeamPaint team teamColor customColor teamFinish customFinish)
    "TAGame.VehiclePickup_TA:ReplicatedPickupData" -> do
        instigator <- Bits.getBool
        instigatorId <- if instigator then fmap Just getInt32 else return Nothing
        pickedUp <- Bits.getBool
        return (PPickup instigator instigatorId pickedUp)
    "Engine.Actor:Role" -> do
        x <- Bits.getWord16be 11
        return (PEnum x)
    "TAGame.Ball_TA:ReplicatedExplosionData" -> do
        noGoal <- Bits.getBool
        a <- if noGoal then return Nothing else fmap Just getInt32
        b <- getVector
        return (PExplosion noGoal a b)
    "TAGame.GameEvent_Soccar_TA:ReplicatedMusicStinger" -> do
        flag <- Bits.getBool
        cue <- getInt32
        trigger <- getInt8
        return (PMusicStinger flag cue trigger)
    -- TODO: Parse other prop types.
    _ -> fail ("don't know how to read property " ++ show name)

getFloat32 :: Bits.BitGet Float
getFloat32 = do
    bytes <- Bits.getByteString 4
    bytes & byteStringToFloat & return

-- TODO: This has a lot of overlap with PCString.
getString :: Bits.BitGet Text.Text
getString = do
    rawSize <- getInt32
    rawText <- if rawSize < 0
        then do
            let size = -2 * rawSize
            bytes <- Bits.getByteString size
            bytes & BS.map Type.reverseBits & Encoding.decodeUtf16LE & return
        else do
            bytes <- Bits.getByteString rawSize
            bytes & BS.map Type.reverseBits & Encoding.decodeLatin1 & return
    rawText & Text.dropEnd 1 & return

getUniqueId :: Bits.BitGet (SystemId, RemoteId, LocalId)
getUniqueId = do
    byte <- Bits.getWord8 8
    let systemId = Type.reverseBits byte
    case systemId of
        0 -> error "don't know how to parse splitscreen ids"
        1 -> do
            remoteId <- Bits.getByteString 8
            localId <- Bits.getWord8 8
            return (systemId, SteamId remoteId, localId)
        2 -> do
            remoteId <- Bits.getByteString 32
            localId <- Bits.getWord8 8
            return (systemId, PlayStationId remoteId, localId)
        _ -> error ("unknown system id " ++ show systemId)

propsWithRigidBodyState :: Set.Set Text.Text
propsWithRigidBodyState =
    [ "TAGame.RBActor_TA:ReplicatedRBState"
    ] & map Text.pack & Set.fromList

propsWithFlaggedInt :: Set.Set Text.Text
propsWithFlaggedInt =
    [ "Engine.GameReplicationInfo:GameClass"
    , "Engine.Pawn:PlayerReplicationInfo"
    , "Engine.PlayerReplicationInfo:Team"
    , "TAGame.Ball_TA:GameEvent"
    , "TAGame.CameraSettingsActor_TA:PRI"
    , "TAGame.CarComponent_TA:Vehicle"
    , "TAGame.PRI_TA:PersistentCamera"
    , "TAGame.PRI_TA:ReplicatedGameEvent"
    , "TAGame.Team_TA:GameEvent"
    ] & map Text.pack & Set.fromList

propsWithString :: Set.Set Text.Text
propsWithString =
    [ "Engine.GameReplicationInfo:ServerName"
    , "Engine.PlayerReplicationInfo:PlayerName"
    ] & map Text.pack & Set.fromList

propsWithBoolean :: Set.Set Text.Text
propsWithBoolean =
    [ "Engine.PlayerReplicationInfo:bReadyToPlay"
    , "ProjectX.GRI_X:bGameStarted"
    , "TAGame.CameraSettingsActor_TA:bUsingSecondaryCamera"
    , "TAGame.GameEvent_TA:bHasLeaveMatchPenalty"
    , "TAGame.GameEvent_Team_TA:bDisableMutingOtherTeam"
    , "TAGame.PRI_TA:bOnlineLoadoutSet"
    , "TAGame.Vehicle_TA:bDriving"
    , "TAGame.GameEvent_Soccar_TA:bBallHasBeenHit"
    , "TAGame.Vehicle_TA:bReplicatedHandbrake"
    , "Engine.Actor:bCollideActors"
    , "Engine.Actor:bBlockActors"
    , "TAGame.CameraSettingsActor_TA:bUsingBehindView"
    ] & map Text.pack & Set.fromList

propsWithQWord :: Set.Set Text.Text
propsWithQWord =
    [ "ProjectX.GRI_X:GameServerID"
    ] & map Text.pack & Set.fromList

propsWithInt :: Set.Set Text.Text
propsWithInt =
    [ "Engine.PlayerReplicationInfo:PlayerID"
    , "ProjectX.GRI_X:ReplicatedGamePlaylist"
    , "TAGame.GameEvent_Soccar_TA:SecondsRemaining"
    , "TAGame.GameEvent_TA:BotSkill"
    , "TAGame.GameEvent_TA:ReplicatedGameStateTimeRemaining"
    , "TAGame.GameEvent_Soccar_TA:RoundNum"
    , "TAGame.GameEvent_TA:ReplicatedStateName"
    , "TAGame.GameEvent_Team_TA:MaxTeamSize"
    , "TAGame.PRI_TA:Title"
    , "TAGame.PRI_TA:TotalXP"
    , "TAGame.PRI_TA:MatchScore"
    , "TAGame.PRI_TA:MatchShots"
    , "TAGame.PRI_TA:MatchSaves"
    , "Engine.TeamInfo:Score"
    , "Engine.PlayerReplicationInfo:Score"
    , "TAGame.PRI_TA:MatchGoals"
    , "TAGame.PRI_TA:MatchAssists"
    ] & map Text.pack & Set.fromList

propsWithByte :: Set.Set Text.Text
propsWithByte =
    [ "Engine.PlayerReplicationInfo:Ping"
    , "TAGame.CarComponent_Boost_TA:ReplicatedBoostAmount"
    , "TAGame.Vehicle_TA:ReplicatedThrottle"
    , "TAGame.CarComponent_TA:ReplicatedActive"
    , "TAGame.Vehicle_TA:ReplicatedSteer"
    , "TAGame.Ball_TA:HitTeamNum"
    , "TAGame.GameEvent_Soccar_TA:ReplicatedScoredOnTeam"
    , "TAGame.CameraSettingsActor_TA:CameraYaw"
    , "TAGame.CameraSettingsActor_TA:CameraPitch"
    ] & map Text.pack & Set.fromList

propsWithUniqueId :: Set.Set Text.Text
propsWithUniqueId =
    [ "Engine.PlayerReplicationInfo:UniqueId"
    , "TAGame.PRI_TA:PartyLeader"
    ] & map Text.pack & Set.fromList

propsWithCamSettings :: Set.Set Text.Text
propsWithCamSettings =
    [ "TAGame.CameraSettingsActor_TA:ProfileSettings"
    ] & map Text.pack & Set.fromList

propsWithLocation :: Set.Set Text.Text
propsWithLocation =
    [ "TAGame.CarComponent_Dodge_TA:DodgeTorque"
    ] & map Text.pack & Set.fromList

type SystemId = Word.Word8

-- This is the number associated with a splitscreen player. So the first player
-- is 0, the second is 1, and so on.
-- - 0 "Someone"
-- - 1 "Someone (1)"
type LocalId = Word.Word8

data RemoteId
    = SteamId BS.ByteString -- TODO: This is an integer.
    | PlayStationId BS.ByteString -- TODO: I think this is a string?
    deriving (Eq, Show)

data Prop = Prop
    { propId :: Int
    , propValue :: PropValue
    } deriving (Eq, Show)

data PropValue
    = PRigidBodyState Bool (Vector Int) (Vector Float) (Maybe (Vector Int)) (Maybe (Vector Int))
    | PFlaggedInt Bool Int
    | PString Text.Text
    | PBoolean Bool
    | PQWord Int Int
    | PReservation Int SystemId RemoteId LocalId (Maybe Text.Text) Bool Bool
    | PInt Int
    | PByte Int
    | PUniqueId SystemId RemoteId LocalId
    | PLoadoutOnline Int Int Int (Maybe Int)
    | PLoadout Int Int Int Int Int Int Int Int (Maybe Int)
    | PCamSettings Float Float Float Float Float Float
    | PTeamPaint Int Int Int Int Int
    | PLocation (Vector Int)
    | PPickup Bool (Maybe Int) Bool
    | PEnum Word.Word16 -- TODO: This isn't the right data type.
    | PExplosion Bool (Maybe Int) (Vector Int)
    | PMusicStinger Bool Int Int
    deriving (Eq, Show)

-- | A frame in the net stream. Each frame has the time since the beginning of
-- | the match, the time since the last frame, and a list of replications.
data Frame = Frame
    { frameTime :: Float
    , frameDelta :: Float
    , frameReplications :: [Replication]
    } deriving (Eq,Generics.Generic,Show)

-- | Replication information about an actor in the net stream.
data Replication = Replication
    { replicationActorId :: Int
    , replicationIsOpen :: Bool
    , replicationIsNew :: Maybe Bool
    , replicationProps :: [Prop]
    } deriving (Eq,Generics.Generic,Show)

data Thing = Thing
    { thingFlag :: Bool
    , thingObjectId :: Int
    , thingObjectName :: Text.Text
    , thingClassId :: Int
    , thingClassName :: Text.Text
    , thingClassInit :: ClassInit
    } deriving (Show)

type Time = Float

type Delta = Float

type ActorId = Int

data Vector a = Vector
    { vectorX :: a
    , vectorY :: a
    , vectorZ :: a
    } deriving (Eq, Show)

data ClassInit = ClassInit
    { classInitLocation :: Maybe (Vector Int)
    , classInitRotation :: Maybe (Vector Int)
    } deriving (Show)

-- { class stream id => { property stream id => name } }
type ClassPropertyMap = IntMap.IntMap (IntMap.IntMap Text.Text)

-- { stream id => object name }
type ObjectMap = IntMap.IntMap Text.Text

-- { archetype (object) name => class name }
type ArchetypeMap = Map.Map Text.Text Text.Text

-- { class name => class id }
type ClassMap = Map.Map Text.Text Int

data Context = Context
    { contextObjectMap :: ObjectMap
    , contextClassPropertyMap :: ClassPropertyMap
    , contextThings :: IntMap.IntMap Thing
    , contextArchetypeMap :: ArchetypeMap
    , contextClassMap :: ClassMap
    } deriving (Show)

buildObjectMap :: Type.Replay -> ObjectMap
buildObjectMap replay =
    replay & Type.replayObjects & Newtype.unpack & map Newtype.unpack &
    zip [0 ..] &
    IntMap.fromAscList

buildArchetypeMap :: Type.Replay -> ArchetypeMap
buildArchetypeMap replay
    = replay
    & Type.replayObjects
    & Newtype.unpack
    & map Newtype.unpack
    & map (\ archetype -> let
        k = archetype
        v = archetypeToClass archetype
        in (k, v))
    & Map.fromList
    & Map.union specialArchetypes

specialArchetypes :: ArchetypeMap
specialArchetypes =
    [ ("GameInfo_Soccar.GameInfo.GameInfo_Soccar:GameReplicationInfoArchetype", "GRI")
    ] & map (\ (k, v) -> (Text.pack k, Text.pack v)) & Map.fromList

buildClassMap :: Type.Replay -> ClassMap
buildClassMap replay
    = replay
    & Type.replayObjects
    & Newtype.unpack
    & map Newtype.unpack
    & zip [0 ..]
    & map (\ (objectId, objectName) -> let
        k = archetypeToClass objectName
        v = objectId
        in (k, v))
    & reverse
    & Map.fromList

getClass :: Context -> Int -> Maybe (Int, Text.Text)
getClass context objectId = let
    objectMap = contextObjectMap context
    archetypeMap = contextArchetypeMap context
    classMap = contextClassMap context
    in case IntMap.lookup objectId objectMap of
        Nothing -> Nothing
        Just archetypeName -> case Map.lookup archetypeName archetypeMap of
            Nothing -> Nothing
            Just className -> case Map.lookup className classMap of
                Nothing -> Nothing
                Just classId -> Just (classId, className)

archetypeToClass :: Text.Text -> Text.Text
archetypeToClass text
    = text
    & Text.splitOn (Text.pack ".")
    & last
    & Text.splitOn (Text.pack ":")
    & last
    & Text.unpack
    & substitute "_?[0-9]+$" ""
    & substitute "^Default__" ""
    & substitute "_TA$" ""
    & substitute "_Default$" ""
    & substitute "Archetype$" ""
    & Text.pack

substitute :: String -> String -> String -> String
substitute pattern replacement input =
    Regex.subRegex (Regex.mkRegex pattern) input replacement

extractContext :: Type.Replay -> Context
extractContext replay =
    Context
    { contextObjectMap = buildObjectMap replay
    , contextClassPropertyMap = buildClassPropertyMap replay
    , contextThings = IntMap.empty
    , contextArchetypeMap = buildArchetypeMap replay
    , contextClassMap = buildClassMap replay
    }

classesWithLocation :: Set.Set Text.Text
classesWithLocation =
    [ "Ball"
    , "CameraSettingsActor"
    , "Car"
    , "CarComponent_Boost"
    , "CarComponent_Dodge"
    , "CarComponent_DoubleJump"
    , "CarComponent_FlipCar"
    , "CarComponent_Jump"
    , "GRI"
    , "GameEvent_Season"
    , "GameEvent_Soccar"
    , "GameEvent_SoccarPrivate"
    , "GameEvent_SoccarSplitscreen"
    , "GameReplicationInfo"
    , "PRI"
    , "Team"
    , "Team_Soccar"
    ] & map Text.pack & Set.fromList

classesWithRotation :: Set.Set Text.Text
classesWithRotation =
    [ "Ball"
    , "Car_Season"
    , "Car"
    ] & map Text.pack & Set.fromList

maxVectorValue :: Int
maxVectorValue = 19

byteStringToFloat :: BS.ByteString -> Float
byteStringToFloat bytes = Binary.runGet
    IEEE754.getFloat32le
    (bytes & BSL.fromStrict & BSL.map Type.reverseBits)

getVector :: Bits.BitGet (Vector Int)
getVector = do
    numBits <- getInt maxVectorValue
    let bias = Bits.shiftL 1 (numBits + 1)
    let maxBits = numBits + 2
    let maxValue = 2 ^ maxBits
    dx <- getInt maxValue
    dy <- getInt maxValue
    dz <- getInt maxValue
    return
        Vector
        { vectorX = dx - bias
        , vectorY = dy - bias
        , vectorZ = dz - bias
        }

getVectorBytewise
    :: Bits.BitGet (Vector Int)
getVectorBytewise = do
    hasX <- Bits.getBool
    x <-
        if hasX
            then do
                word <- Bits.getWord8 8
                word & Type.reverseBits & fromIntegral & return
            else return 0
    hasY <- Bits.getBool
    y <-
        if hasY
            then do
                word <- Bits.getWord8 8
                word & Type.reverseBits & fromIntegral & return
            else return 0
    hasZ <- Bits.getBool
    z <-
        if hasZ
            then do
                word <- Bits.getWord8 8
                word & Type.reverseBits & fromIntegral & return
            else return 0
    return
        Vector
        { vectorX = x
        , vectorY = y
        , vectorZ = z
        }

getFloatVector :: Bits.BitGet (Vector Float)
getFloatVector = do
    let maxValue = 1
    let numBits = 16
    x <- getFloat maxValue numBits
    y <- getFloat maxValue numBits
    z <- getFloat maxValue numBits
    return Vector { vectorX = x, vectorY = y, vectorZ = z }

getFloat :: Int -> Int -> Bits.BitGet Float
getFloat maxValue numBits = do
    let maxBitValue = (Bits.shiftL 1 (numBits - 1)) - 1
    let bias = Bits.shiftL 1 (numBits - 1)
    let serIntMax = Bits.shiftL 1 numBits
    delta <- getInt serIntMax
    let unscaledValue = delta - bias
    if maxValue > maxBitValue
    then do
        let invScale = fromIntegral maxValue / fromIntegral maxBitValue
        return (fromIntegral unscaledValue * invScale)
    else do
        let scale = fromIntegral maxBitValue / fromIntegral maxValue
        let invScale = 1.0 / scale
        return (fromIntegral unscaledValue * invScale)

getClassInit :: Text.Text -> Bits.BitGet ClassInit
getClassInit className = do
    location <-
        if Set.member className classesWithLocation
            then do
                vector <- getVector
                return (Just vector)
            else return Nothing
    rotation <-
        if Set.member className classesWithRotation
            then do
                vector <- getVectorBytewise
                return (Just vector)
            else return Nothing
    return
        ClassInit
        { classInitLocation = location
        , classInitRotation = rotation
        }

maxChannels
    :: (Integral a)
    => a
maxChannels = 1024

bitSize
    :: (Integral a)
    => a -> a
bitSize x = x & fromIntegral & logBase (2 :: Double) & ceiling

-- Reads an integer bitwise. The bits of the integer are backwards, so the
-- least significant bit is first. The argument is the maximum value this
-- integer can have. Bits will be read until the next bit would be greater than
-- the maximum value, or the number of bits necessary to reach the maximum
-- value has been reached, whichever comes first.
--
-- For example, if the maximum value is 4 and "11" has been read already,
-- nothing more will be read because another "1" would put the value over the
-- maximum.
getInt
    :: Int -> Bits.BitGet Int
getInt maxValue = do
    let maxBits = bitSize maxValue
        go i value = do
            let x = Bits.shiftL 1 i
            if i < maxBits && value + x <= maxValue
                then do
                    bit <- Bits.getBool
                    let newValue =
                            if bit
                                then value + x
                                else value
                    go (i + 1) newValue
                else return value
    go 0 0

getInt32 :: Bits.BitGet Int
getInt32 = getInt (2 ^ (32 :: Int))

getInt8 :: Bits.BitGet Int
getInt8 = getInt (2 ^ (8 :: Int))

-- builds a map from property ids in the stream to property names
buildPropertyMap :: Type.Replay -> IntMap.IntMap Text.Text
buildPropertyMap replay
    = replay
    & Type.replayObjects
    & Newtype.unpack
    & map Newtype.unpack
    & zip [0 ..]
    & IntMap.fromDistinctAscList

buildClassPropertyMap :: Type.Replay -> IntMap.IntMap (IntMap.IntMap Text.Text)
buildClassPropertyMap replay = let
    propertyMap = buildPropertyMap replay
    g x items = case items of
        [] -> IntMap.empty
        _ -> case dropWhile (\ (_, cacheId, _, _) -> cacheId /= x) items of
            [] -> g (x - 1) items
            (_, _, parentCacheId, properties) : others -> IntMap.union
                properties
                (g parentCacheId others)
    f x items = case items of
        (classId, _cacheId, parentCacheId, properties) : others -> IntMap.insert
            classId
            (IntMap.union
                properties
                (g parentCacheId others))
            x
        [] -> x
    in replay
        & Type.replayCacheItems
        & Newtype.unpack
        & map (\ item ->
            ( item & Type.cacheItemClassId & Newtype.unpack & fromIntegral
            , item & Type.cacheItemCacheId & Newtype.unpack & fromIntegral & (\ x -> x :: Int)
            , item & Type.cacheItemParentCacheId & Newtype.unpack & fromIntegral
            , item & Type.cacheItemCacheProperties & Newtype.unpack & map (\ x ->
                ( x & Type.cachePropertyStreamId & Newtype.unpack & fromIntegral
                , x & Type.cachePropertyObjectId & Newtype.unpack & fromIntegral & flip IntMap.lookup propertyMap & Maybe.fromJust
                )) & IntMap.fromList
            ))
        & reverse
        & List.tails
        & foldl f IntMap.empty