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
header :: ShowS
header 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