module Rattletrap.Console.Main where

import qualified Control.Exception as Exception
import qualified Control.Monad as Monad
import qualified Data.Bool as Bool
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Lazy as LazyByteString
import qualified Data.List as List
import qualified Data.Text as Text
import qualified Network.HTTP.Client as Client
import qualified Network.HTTP.Client.TLS as Client
import qualified Rattletrap.Console.Config as Config
import qualified Rattletrap.Console.Mode as Mode
import qualified Rattletrap.Console.Option as Option
import qualified Rattletrap.Schema as Schema
import qualified Rattletrap.Type.Attribute as Attribute
import qualified Rattletrap.Type.Attribute.AppliedDamage as Attribute.AppliedDamage
import qualified Rattletrap.Type.Attribute.Boolean as Attribute.Boolean
import qualified Rattletrap.Type.Attribute.Byte as Attribute.Byte
import qualified Rattletrap.Type.Attribute.CamSettings as Attribute.CamSettings
import qualified Rattletrap.Type.Attribute.ClubColors as Attribute.ClubColors
import qualified Rattletrap.Type.Attribute.CustomDemolish as Attribute.CustomDemolish
import qualified Rattletrap.Type.Attribute.DamageState as Attribute.DamageState
import qualified Rattletrap.Type.Attribute.Demolish as Attribute.Demolish
import qualified Rattletrap.Type.Attribute.Enum as Attribute.Enum
import qualified Rattletrap.Type.Attribute.Explosion as Attribute.Explosion
import qualified Rattletrap.Type.Attribute.ExtendedExplosion as Attribute.ExtendedExplosion
import qualified Rattletrap.Type.Attribute.FlaggedByte as Attribute.FlaggedByte
import qualified Rattletrap.Type.Attribute.FlaggedInt as Attribute.FlaggedInt
import qualified Rattletrap.Type.Attribute.Float as Attribute.Float
import qualified Rattletrap.Type.Attribute.GameMode as Attribute.GameMode
import qualified Rattletrap.Type.Attribute.GameServer as Attribute.GameServer
import qualified Rattletrap.Type.Attribute.Int as Attribute.Int
import qualified Rattletrap.Type.Attribute.Int64 as Attribute.Int64
import qualified Rattletrap.Type.Attribute.Loadout as Attribute.Loadout
import qualified Rattletrap.Type.Attribute.LoadoutOnline as Attribute.LoadoutOnline
import qualified Rattletrap.Type.Attribute.Loadouts as Attribute.Loadouts
import qualified Rattletrap.Type.Attribute.LoadoutsOnline as Attribute.LoadoutsOnline
import qualified Rattletrap.Type.Attribute.Location as Attribute.Location
import qualified Rattletrap.Type.Attribute.MusicStinger as Attribute.MusicStinger
import qualified Rattletrap.Type.Attribute.PartyLeader as Attribute.PartyLeader
import qualified Rattletrap.Type.Attribute.Pickup as Attribute.Pickup
import qualified Rattletrap.Type.Attribute.PickupInfo as Attribute.PickupInfo
import qualified Rattletrap.Type.Attribute.PickupNew as Attribute.PickupNew
import qualified Rattletrap.Type.Attribute.PlayerHistoryKey as Attribute.PlayerHistoryKey
import qualified Rattletrap.Type.Attribute.PrivateMatchSettings as Attribute.PrivateMatchSettings
import qualified Rattletrap.Type.Attribute.Product as Attribute.Product
import qualified Rattletrap.Type.Attribute.ProductValue as Attribute.ProductValue
import qualified Rattletrap.Type.Attribute.QWord as Attribute.QWord
import qualified Rattletrap.Type.Attribute.RepStatTitle as Attribute.RepStatTitle
import qualified Rattletrap.Type.Attribute.Reservation as Attribute.Reservation
import qualified Rattletrap.Type.Attribute.RigidBodyState as Attribute.RigidBodyState
import qualified Rattletrap.Type.Attribute.Rotation as Attribute.Rotation
import qualified Rattletrap.Type.Attribute.StatEvent as Attribute.StatEvent
import qualified Rattletrap.Type.Attribute.String as Attribute.String
import qualified Rattletrap.Type.Attribute.TeamPaint as Attribute.TeamPaint
import qualified Rattletrap.Type.Attribute.Title as Attribute.Title
import qualified Rattletrap.Type.Attribute.UniqueId as Attribute.UniqueId
import qualified Rattletrap.Type.Attribute.WeldedInfo as Attribute.WeldedInfo
import qualified Rattletrap.Type.AttributeMapping as AttributeMapping
import qualified Rattletrap.Type.AttributeValue as AttributeValue
import qualified Rattletrap.Type.Cache as Cache
import qualified Rattletrap.Type.ClassMapping as ClassMapping
import qualified Rattletrap.Type.CompressedWord as CompressedWord
import qualified Rattletrap.Type.CompressedWordVector as CompressedWordVector
import qualified Rattletrap.Type.Content as Content
import qualified Rattletrap.Type.Dictionary as Dictionary
import qualified Rattletrap.Type.F32 as F32
import qualified Rattletrap.Type.Frame as Frame
import qualified Rattletrap.Type.Header as Header
import qualified Rattletrap.Type.I32 as I32
import qualified Rattletrap.Type.I64 as I64
import qualified Rattletrap.Type.I8 as I8
import qualified Rattletrap.Type.Initialization as Initialization
import qualified Rattletrap.Type.Int8Vector as Int8Vector
import qualified Rattletrap.Type.Keyframe as Keyframe
import qualified Rattletrap.Type.List as List
import qualified Rattletrap.Type.Mark as Mark
import qualified Rattletrap.Type.Message as Message
import qualified Rattletrap.Type.Property as Property
import qualified Rattletrap.Type.Property.Array as Property.Array
import qualified Rattletrap.Type.Property.Byte as Property.Byte
import qualified Rattletrap.Type.PropertyValue as PropertyValue
import qualified Rattletrap.Type.Quaternion as Quaternion
import qualified Rattletrap.Type.RemoteId as RemoteId
import qualified Rattletrap.Type.RemoteId.PlayStation as RemoteId.PlayStation
import qualified Rattletrap.Type.RemoteId.PsyNet as RemoteId.PsyNet
import qualified Rattletrap.Type.RemoteId.Switch as RemoteId.Switch
import qualified Rattletrap.Type.Replay as Replay
import qualified Rattletrap.Type.Replication as Replication
import qualified Rattletrap.Type.Replication.Destroyed as Replication.Destroyed
import qualified Rattletrap.Type.Replication.Spawned as Replication.Spawned
import qualified Rattletrap.Type.Replication.Updated as Replication.Updated
import qualified Rattletrap.Type.ReplicationValue as ReplicationValue
import qualified Rattletrap.Type.Rotation as Rotation
import qualified Rattletrap.Type.Section as Section
import qualified Rattletrap.Type.Str as Str
import qualified Rattletrap.Type.U32 as U32
import qualified Rattletrap.Type.U64 as U64
import qualified Rattletrap.Type.U8 as U8
import qualified Rattletrap.Type.Vector as Vector
import qualified Rattletrap.Utility.Helper as Rattletrap
import qualified Rattletrap.Utility.Json as Json
import qualified Rattletrap.Version as Version
import qualified System.Console.GetOpt as Console
import qualified System.Environment as Environment
import qualified System.Exit as Exit
import qualified System.FilePath as FilePath
import qualified System.IO as IO

main :: IO ()
main :: IO ()
main = do
  String
name <- IO String
Environment.getProgName
  [String]
arguments <- IO [String]
Environment.getArgs
  String -> [String] -> IO ()
rattletrap String
name [String]
arguments

rattletrap :: String -> [String] -> IO ()
rattletrap :: String -> [String] -> IO ()
rattletrap String
name [String]
arguments = do
  Config
config <- [String] -> IO Config
getConfig [String]
arguments
  if Config -> Bool
Config.help Config
config
    then String -> IO ()
helpMain String
name
    else
      if Config -> Bool
Config.version Config
config
        then IO ()
versionMain
        else
          if Config -> Bool
Config.schema Config
config
            then Config -> IO ()
schemaMain Config
config
            else String -> Config -> IO ()
defaultMain String
name Config
config

helpMain :: String -> IO ()
helpMain :: String -> IO ()
helpMain String
name = do
  String -> IO ()
putStr forall a b. (a -> b) -> a -> b
$
    forall a. String -> [OptDescr a] -> String
Console.usageInfo
      ([String] -> String
unwords [String
name, String
"version", String
Version.string])
      [Option]
Option.all

versionMain :: IO ()
versionMain :: IO ()
versionMain = do
  String -> IO ()
putStrLn String
Version.string

schemaMain :: Config.Config -> IO ()
schemaMain :: Config -> IO ()
schemaMain Config
config = Config -> ByteString -> IO ()
putOutput Config
config forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => Config -> a -> ByteString
encodeJson Config
config Value
schema

defaultMain :: String -> Config.Config -> IO ()
defaultMain :: String -> Config -> IO ()
defaultMain String
name Config
config = do
  ByteString
input <- String -> Config -> IO ByteString
getInput String
name Config
config
  let decode :: ByteString -> Either ([String], SomeException) Replay
decode = Config -> ByteString -> Either ([String], SomeException) Replay
getDecoder Config
config
  Replay
replay <- case ByteString -> Either ([String], SomeException) Replay
decode ByteString
input of
    Left ([String]
ls, SomeException
e) -> do
      Handle -> String -> IO ()
IO.hPutStr Handle
IO.stderr forall a b. (a -> b) -> a -> b
$
        [String] -> String
unlines
          [ String
"ERROR: " forall a. Semigroup a => a -> a -> a
<> forall e. Exception e => e -> String
Exception.displayException SomeException
e,
            String
"-- Context: " forall a. Semigroup a => a -> a -> a
<> forall a. [a] -> [[a]] -> [a]
List.intercalate String
", " [String]
ls,
            String
"-- You are using Rattletrap version " forall a. Semigroup a => a -> a -> a
<> String
Version.string,
            String
"-- " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Config
config,
            String
"-- Please report this problem at https://github.com/tfausak/rattletrap/issues/new"
          ]
      forall a. IO a
Exit.exitFailure
    Right Replay
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Replay
x
  let encode :: Replay -> ByteString
encode = Config -> Replay -> ByteString
getEncoder Config
config
  Config -> ByteString -> IO ()
putOutput Config
config (Replay -> ByteString
encode Replay
replay)

schema :: Json.Value
schema :: Value
schema =
  let contentSchema :: Schema
contentSchema = Schema -> Schema
Content.schema forall a b. (a -> b) -> a -> b
$ Schema -> Schema
List.schema Schema
Frame.schema
   in [Pair] -> Value
Json.object
        [ forall value p. (ToJSON value, KeyValue p) => String -> value -> p
Json.pair String
"$schema" String
"http://json-schema.org/draft-07/schema",
          forall value p. (ToJSON value, KeyValue p) => String -> value -> p
Json.pair String
"$id" String
Replay.schemaUrl,
          forall value p. (ToJSON value, KeyValue p) => String -> value -> p
Json.pair String
"$ref" String
"#/definitions/replay",
          forall value p. (ToJSON value, KeyValue p) => String -> value -> p
Json.pair String
"definitions" forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pair] -> Value
Json.object forall a b. (a -> b) -> a -> b
$
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
              (\Schema
s -> forall value p. (ToJSON value, KeyValue p) => String -> value -> p
Json.pair (Text -> String
Text.unpack forall a b. (a -> b) -> a -> b
$ Schema -> Text
Schema.name Schema
s) forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.json Schema
s)
              [ Schema
Attribute.schema,
                Schema
Attribute.AppliedDamage.schema,
                Schema
Attribute.Boolean.schema,
                Schema
Attribute.Byte.schema,
                Schema
Attribute.CamSettings.schema,
                Schema
Attribute.ClubColors.schema,
                Schema
Attribute.CustomDemolish.schema,
                Schema
Attribute.DamageState.schema,
                Schema
Attribute.Demolish.schema,
                Schema
Attribute.Enum.schema,
                Schema
Attribute.Explosion.schema,
                Schema
Attribute.ExtendedExplosion.schema,
                Schema
Attribute.FlaggedByte.schema,
                Schema
Attribute.FlaggedInt.schema,
                Schema
Attribute.Float.schema,
                Schema
Attribute.GameMode.schema,
                Schema
Attribute.GameServer.schema,
                Schema
Attribute.Int.schema,
                Schema
Attribute.Int64.schema,
                Schema
Attribute.Loadout.schema,
                Schema
Attribute.LoadoutOnline.schema,
                Schema
Attribute.Loadouts.schema,
                Schema
Attribute.LoadoutsOnline.schema,
                Schema
Attribute.Location.schema,
                Schema
Attribute.MusicStinger.schema,
                Schema
Attribute.PartyLeader.schema,
                Schema
Attribute.Pickup.schema,
                Schema
Attribute.PickupInfo.schema,
                Schema
Attribute.PickupNew.schema,
                Schema
Attribute.PlayerHistoryKey.schema,
                Schema
Attribute.PrivateMatchSettings.schema,
                Schema
Attribute.Product.schema,
                Schema
Attribute.ProductValue.schema,
                Schema
Attribute.QWord.schema,
                Schema
Attribute.RepStatTitle.schema,
                Schema
Attribute.Reservation.schema,
                Schema
Attribute.RigidBodyState.schema,
                Schema
Attribute.Rotation.schema,
                Schema
Attribute.StatEvent.schema,
                Schema
Attribute.String.schema,
                Schema
Attribute.TeamPaint.schema,
                Schema
Attribute.Title.schema,
                Schema
Attribute.UniqueId.schema,
                Schema
Attribute.WeldedInfo.schema,
                Schema
AttributeMapping.schema,
                Schema
AttributeValue.schema,
                Schema
Cache.schema,
                Schema
ClassMapping.schema,
                Schema
CompressedWord.schema,
                Schema
CompressedWordVector.schema,
                Schema
contentSchema,
                Schema -> Schema
Dictionary.schema Schema
Property.schema,
                Schema
F32.schema,
                Schema
Frame.schema,
                Schema
Header.schema,
                Schema
I32.schema,
                Schema
I64.schema,
                Schema
I8.schema,
                Schema
Initialization.schema,
                Schema
Int8Vector.schema,
                Schema
Keyframe.schema,
                Schema -> Schema
List.schema Schema
Attribute.Product.schema,
                Schema
Mark.schema,
                Schema
Message.schema,
                Schema
Property.schema,
                Schema -> Schema
Property.Array.schema Schema
Property.schema,
                Schema
Property.Byte.schema,
                Schema -> Schema
PropertyValue.schema Schema
Property.schema,
                Schema
Quaternion.schema,
                Schema
RemoteId.schema,
                Schema
RemoteId.PlayStation.schema,
                Schema
RemoteId.PsyNet.schema,
                Schema
RemoteId.Switch.schema,
                Schema -> Schema -> Schema
Replay.schema (Schema -> Schema
Section.schema Schema
Header.schema)
                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Schema
Section.schema
                  forall a b. (a -> b) -> a -> b
$ Schema
contentSchema,
                Schema
Replication.Destroyed.schema,
                Schema
Replication.schema,
                Schema
Replication.Spawned.schema,
                Schema
Replication.Updated.schema,
                Schema
ReplicationValue.schema,
                Schema
Rotation.schema,
                Schema
Schema.boolean,
                Schema
Schema.integer,
                Schema
Schema.null,
                Schema
Schema.number,
                Schema
Schema.string,
                Schema -> Schema
Section.schema Schema
contentSchema,
                Schema -> Schema
Section.schema Schema
Header.schema,
                Schema
Str.schema,
                Schema
U32.schema,
                Schema
U64.schema,
                Schema
U8.schema,
                Schema
Vector.schema
              ]
        ]

getDecoder ::
  Config.Config ->
  ByteString.ByteString ->
  Either ([String], Exception.SomeException) Replay.Replay
getDecoder :: Config -> ByteString -> Either ([String], SomeException) Replay
getDecoder Config
config = case Config -> Mode
Config.getMode Config
config of
  Mode
Mode.Decode ->
    Bool
-> Bool -> ByteString -> Either ([String], SomeException) Replay
Rattletrap.decodeReplayFile (Config -> Bool
Config.fast Config
config) (Config -> Bool
Config.skipCrc Config
config)
  Mode
Mode.Encode -> ByteString -> Either ([String], SomeException) Replay
Rattletrap.decodeReplayJson

getEncoder :: Config.Config -> Replay.Replay -> LazyByteString.ByteString
getEncoder :: Config -> Replay -> ByteString
getEncoder Config
config = case Config -> Mode
Config.getMode Config
config of
  Mode
Mode.Decode -> forall a. ToJSON a => Config -> a -> ByteString
encodeJson Config
config
  Mode
Mode.Encode -> Bool -> Replay -> ByteString
Rattletrap.encodeReplayFile forall a b. (a -> b) -> a -> b
$ Config -> Bool
Config.fast Config
config

getInput :: String -> Config.Config -> IO ByteString.ByteString
getInput :: String -> Config -> IO ByteString
getInput String
name Config
config = case Config -> Maybe String
Config.input Config
config of
  Maybe String
Nothing -> do
    Bool
isTerminalDevice <- Handle -> IO Bool
IO.hIsTerminalDevice Handle
IO.stdin
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Monad.when Bool
isTerminalDevice forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> String -> IO ()
IO.hPutStr Handle
IO.stderr forall a b. (a -> b) -> a -> b
$
      [String] -> String
unlines
        [ String
"-- You did not supply any input, so Rattletrap will read from STDIN.",
          String
"-- If that is unexpected, try running: "
            forall a. Semigroup a => a -> a -> a
<> String -> String -> String
FilePath.combine String
"." String
name
            forall a. Semigroup a => a -> a -> a
<> String
" --help"
        ]
    IO ByteString
ByteString.getContents
  Just String
fileOrUrl -> case forall (m :: * -> *). MonadThrow m => String -> m Request
Client.parseUrlThrow String
fileOrUrl of
    Maybe Request
Nothing -> String -> IO ByteString
ByteString.readFile String
fileOrUrl
    Just Request
request -> do
      Manager
manager <- forall (m :: * -> *). MonadIO m => m Manager
Client.newTlsManager
      Response ByteString
response <- Request -> Manager -> IO (Response ByteString)
Client.httpLbs Request
request Manager
manager
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> ByteString
LazyByteString.toStrict (forall body. Response body -> body
Client.responseBody Response ByteString
response))

putOutput :: Config.Config -> LazyByteString.ByteString -> IO ()
putOutput :: Config -> ByteString -> IO ()
putOutput =
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString -> IO ()
LazyByteString.putStr String -> ByteString -> IO ()
LazyByteString.writeFile forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Maybe String
Config.output

encodeJson :: (Json.ToJSON a) => Config.Config -> a -> LazyByteString.ByteString
encodeJson :: forall a. ToJSON a => Config -> a -> ByteString
encodeJson = forall a. a -> a -> Bool -> a
Bool.bool forall a. ToJSON a => a -> ByteString
Json.encodePretty forall a. ToJSON a => a -> ByteString
Json.encode forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Bool
Config.compact

getConfig :: [String] -> IO Config.Config
getConfig :: [String] -> IO Config
getConfig [String]
arguments = do
  let ([Flag]
flags, [String]
unexpectedArguments, [String]
unknownOptions, [String]
problems) =
        forall a.
ArgOrder a
-> [OptDescr a] -> [String] -> ([a], [String], [String], [String])
Console.getOpt' forall a. ArgOrder a
Console.Permute [Option]
Option.all [String]
arguments
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
Monad.forM_ [String]
unexpectedArguments forall a b. (a -> b) -> a -> b
$ \String
x ->
    Handle -> String -> IO ()
IO.hPutStrLn Handle
IO.stderr forall a b. (a -> b) -> a -> b
$ String
"WARNING: unexpected argument `" forall a. Semigroup a => a -> a -> a
<> String
x forall a. Semigroup a => a -> a -> a
<> String
"'"
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
Monad.forM_ [String]
unknownOptions forall a b. (a -> b) -> a -> b
$
    \String
x -> Handle -> String -> IO ()
IO.hPutStrLn Handle
IO.stderr forall a b. (a -> b) -> a -> b
$ String
"WARNING: unknown option `" forall a. Semigroup a => a -> a -> a
<> String
x forall a. Semigroup a => a -> a -> a
<> String
"'"
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
Monad.forM_ [String]
problems forall a b. (a -> b) -> a -> b
$ \String
x -> Handle -> String -> IO ()
IO.hPutStr Handle
IO.stderr forall a b. (a -> b) -> a -> b
$ String
"ERROR: " forall a. Semigroup a => a -> a -> a
<> String
x
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Monad.unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
problems) forall a. IO a
Exit.exitFailure
  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
Monad.foldM Config -> Flag -> Either String Config
Config.applyFlag Config
Config.initial [Flag]
flags