-- | 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 Replay
decodeReplayFile :: Bool -> ByteString -> Either String Replay
decodeReplayFile Bool
fast = Decode Replay -> ByteString -> Either String Replay
forall a. Decode a -> ByteString -> Either String a
runDecode (Decode Replay -> ByteString -> Either String Replay)
-> Decode Replay -> ByteString -> Either String Replay
forall a b. (a -> b) -> a -> b
$ Bool -> Decode Replay
decodeReplay Bool
fast

-- | Encodes a replay as JSON.
encodeReplayJson :: Replay -> Bytes.ByteString
encodeReplayJson :: Replay -> ByteString
encodeReplayJson = ByteString -> ByteString
LazyBytes.toStrict (ByteString -> ByteString)
-> (Replay -> ByteString) -> Replay -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Replay -> 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 Replay
decodeReplayJson :: ByteString -> Either String Replay
decodeReplayJson = ByteString -> Either String Replay
forall a. FromJSON a => ByteString -> Either String a
Json.eitherDecodeStrict'

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