module Rattletrap.Console.Main
  ( main
  , rattletrap
  ) where

import qualified Control.Monad as Monad
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Encode.Pretty as Aeson
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Lazy as LazyByteString
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.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.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.Reservation as Attribute.Reservation
import qualified Rattletrap.Type.Attribute.RigidBodyState as Attribute.RigidBodyState
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.PropertyValue as PropertyValue
import qualified Rattletrap.Type.Quaternion as Quaternion
import qualified Rattletrap.Type.RemoteId as RemoteId
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.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 Config -> IO ()
defaultMain Config
config

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

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

schemaMain :: Config.Config -> IO ()
schemaMain :: Config -> IO ()
schemaMain Config
config = do
  let
    json :: ByteString
json = Config -> Value -> ByteString
forall a. ToJSON a => Config -> a -> ByteString
Aeson.encodePretty'
      Config
Aeson.defConfig
        { confCompare :: Text -> Text -> Ordering
Aeson.confCompare = Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
        , confIndent :: Indent
Aeson.confIndent = Indent
Aeson.Tab
        , confTrailingNewline :: Bool
Aeson.confTrailingNewline = Bool
True
        }
      Value
schema
  case Config -> Maybe String
Config.output Config
config of
    Maybe String
Nothing -> ByteString -> IO ()
LazyByteString.putStr ByteString
json
    Just String
file -> String -> ByteString -> IO ()
LazyByteString.writeFile String
file ByteString
json

defaultMain :: Config.Config -> IO ()
defaultMain :: Config -> IO ()
defaultMain Config
config = do
  ByteString
input <- Config -> IO ByteString
getInput Config
config
  let decode :: ByteString -> Either String Replay
decode = Config -> ByteString -> Either String Replay
getDecoder Config
config
  Replay
replay <- (String -> IO Replay)
-> (Replay -> IO Replay) -> Either String Replay -> IO Replay
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> IO Replay
forall (m :: * -> *) a. MonadFail m => String -> m a
fail Replay -> IO Replay
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Either String Replay
decode ByteString
input)
  let encode :: Replay -> ByteString
encode = Config -> Replay -> ByteString
getEncoder Config
config
  Config -> ByteString -> IO ()
putOutput Config
config (Replay -> ByteString
encode Replay
replay)

schema :: Aeson.Value
schema :: Value
schema =
  let contentSchema :: Schema
contentSchema = Schema -> Schema
Content.schema (Schema -> Schema) -> Schema -> Schema
forall a b. (a -> b) -> a -> b
$ Schema -> Schema
List.schema Schema
Frame.schema
  in
    [Pair] -> Value
Aeson.object
      [ String -> String -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"$schema" String
"https://json-schema.org/draft-07/schema"
      , String -> String -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"$id" String
Replay.schemaUrl
      , String -> String -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"$ref" String
"#/definitions/replay"
      , String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"definitions" (Value -> Pair) -> ([Pair] -> Value) -> [Pair] -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pair] -> Value
Aeson.object ([Pair] -> Pair) -> [Pair] -> Pair
forall a b. (a -> b) -> a -> b
$ (Schema -> Pair) -> [Schema] -> [Pair]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
        (\Schema
s -> Schema -> Text
Schema.name Schema
s Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Aeson..= 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.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.PickupNew.schema
        , Schema
Attribute.PlayerHistoryKey.schema
        , Schema
Attribute.PrivateMatchSettings.schema
        , Schema
Attribute.Product.schema
        , Schema
Attribute.ProductValue.schema
        , Schema
Attribute.QWord.schema
        , Schema
Attribute.Reservation.schema
        , Schema
Attribute.RigidBodyState.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
PropertyValue.schema Schema
Property.schema
        , Schema
Quaternion.schema
        , Schema
RemoteId.schema
        , Schema -> Schema -> Schema
Replay.schema (Schema -> Schema
Section.schema Schema
Header.schema)
        (Schema -> Schema) -> (Schema -> Schema) -> Schema -> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Schema
Section.schema
        (Schema -> Schema) -> Schema -> 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 Replay.Replay
getDecoder :: Config -> ByteString -> Either String Replay
getDecoder Config
config = case Config -> Mode
Config.getMode Config
config of
  Mode
Mode.Decode ->
    Bool -> Bool -> ByteString -> Either String Replay
Rattletrap.decodeReplayFile (Config -> Bool
Config.fast Config
config) (Config -> Bool
Config.skipCrc Config
config)
  Mode
Mode.Encode -> ByteString -> Either String 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 ->
    if Config -> Bool
Config.compact Config
config then Replay -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode else Replay -> ByteString
Rattletrap.encodeReplayJson
  Mode
Mode.Encode -> Bool -> Replay -> ByteString
Rattletrap.encodeReplayFile (Bool -> Replay -> ByteString) -> Bool -> Replay -> ByteString
forall a b. (a -> b) -> a -> b
$ Config -> Bool
Config.fast Config
config

getInput :: Config.Config -> IO ByteString.ByteString
getInput :: Config -> IO ByteString
getInput Config
config = case Config -> Maybe String
Config.input Config
config of
  Maybe String
Nothing -> IO ByteString
ByteString.getContents
  Just String
fileOrUrl -> case String -> Maybe Request
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 <- IO Manager
forall (m :: * -> *). MonadIO m => m Manager
Client.newTlsManager
      Response ByteString
response <- Request -> Manager -> IO (Response ByteString)
Client.httpLbs Request
request Manager
manager
      ByteString -> IO ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> ByteString
LazyByteString.toStrict (Response ByteString -> ByteString
forall body. Response body -> body
Client.responseBody Response ByteString
response))

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

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