Main.hs

module Octane.Main (main) where

import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import qualified Data.IntMap as IntMap
import qualified Data.Map as Map
import Octane.Core
import Octane.Type

main :: IO ()
main = do
    files <- getArgs
    contents <- mapM BS.readFile files
    results <- mapM decodeFileOrFail files
    mapM_ debug (zip3 files contents results)

debug :: (String, ByteString, Either (ByteOffset, String) Replay) -> IO ()
debug (file, contents, result) = case result of
    Left (offset, message) -> hPutStrLn stderr
        (file ++ " @ byte " ++ show offset ++ " - " ++ message)
    Right replay -> do
        putStrLn file

        let inputSize = contents & BS.length & fromIntegral
        let outputSize = replay & encode & BSL.length
        when (inputSize /= outputSize) $ do
            hPutStrLn stderr
                ( "input size ("
                ++ show inputSize
                ++ ") not equal to output size ("
                ++ show outputSize ++ ")!"
                )
        putStrLn ""

        putStrLn "# SIZE 1 #\n"
        print (getInt32LE (replaySize1 replay))
        putStrLn ""

        putStrLn "# CRC 1 #\n"
        print (getInt32LE (replayCRC1 replay))
        putStrLn ""

        putStrLn "# VERSION #\n"
        print (getInt32LE (replayVersion1 replay))
        print (getInt32LE (replayVersion2 replay))
        putStrLn ""

        putStrLn "# LABEL #\n"
        print (getPCString (replayLabel replay))
        putStrLn ""

        putStrLn "# PROPERTIES #\n"
        mapM_
            (\ (name, property) -> do
                putStr (show (getPCString name) ++ "\t=> ")
                debugProperty property)
            (Map.assocs (getDictionary (replayProperties replay)))
        putStrLn ""

        putStrLn "# SIZE 2 #\n"
        print (getInt32LE (replaySize2 replay))
        putStrLn ""

        putStrLn "# CRC 2 #\n"
        print (getInt32LE (replayCRC2 replay))
        putStrLn ""

        putStrLn "# EFFECTS #\n"
        mapM_
            (\ effect -> do
                print (getPCString effect))
            (getList (replayEffects replay))
        putStrLn ""

        putStrLn "# KEY FRAMES #\n"
        mapM_
            (\ keyFrame -> do
                putStrLn (show (getFloat32LE (keyFrameTime keyFrame)) ++ "s @ frame " ++ show (getInt32LE (keyFrameFrame keyFrame)) ++ " - bit " ++ show (getInt32LE (keyFramePosition keyFrame))))
            (getList (replayKeyFrames replay))
        putStrLn ""

        putStrLn "# FRAMES #\n"
        putStrLn (show (BS.length (replayFrames replay)) ++ " bytes")
        putStrLn ""

        putStrLn "# MESSAGES #\n"
        mapM_
            (\ message -> do
                putStrLn (show (getPCString (messageName message)) ++ " @ frame " ++ show (getInt32LE (messageFrame message)) ++ ": " ++ show (getPCString (messageContent message))))
            (getList (replayMessages replay))
        putStrLn ""

        putStrLn "# MARKS #\n"
        mapM_
            (\ goal -> do
                putStrLn (show (getPCString (markLabel goal)) ++ " @ frame " ++ show (getInt32LE (markFrame goal))))
            (getList (replayMarks replay))
        putStrLn ""

        putStrLn "# PACKAGES #\n"
        mapM_
            (\ package -> do
                print (getPCString package))
            (getList (replayPackages replay))
        putStrLn ""

        putStrLn "# OBJECTS #\n"
        mapM_
            (\ (index, object) -> do
                putStrLn (show index ++ "\t=> " ++ show (getPCString object)))
            (IntMap.assocs (getObjectMap (replayObjectMap replay)))
        putStrLn ""

        putStrLn "# NAMES #\n"
        mapM_
            (\ name -> do
                print (getPCString name))
            (getList (replayNames replay))
        putStrLn ""

        putStrLn "# ACTORS #\n"
        mapM_
            (\ (index, actor) -> do
                putStrLn (show index ++ "\t=> " ++ show (getPCString actor)))
            (IntMap.assocs (getActorMap (replayActorMap replay)))
        putStrLn ""

        putStrLn "# CACHE #\n"
        mapM_
            (\ cacheItem -> do
                let a = cacheItem & cacheItemTag & getInt32LE & fromIntegral
                let b = replay & replayObjectMap & getObjectMap & IntMap.lookup a & fmap getPCString
                putStrLn ("ID:\t" ++ show a ++ " (" ++ show b ++ ")")
                putStrLn ("Start:\t" ++ show (getInt32LE (cacheItemStart cacheItem)))
                putStrLn ("End:\t" ++ show (getInt32LE (cacheItemEnd cacheItem)))
                putStrLn "Properties:"
                mapM_
                    (\ cacheProperty -> do
                        let c = cacheProperty & cachePropertyIndex & getInt32LE & fromIntegral
                        let d = replay & replayObjectMap & getObjectMap & IntMap.lookup c & fmap getPCString
                        putStrLn ("- " ++ show (getInt32LE (cachePropertyTag cacheProperty)) ++ "\t=> " ++ show c ++ " (" ++ show d ++ ")"))
                    (getList (cacheItemCacheProperties cacheItem))
                putStrLn "")
            (getList (replayCacheItems replay))

debugProperty :: Property -> IO ()
debugProperty property = case property of
    ArrayProperty _ (NewList array) -> do
        putStrLn "[array]"
        mapM_
            (\ (NewDictionary dictionary) -> mapM_
                (\ (NewPCString k, v) -> do
                    putStr ("\t" ++ show k ++ "\t=> ")
                    debugProperty v)
                (Map.assocs dictionary) >> putStrLn "")
            array
    BoolProperty _ (NewBoolean value) -> print value
    ByteProperty _ (NewPCString key, NewPCString value) -> putStrLn (show key ++ ": " ++ show value)
    FloatProperty _ (NewFloat32LE value) -> print value
    IntProperty _ (NewInt32LE value) -> print value
    NameProperty _ (NewPCString value) -> putStrLn (show value ++ " [name]")
    QWordProperty _ (NewInt64LE value) -> print value
    StrProperty _ (NewPCString value) -> print value