module Rattletrap.Console.Main
( main
, rattletrap
)
where
import qualified Control.Monad as Monad
import qualified Data.Aeson as Json
import qualified Data.ByteString as Bytes
import qualified Data.ByteString.Lazy as LazyBytes
import qualified Data.Version as Version
import qualified Network.HTTP.Client as Client
import qualified Network.HTTP.Client.TLS as Client
import qualified Paths_rattletrap as This
import qualified Rattletrap.Type.Replay as Rattletrap
import qualified Rattletrap.Utility.Helper as Rattletrap
import qualified System.Console.GetOpt as Console
import qualified System.Environment as Environment
import qualified System.Exit as Exit
import qualified System.FilePath as Path
import qualified System.IO as IO
import qualified Text.Printf as Printf
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
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Monad.when (Config -> Bool
configHelp Config
config) (String -> IO ()
printHelp String
name IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> IO ()
forall a. IO a
Exit.exitFailure)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Monad.when (Config -> Bool
configVersion Config
config) (IO ()
printVersion IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> IO ()
forall a. IO a
Exit.exitFailure)
ByteString
input <- Config -> IO ByteString
getInput Config
config
let decode :: ByteString -> Either String FullReplay
decode = Config -> ByteString -> Either String FullReplay
getDecoder Config
config
FullReplay
replay <- (String -> IO FullReplay)
-> (FullReplay -> IO FullReplay)
-> Either String FullReplay
-> IO FullReplay
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> IO FullReplay
forall (m :: * -> *) a. MonadFail m => String -> m a
fail FullReplay -> IO FullReplay
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Either String FullReplay
decode ByteString
input)
let encode :: FullReplay -> ByteString
encode = Config -> FullReplay -> ByteString
getEncoder Config
config
Config -> ByteString -> IO ()
putOutput Config
config (FullReplay -> ByteString
encode FullReplay
replay)
getDecoder :: Config -> Bytes.ByteString -> Either String Rattletrap.FullReplay
getDecoder :: Config -> ByteString -> Either String FullReplay
getDecoder Config
config = case Config -> Mode
getMode Config
config of
Mode
ModeDecode -> Bool -> ByteString -> Either String FullReplay
Rattletrap.decodeReplayFile (Bool -> ByteString -> Either String FullReplay)
-> Bool -> ByteString -> Either String FullReplay
forall a b. (a -> b) -> a -> b
$ Config -> Bool
configFast Config
config
Mode
ModeEncode -> ByteString -> Either String FullReplay
Rattletrap.decodeReplayJson
getEncoder :: Config -> Rattletrap.FullReplay -> Bytes.ByteString
getEncoder :: Config -> FullReplay -> ByteString
getEncoder Config
config = case Config -> Mode
getMode Config
config of
Mode
ModeDecode -> if Config -> Bool
configCompact Config
config
then ByteString -> ByteString
LazyBytes.toStrict (ByteString -> ByteString)
-> (FullReplay -> ByteString) -> FullReplay -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FullReplay -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encode
else FullReplay -> ByteString
Rattletrap.encodeReplayJson
Mode
ModeEncode -> Bool -> FullReplay -> ByteString
Rattletrap.encodeReplayFile (Bool -> FullReplay -> ByteString)
-> Bool -> FullReplay -> ByteString
forall a b. (a -> b) -> a -> b
$ Config -> Bool
configFast Config
config
getInput :: Config -> IO Bytes.ByteString
getInput :: Config -> IO ByteString
getInput Config
config = case Config -> Maybe String
configInput Config
config of
Maybe String
Nothing -> IO ByteString
Bytes.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
Bytes.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
LazyBytes.toStrict (Response ByteString -> ByteString
forall body. Response body -> body
Client.responseBody Response ByteString
response))
putOutput :: Config -> Bytes.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 ()
Bytes.putStr String -> ByteString -> IO ()
Bytes.writeFile (Maybe String -> ByteString -> IO ())
-> (Config -> Maybe String) -> Config -> ByteString -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Maybe String
configOutput
getConfig :: [String] -> IO Config
getConfig :: [String] -> IO Config
getConfig [String]
arguments = do
let
([Update]
updates, [String]
unexpectedArguments, [String]
unknownOptions, [String]
problems) =
ArgOrder Update
-> [OptDescr Update]
-> [String]
-> ([Update], [String], [String], [String])
forall a.
ArgOrder a
-> [OptDescr a] -> [String] -> ([a], [String], [String], [String])
Console.getOpt' ArgOrder Update
forall a. ArgOrder a
Console.Permute [OptDescr Update]
options [String]
arguments
[String] -> IO ()
printUnexpectedArguments [String]
unexpectedArguments
[String] -> IO ()
printUnknownOptions [String]
unknownOptions
[String] -> IO ()
printProblems [String]
problems
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 ((Config -> Update -> Either String Config)
-> Config -> [Update] -> Either String Config
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
Monad.foldM Config -> Update -> Either String Config
applyUpdate Config
defaultConfig [Update]
updates)
type Option = Console.OptDescr Update
type Update = Config -> Either String Config
options :: [Option]
options :: [OptDescr Update]
options =
[ OptDescr Update
compactOption
, OptDescr Update
fastOption
, OptDescr Update
helpOption
, OptDescr Update
inputOption
, OptDescr Update
modeOption
, OptDescr Update
outputOption
, OptDescr Update
versionOption
]
compactOption :: Option
compactOption :: OptDescr Update
compactOption = String -> [String] -> ArgDescr Update -> String -> OptDescr Update
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Console.Option
[Char
'c']
[String
"compact"]
(Update -> ArgDescr Update
forall a. a -> ArgDescr a
Console.NoArg (\Config
config -> Update
forall (f :: * -> *) a. Applicative f => a -> f a
pure Config
config { configCompact :: Bool
configCompact = Bool
True }))
String
"minify JSON output"
fastOption :: Option
fastOption :: OptDescr Update
fastOption = String -> [String] -> ArgDescr Update -> String -> OptDescr Update
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Console.Option
[Char
'f']
[String
"fast"]
(Update -> ArgDescr Update
forall a. a -> ArgDescr a
Console.NoArg (\Config
config -> Update
forall (f :: * -> *) a. Applicative f => a -> f a
pure Config
config { configFast :: Bool
configFast = Bool
True }))
String
"only encode or decode the header"
helpOption :: Option
helpOption :: OptDescr Update
helpOption = String -> [String] -> ArgDescr Update -> String -> OptDescr Update
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Console.Option
[Char
'h']
[String
"help"]
(Update -> ArgDescr Update
forall a. a -> ArgDescr a
Console.NoArg (\Config
config -> Update
forall (f :: * -> *) a. Applicative f => a -> f a
pure Config
config { configHelp :: Bool
configHelp = Bool
True }))
String
"show the help"
inputOption :: Option
inputOption :: OptDescr Update
inputOption = String -> [String] -> ArgDescr Update -> String -> OptDescr Update
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Console.Option
[Char
'i']
[String
"input"]
((String -> Update) -> String -> ArgDescr Update
forall a. (String -> a) -> String -> ArgDescr a
Console.ReqArg
(\String
input Config
config -> Update
forall (f :: * -> *) a. Applicative f => a -> f a
pure Config
config { configInput :: Maybe String
configInput = String -> Maybe String
forall a. a -> Maybe a
Just String
input })
String
"FILE|URL"
)
String
"input file or URL"
modeOption :: Option
modeOption :: OptDescr Update
modeOption = String -> [String] -> ArgDescr Update -> String -> OptDescr Update
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Console.Option
[Char
'm']
[String
"mode"]
((String -> Update) -> String -> ArgDescr Update
forall a. (String -> a) -> String -> ArgDescr a
Console.ReqArg
(\String
rawMode Config
config -> do
Mode
mode <- String -> Either String Mode
parseMode String
rawMode
Update
forall (f :: * -> *) a. Applicative f => a -> f a
pure Config
config { configMode :: Maybe Mode
configMode = Mode -> Maybe Mode
forall a. a -> Maybe a
Just Mode
mode }
)
String
"MODE"
)
String
"decode or encode"
outputOption :: Option
outputOption :: OptDescr Update
outputOption = String -> [String] -> ArgDescr Update -> String -> OptDescr Update
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Console.Option
[Char
'o']
[String
"output"]
((String -> Update) -> String -> ArgDescr Update
forall a. (String -> a) -> String -> ArgDescr a
Console.ReqArg
(\String
output Config
config -> Update
forall (f :: * -> *) a. Applicative f => a -> f a
pure Config
config { configOutput :: Maybe String
configOutput = String -> Maybe String
forall a. a -> Maybe a
Just String
output })
String
"FILE"
)
String
"output file"
versionOption :: Option
versionOption :: OptDescr Update
versionOption = String -> [String] -> ArgDescr Update -> String -> OptDescr Update
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Console.Option
[Char
'v']
[String
"version"]
(Update -> ArgDescr Update
forall a. a -> ArgDescr a
Console.NoArg (\Config
config -> Update
forall (f :: * -> *) a. Applicative f => a -> f a
pure Config
config { configVersion :: Bool
configVersion = Bool
True }))
String
"show the version"
applyUpdate :: Config -> Update -> Either String Config
applyUpdate :: Config -> Update -> Either String Config
applyUpdate Config
config Update
update = Update
update Config
config
data Config = Config
{ Config -> Bool
configCompact :: Bool
, Config -> Bool
configFast :: Bool
, Config -> Bool
configHelp :: Bool
, Config -> Maybe String
configInput :: Maybe String
, Config -> Maybe Mode
configMode :: Maybe Mode
, Config -> Maybe String
configOutput :: Maybe String
, Config -> Bool
configVersion :: Bool
} deriving (Int -> Config -> ShowS
[Config] -> ShowS
Config -> String
(Int -> Config -> ShowS)
-> (Config -> String) -> ([Config] -> ShowS) -> Show Config
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Config] -> ShowS
$cshowList :: [Config] -> ShowS
show :: Config -> String
$cshow :: Config -> String
showsPrec :: Int -> Config -> ShowS
$cshowsPrec :: Int -> Config -> ShowS
Show)
defaultConfig :: Config
defaultConfig :: Config
defaultConfig = Config :: Bool
-> Bool
-> Bool
-> Maybe String
-> Maybe Mode
-> Maybe String
-> Bool
-> Config
Config
{ configCompact :: Bool
configCompact = Bool
False
, configFast :: Bool
configFast = Bool
False
, configHelp :: Bool
configHelp = Bool
False
, configInput :: Maybe String
configInput = Maybe String
forall a. Maybe a
Nothing
, configMode :: Maybe Mode
configMode = Maybe Mode
forall a. Maybe a
Nothing
, configOutput :: Maybe String
configOutput = Maybe String
forall a. Maybe a
Nothing
, configVersion :: Bool
configVersion = Bool
False
}
getMode :: Config -> Mode
getMode :: Config -> Mode
getMode Config
config = case Maybe String -> String
getExtension (Config -> Maybe String
configInput Config
config) of
String
".json" -> Mode
ModeEncode
String
".replay" -> Mode
ModeDecode
String
_ -> case Maybe String -> String
getExtension (Config -> Maybe String
configOutput Config
config) of
String
".json" -> Mode
ModeDecode
String
".replay" -> Mode
ModeEncode
String
_ -> Mode
ModeDecode
getExtension :: Maybe String -> String
getExtension :: Maybe String -> String
getExtension = String -> ShowS -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" ShowS
Path.takeExtension
data Mode
= ModeDecode
| ModeEncode
deriving (Int -> Mode -> ShowS
[Mode] -> ShowS
Mode -> String
(Int -> Mode -> ShowS)
-> (Mode -> String) -> ([Mode] -> ShowS) -> Show Mode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mode] -> ShowS
$cshowList :: [Mode] -> ShowS
show :: Mode -> String
$cshow :: Mode -> String
showsPrec :: Int -> Mode -> ShowS
$cshowsPrec :: Int -> Mode -> ShowS
Show)
parseMode :: String -> Either String Mode
parseMode :: String -> Either String Mode
parseMode String
mode = case String
mode of
String
"decode" -> Mode -> Either String Mode
forall a b. b -> Either a b
Right Mode
ModeDecode
String
"encode" -> Mode -> Either String Mode
forall a b. b -> Either a b
Right Mode
ModeEncode
String
_ -> String -> Either String Mode
forall a b. a -> Either a b
Left (String -> ShowS
forall r. PrintfType r => String -> r
Printf.printf String
"invalid mode: %s" (ShowS
forall a. Show a => a -> String
show String
mode))
printUnexpectedArguments :: [String] -> IO ()
printUnexpectedArguments :: [String] -> IO ()
printUnexpectedArguments = (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
printUnexpectedArgument
printUnexpectedArgument :: String -> IO ()
printUnexpectedArgument :: String -> IO ()
printUnexpectedArgument =
String -> IO ()
warnLn (String -> IO ()) -> ShowS -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
forall r. PrintfType r => String -> r
Printf.printf String
"WARNING: unexpected argument `%s'"
printUnknownOptions :: [String] -> IO ()
printUnknownOptions :: [String] -> IO ()
printUnknownOptions = (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
printUnknownOption
printUnknownOption :: String -> IO ()
printUnknownOption :: String -> IO ()
printUnknownOption = String -> IO ()
warnLn (String -> IO ()) -> ShowS -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
forall r. PrintfType r => String -> r
Printf.printf String
"WARNING: unknown option `%s'"
printProblems :: [String] -> IO ()
printProblems :: [String] -> IO ()
printProblems = (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
printProblem
printProblem :: String -> IO ()
printProblem :: String -> IO ()
printProblem = String -> IO ()
warn (String -> IO ()) -> ShowS -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
forall r. PrintfType r => String -> r
Printf.printf String
"ERROR: %s"
printHelp :: String -> IO ()
printHelp :: String -> IO ()
printHelp = String -> IO ()
warn (String -> IO ()) -> ShowS -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
help
help :: String -> String
help :: ShowS
help String
name = String -> [OptDescr Update] -> String
forall a. String -> [OptDescr a] -> String
Console.usageInfo (ShowS
header String
name) [OptDescr Update]
options
header :: String -> String
String
name = [String] -> String
unwords [String
name, String
"version", String
version]
version :: String
version :: String
version = Version -> String
Version.showVersion Version
This.version
printVersion :: IO ()
printVersion :: IO ()
printVersion = String -> IO ()
warnLn String
version
warn :: String -> IO ()
warn :: String -> IO ()
warn = Handle -> String -> IO ()
IO.hPutStr Handle
IO.stderr
warnLn :: String -> IO ()
warnLn :: String -> IO ()
warnLn = Handle -> String -> IO ()
IO.hPutStrLn Handle
IO.stderr