-- | This module provides helper functions for converting replays to and from
-- both their binary format and JSON.
module Rattletrap.Utility.Helper
  ( decodeReplayFile
  , encodeReplayJson
  , decodeReplayJson
  , encodeReplayFile
  )
where

import Rattletrap.Decode.Common
import Rattletrap.Encode.Content
import Rattletrap.Decode.Replay
import Rattletrap.Encode.Replay
import Rattletrap.Type.Replay
import Rattletrap.Type.Section
import Rattletrap.Type.Content

import qualified Data.Aeson as Json
import qualified Data.Aeson.Encode.Pretty as Json
import qualified Data.Binary.Put as Binary
import qualified Data.ByteString as Bytes
import qualified Data.ByteString.Lazy as LazyBytes

-- | Parses a raw replay.
decodeReplayFile :: Bool -> Bytes.ByteString -> Either String FullReplay
decodeReplayFile :: Bool -> ByteString -> Either String FullReplay
decodeReplayFile Bool
fast = Decode FullReplay -> ByteString -> Either String FullReplay
forall a. Decode a -> ByteString -> Either String a
runDecode (Decode FullReplay -> ByteString -> Either String FullReplay)
-> Decode FullReplay -> ByteString -> Either String FullReplay
forall a b. (a -> b) -> a -> b
$ Bool -> Decode FullReplay
decodeReplay Bool
fast

-- | Encodes a replay as JSON.
encodeReplayJson :: FullReplay -> Bytes.ByteString
encodeReplayJson :: FullReplay -> ByteString
encodeReplayJson = ByteString -> ByteString
LazyBytes.toStrict (ByteString -> ByteString)
-> (FullReplay -> ByteString) -> FullReplay -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> FullReplay -> ByteString
forall a. ToJSON a => Config -> a -> ByteString
Json.encodePretty' Config
Json.defConfig
  { confCompare :: Text -> Text -> Ordering
Json.confCompare = Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
  , confIndent :: Indent
Json.confIndent = Int -> Indent
Json.Spaces Int
2
  , confTrailingNewline :: Bool
Json.confTrailingNewline = Bool
True
  }

-- | Parses a JSON replay.
decodeReplayJson :: Bytes.ByteString -> Either String FullReplay
decodeReplayJson :: ByteString -> Either String FullReplay
decodeReplayJson = ByteString -> Either String FullReplay
forall a. FromJSON a => ByteString -> Either String a
Json.eitherDecodeStrict'

-- | Encodes a raw replay.
encodeReplayFile :: Bool -> FullReplay -> Bytes.ByteString
encodeReplayFile :: Bool -> FullReplay -> ByteString
encodeReplayFile Bool
fast FullReplay
replay =
  ByteString -> ByteString
LazyBytes.toStrict (ByteString -> ByteString)
-> (FullReplay -> ByteString) -> FullReplay -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
Binary.runPut (Put -> ByteString)
-> (FullReplay -> Put) -> FullReplay -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FullReplay -> Put
putReplay (FullReplay -> ByteString) -> FullReplay -> ByteString
forall a b. (a -> b) -> a -> b
$ if Bool
fast
    then FullReplay
replay { replayContent :: Section Content
replayContent = (Content -> Put) -> Content -> Section Content
forall a. (a -> Put) -> a -> Section a
toSection Content -> Put
putContent Content
defaultContent }
    else FullReplay
replay