-- | This module provides helper functions for converting replays to and from
-- both their binary format and JSON.
module Rattletrap.Utility.Helper where

import qualified Rattletrap.ByteGet as ByteGet
import qualified Rattletrap.BytePut as BytePut
import qualified Rattletrap.Exception.InvalidJson as InvalidJson
import qualified Rattletrap.Type.Content as Content
import qualified Rattletrap.Type.Replay as Replay
import qualified Rattletrap.Type.Section as Section
import qualified Rattletrap.Utility.Json as Json

import qualified Control.Exception as Exception
import qualified Data.Bifunctor as Bifunctor
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Lazy as LazyByteString

-- | Parses a raw replay.
decodeReplayFile
  :: Bool
  -> Bool
  -> ByteString.ByteString
  -> Either ([String], Exception.SomeException) Replay.Replay
decodeReplayFile :: Bool
-> Bool -> ByteString -> Either ([String], SomeException) Replay
decodeReplayFile Bool
fast = ByteGet Replay
-> ByteString -> Either ([String], SomeException) Replay
forall a.
ByteGet a -> ByteString -> Either ([String], SomeException) a
ByteGet.run (ByteGet Replay
 -> ByteString -> Either ([String], SomeException) Replay)
-> (Bool -> ByteGet Replay)
-> Bool
-> ByteString
-> Either ([String], SomeException) Replay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool -> ByteGet Replay
Replay.byteGet Bool
fast

-- | Encodes a replay as JSON.
encodeReplayJson :: Replay.Replay -> LazyByteString.ByteString
encodeReplayJson :: Replay -> ByteString
encodeReplayJson = Replay -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodePretty

-- | Parses a JSON replay.
decodeReplayJson
  :: ByteString.ByteString
  -> Either ([String], Exception.SomeException) Replay.Replay
decodeReplayJson :: ByteString -> Either ([String], SomeException) Replay
decodeReplayJson =
  (String -> ([String], SomeException))
-> Either String Replay -> Either ([String], SomeException) Replay
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
Bifunctor.first ((,) [] (SomeException -> ([String], SomeException))
-> (String -> SomeException) -> String -> ([String], SomeException)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InvalidJson -> SomeException
forall e. Exception e => e -> SomeException
Exception.toException (InvalidJson -> SomeException)
-> (String -> InvalidJson) -> String -> SomeException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> InvalidJson
InvalidJson.InvalidJson)
    (Either String Replay -> Either ([String], SomeException) Replay)
-> (ByteString -> Either String Replay)
-> ByteString
-> Either ([String], SomeException) Replay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String Replay
forall a. FromJSON a => ByteString -> Either String a
Json.decode

-- | Encodes a raw replay.
encodeReplayFile :: Bool -> Replay.Replay -> LazyByteString.ByteString
encodeReplayFile :: Bool -> Replay -> ByteString
encodeReplayFile Bool
fast Replay
replay =
  BytePut -> ByteString
BytePut.toLazyByteString (BytePut -> ByteString)
-> (Replay -> BytePut) -> Replay -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Replay -> BytePut
Replay.bytePut (Replay -> ByteString) -> Replay -> ByteString
forall a b. (a -> b) -> a -> b
$ if Bool
fast
    then Replay
replay
      { content :: Section Content
Replay.content = (Content -> BytePut) -> Content -> Section Content
forall a. (a -> BytePut) -> a -> Section a
Section.create Content -> BytePut
Content.bytePut Content
Content.empty
      }
    else Replay
replay