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 pair. (ToJSON value, KeyValue pair) => String -> value -> pair Json.pair String "$schema" String "http://json-schema.org/draft-07/schema", forall value pair. (ToJSON value, KeyValue pair) => String -> value -> pair Json.pair String "$id" String Replay.schemaUrl, forall value pair. (ToJSON value, KeyValue pair) => String -> value -> pair Json.pair String "$ref" String "#/definitions/replay", forall value pair. (ToJSON value, KeyValue pair) => String -> value -> pair 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 pair. (ToJSON value, KeyValue pair) => String -> value -> pair 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