-- |
-- Module      : Jikka.Main
-- Description : is the entry point of the @jikka@ command. / @jikka@ コマンドのエントリポイントです。
-- Copyright   : (c) Kimiyuki Onaka, 2021
-- License     : Apache License 2.0
-- Maintainer  : kimiyuki95@gmail.com
-- Stability   : experimental
-- Portability : portable
module Jikka.Main where

import Data.Maybe (fromMaybe)
import qualified Data.Text.IO as T
import Data.Version (showVersion)
import Jikka.Common.Error
import Jikka.Common.Format.Error (hPrintError, hPrintErrorWithText)
import qualified Jikka.Main.Subcommand.Convert as Convert
import qualified Jikka.Main.Subcommand.Debug as Debug
import qualified Jikka.Main.Subcommand.Execute as Execute
import Jikka.Main.Target
import Paths_Jikka (version)
import System.Console.GetOpt
import System.Exit (ExitCode (..))
import System.IO (hPutStr, stderr)

data Flag
  = Help
  | Verbose
  | Version
  | Target String
  deriving (Flag -> Flag -> Bool
(Flag -> Flag -> Bool) -> (Flag -> Flag -> Bool) -> Eq Flag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Flag -> Flag -> Bool
$c/= :: Flag -> Flag -> Bool
== :: Flag -> Flag -> Bool
$c== :: Flag -> Flag -> Bool
Eq, Eq Flag
Eq Flag
-> (Flag -> Flag -> Ordering)
-> (Flag -> Flag -> Bool)
-> (Flag -> Flag -> Bool)
-> (Flag -> Flag -> Bool)
-> (Flag -> Flag -> Bool)
-> (Flag -> Flag -> Flag)
-> (Flag -> Flag -> Flag)
-> Ord Flag
Flag -> Flag -> Bool
Flag -> Flag -> Ordering
Flag -> Flag -> Flag
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Flag -> Flag -> Flag
$cmin :: Flag -> Flag -> Flag
max :: Flag -> Flag -> Flag
$cmax :: Flag -> Flag -> Flag
>= :: Flag -> Flag -> Bool
$c>= :: Flag -> Flag -> Bool
> :: Flag -> Flag -> Bool
$c> :: Flag -> Flag -> Bool
<= :: Flag -> Flag -> Bool
$c<= :: Flag -> Flag -> Bool
< :: Flag -> Flag -> Bool
$c< :: Flag -> Flag -> Bool
compare :: Flag -> Flag -> Ordering
$ccompare :: Flag -> Flag -> Ordering
$cp1Ord :: Eq Flag
Ord, Int -> Flag -> ShowS
[Flag] -> ShowS
Flag -> String
(Int -> Flag -> ShowS)
-> (Flag -> String) -> ([Flag] -> ShowS) -> Show Flag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Flag] -> ShowS
$cshowList :: [Flag] -> ShowS
show :: Flag -> String
$cshow :: Flag -> String
showsPrec :: Int -> Flag -> ShowS
$cshowsPrec :: Int -> Flag -> ShowS
Show, ReadPrec [Flag]
ReadPrec Flag
Int -> ReadS Flag
ReadS [Flag]
(Int -> ReadS Flag)
-> ReadS [Flag] -> ReadPrec Flag -> ReadPrec [Flag] -> Read Flag
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Flag]
$creadListPrec :: ReadPrec [Flag]
readPrec :: ReadPrec Flag
$creadPrec :: ReadPrec Flag
readList :: ReadS [Flag]
$creadList :: ReadS [Flag]
readsPrec :: Int -> ReadS Flag
$creadsPrec :: Int -> ReadS Flag
Read)

data Options = Options
  { Options -> Bool
verbose :: Bool,
    Options -> Maybe Target
target :: Maybe Target
  }
  deriving (Options -> Options -> Bool
(Options -> Options -> Bool)
-> (Options -> Options -> Bool) -> Eq Options
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Options -> Options -> Bool
$c/= :: Options -> Options -> Bool
== :: Options -> Options -> Bool
$c== :: Options -> Options -> Bool
Eq, Eq Options
Eq Options
-> (Options -> Options -> Ordering)
-> (Options -> Options -> Bool)
-> (Options -> Options -> Bool)
-> (Options -> Options -> Bool)
-> (Options -> Options -> Bool)
-> (Options -> Options -> Options)
-> (Options -> Options -> Options)
-> Ord Options
Options -> Options -> Bool
Options -> Options -> Ordering
Options -> Options -> Options
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Options -> Options -> Options
$cmin :: Options -> Options -> Options
max :: Options -> Options -> Options
$cmax :: Options -> Options -> Options
>= :: Options -> Options -> Bool
$c>= :: Options -> Options -> Bool
> :: Options -> Options -> Bool
$c> :: Options -> Options -> Bool
<= :: Options -> Options -> Bool
$c<= :: Options -> Options -> Bool
< :: Options -> Options -> Bool
$c< :: Options -> Options -> Bool
compare :: Options -> Options -> Ordering
$ccompare :: Options -> Options -> Ordering
$cp1Ord :: Eq Options
Ord, Int -> Options -> ShowS
[Options] -> ShowS
Options -> String
(Int -> Options -> ShowS)
-> (Options -> String) -> ([Options] -> ShowS) -> Show Options
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Options] -> ShowS
$cshowList :: [Options] -> ShowS
show :: Options -> String
$cshow :: Options -> String
showsPrec :: Int -> Options -> ShowS
$cshowsPrec :: Int -> Options -> ShowS
Show, ReadPrec [Options]
ReadPrec Options
Int -> ReadS Options
ReadS [Options]
(Int -> ReadS Options)
-> ReadS [Options]
-> ReadPrec Options
-> ReadPrec [Options]
-> Read Options
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Options]
$creadListPrec :: ReadPrec [Options]
readPrec :: ReadPrec Options
$creadPrec :: ReadPrec Options
readList :: ReadS [Options]
$creadList :: ReadS [Options]
readsPrec :: Int -> ReadS Options
$creadsPrec :: Int -> ReadS Options
Read)

defaultOptions :: Options
defaultOptions :: Options
defaultOptions =
  Options :: Bool -> Maybe Target -> Options
Options
    { verbose :: Bool
verbose = Bool
False,
      target :: Maybe Target
target = Maybe Target
forall a. Maybe a
Nothing
    }

header :: String -> String
header :: ShowS
header String
progName = String
"Usage: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
progName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" [convert | debug | execute] FILE"

options :: [OptDescr Flag]
options :: [OptDescr Flag]
options =
  [ String -> [String] -> ArgDescr Flag -> String -> OptDescr Flag
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [Char
'h', Char
'?'] [String
"help"] (Flag -> ArgDescr Flag
forall a. a -> ArgDescr a
NoArg Flag
Help) String
"",
    String -> [String] -> ArgDescr Flag -> String -> OptDescr Flag
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [Char
'v'] [String
"verbose"] (Flag -> ArgDescr Flag
forall a. a -> ArgDescr a
NoArg Flag
Verbose) String
"",
    String -> [String] -> ArgDescr Flag -> String -> OptDescr Flag
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"version"] (Flag -> ArgDescr Flag
forall a. a -> ArgDescr a
NoArg Flag
Version) String
"",
    String -> [String] -> ArgDescr Flag -> String -> OptDescr Flag
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"target"] ((String -> Flag) -> String -> ArgDescr Flag
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Flag
Target String
"TARGET") String
"\"python\", \"rpython\", \"core\" or \"cxx\""
  ]

main :: String -> [String] -> IO ExitCode
main :: String -> [String] -> IO ExitCode
main String
name [String]
args = do
  let usage :: String
usage = String -> [OptDescr Flag] -> String
forall a. String -> [OptDescr a] -> String
usageInfo (ShowS
header String
name) [OptDescr Flag]
options
  case ArgOrder Flag
-> [OptDescr Flag] -> [String] -> ([Flag], [String], [String])
forall a.
ArgOrder a -> [OptDescr a] -> [String] -> ([a], [String], [String])
getOpt ArgOrder Flag
forall a. ArgOrder a
Permute [OptDescr Flag]
options [String]
args of
    ([Flag]
parsed, [String]
_, []) | Flag
Help Flag -> [Flag] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Flag]
parsed -> do
      String -> IO ()
putStr String
usage
      ExitCode -> IO ExitCode
forall (m :: * -> *) a. Monad m => a -> m a
return ExitCode
ExitSuccess
    ([Flag]
parsed, [String]
_, []) | Flag
Version Flag -> [Flag] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Flag]
parsed -> do
      String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Version -> String
showVersion Version
version
      ExitCode -> IO ExitCode
forall (m :: * -> *) a. Monad m => a -> m a
return ExitCode
ExitSuccess
    ([Flag]
parsed, [String
subcmd, String
path], []) -> case String -> [Flag] -> Either Error Options
parseFlags String
name [Flag]
parsed of
      Left Error
err -> do
        Handle -> Error -> IO ()
hPrintError Handle
stderr Error
err
        ExitCode -> IO ExitCode
forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode -> IO ExitCode) -> ExitCode -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
1
      Right Options
opts -> do
        Either Error ()
result <- ExceptT Error IO () -> IO (Either Error ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Error IO () -> IO (Either Error ()))
-> ExceptT Error IO () -> IO (Either Error ())
forall a b. (a -> b) -> a -> b
$ String -> Options -> String -> ExceptT Error IO ()
runSubcommand String
subcmd Options
opts String
path
        case Either Error ()
result of
          Left Error
err -> do
            Text
text <- IO Text -> IO Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> IO Text) -> IO Text -> IO Text
forall a b. (a -> b) -> a -> b
$ String -> IO Text
T.readFile String
path
            Handle -> Text -> Error -> IO ()
hPrintErrorWithText Handle
stderr Text
text Error
err
            ExitCode -> IO ExitCode
forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode -> IO ExitCode) -> ExitCode -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
1
          Right () -> do
            ExitCode -> IO ExitCode
forall (m :: * -> *) a. Monad m => a -> m a
return ExitCode
ExitSuccess
    ([Flag]
_, [String]
_, [String]
errors) | [String]
errors [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
/= [] -> do
      [String] -> (String -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [String]
errors ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \String
msg -> do
        let err :: Error
err = ErrorGroup -> Error -> Error
WithGroup ErrorGroup
CommandLineError (String -> Error
Error String
msg)
        Handle -> Error -> IO ()
hPrintError Handle
stderr Error
err
      ExitCode -> IO ExitCode
forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode -> IO ExitCode) -> ExitCode -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
1
    ([Flag], [String], [String])
_ -> do
      Handle -> String -> IO ()
hPutStr Handle
stderr String
usage
      ExitCode -> IO ExitCode
forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode -> IO ExitCode) -> ExitCode -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
1

parseFlags :: String -> [Flag] -> Either Error Options
parseFlags :: String -> [Flag] -> Either Error Options
parseFlags String
_ = Options -> [Flag] -> Either Error Options
go Options
defaultOptions
  where
    go :: Options -> [Flag] -> Either Error Options
    go :: Options -> [Flag] -> Either Error Options
go Options
opts [] = Options -> Either Error Options
forall a b. b -> Either a b
Right Options
opts
    go Options
opts (Flag
flag : [Flag]
flags) = case Flag
flag of
      Flag
Help -> String -> Either Error Options
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwCommandLineError String
"parseFlags is not called when --help is specified"
      Flag
Version -> String -> Either Error Options
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwCommandLineError String
"parseFlags is not called when --version is specified"
      Flag
Verbose -> Options -> [Flag] -> Either Error Options
go (Options
opts {verbose :: Bool
verbose = Bool
True}) [Flag]
flags
      Target String
target -> do
        Target
target <- String -> Either Error Target
parseTarget String
target
        Options -> [Flag] -> Either Error Options
go (Options
opts {target :: Maybe Target
target = Target -> Maybe Target
forall a. a -> Maybe a
Just Target
target}) [Flag]
flags

runSubcommand :: String -> Options -> FilePath -> ExceptT Error IO ()
runSubcommand :: String -> Options -> String -> ExceptT Error IO ()
runSubcommand String
subcmd Options
opts String
path = case String
subcmd of
  String
"convert" -> do
    Text
input <- IO Text -> ExceptT Error IO Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> ExceptT Error IO Text)
-> IO Text -> ExceptT Error IO Text
forall a b. (a -> b) -> a -> b
$ String -> IO Text
T.readFile String
path
    Text
output <- Either Error Text -> ExceptT Error IO Text
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either Error Text -> ExceptT Error IO Text)
-> Either Error Text -> ExceptT Error IO Text
forall a b. (a -> b) -> a -> b
$ Target -> String -> Text -> Either Error Text
Convert.run (Target -> Maybe Target -> Target
forall a. a -> Maybe a -> a
fromMaybe Target
CPlusPlusTarget (Options -> Maybe Target
target Options
opts)) String
path Text
input
    IO () -> ExceptT Error IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT Error IO ()) -> IO () -> ExceptT Error IO ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
T.putStr Text
output
  String
"debug" -> String -> ExceptT Error IO ()
Debug.run String
path
  String
"execute" -> Target -> String -> ExceptT Error IO ()
Execute.run (Target -> Maybe Target -> Target
forall a. a -> Maybe a -> a
fromMaybe Target
CoreTarget (Options -> Maybe Target
target Options
opts)) String
path
  String
_ -> String -> ExceptT Error IO ()
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwCommandLineError (String -> ExceptT Error IO ()) -> String -> ExceptT Error IO ()
forall a b. (a -> b) -> a -> b
$ String
"undefined subcommand: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
subcmd