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