-- | GF main program (grammar compiler, interactive shell, http server)
{-# LANGUAGE CPP #-}
module GF.Main where
import GF.Compiler
import qualified GF.Interactive as GFI1
#ifdef C_RUNTIME
import qualified GF.Interactive2 as GFI2
#endif
import GF.Data.ErrM
import GF.Infra.Option
import GF.Infra.UseIO
import GF.Infra.BuildInfo (buildInfo)
import Paths_gf

import Data.Version
import System.Directory
import System.Environment (getArgs)
import System.Exit
-- import GF.System.Console (setConsoleEncoding)

-- | Run the GF main program, taking arguments from the command line.
-- (It calls 'setConsoleEncoding' and 'getOptions', then 'mainOpts'.)
-- Run @gf --help@ for usage info.
main :: IO ()
main :: IO ()
main = do
  -- setConsoleEncoding
  (Options -> [FilePath] -> IO ()) -> (Options, [FilePath]) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Options -> [FilePath] -> IO ()
mainOpts ((Options, [FilePath]) -> IO ())
-> IO (Options, [FilePath]) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Options, [FilePath])
getOptions

-- | Get and parse GF command line arguments. Fix relative paths.
-- Calls 'getArgs' and 'parseOptions'.
getOptions :: IO (Options, [FilePath])
getOptions :: IO (Options, [FilePath])
getOptions = do
  [FilePath]
args <- IO [FilePath]
getArgs
  case [FilePath] -> Err (Options, [FilePath])
forall (err :: * -> *).
ErrorMonad err =>
[FilePath] -> err (Options, [FilePath])
parseOptions [FilePath]
args of
    Ok (Options
opts,[FilePath]
files) -> do FilePath
curr_dir <- IO FilePath
getCurrentDirectory
                          [FilePath]
lib_dir  <- Options -> IO [FilePath]
forall (io :: * -> *). MonadIO io => Options -> io [FilePath]
getLibraryDirectory Options
opts
                          (Options, [FilePath]) -> IO (Options, [FilePath])
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> [FilePath] -> Options -> Options
fixRelativeLibPaths FilePath
curr_dir [FilePath]
lib_dir Options
opts, [FilePath]
files)
    Bad FilePath
err         -> do FilePath -> IO ()
forall (m :: * -> *). Output m => FilePath -> m ()
ePutStrLn FilePath
err
                          FilePath -> IO ()
forall (m :: * -> *). Output m => FilePath -> m ()
ePutStrLn FilePath
"You may want to try --help."
                          IO (Options, [FilePath])
forall a. IO a
exitFailure


-- | Run the GF main program with the given options and files. Depending on
-- the options it invokes 'mainGFC', 'mainGFI', 'mainRunGFI', 'mainServerGFI',
-- or it just prints version/usage info.
mainOpts :: Options -> [FilePath] -> IO ()
mainOpts :: Options -> [FilePath] -> IO ()
mainOpts Options
opts [FilePath]
files =
    case (Flags -> Mode) -> Options -> Mode
forall a. (Flags -> a) -> Options -> a
flag Flags -> Mode
optMode Options
opts of
      Mode
ModeVersion     -> FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Grammatical Framework (GF) version " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Version -> FilePath
showVersion Version
version FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
buildInfo
      Mode
ModeHelp        -> FilePath -> IO ()
putStrLn FilePath
helpMessage
      ModeServer Int
port -> Options -> Int -> [FilePath] -> IO ()
GFI1.mainServerGFI Options
opts Int
port [FilePath]
files
      Mode
ModeCompiler    -> Options -> [FilePath] -> IO ()
mainGFC Options
opts [FilePath]
files
      Mode
ModeInteractive -> Options -> [FilePath] -> IO ()
GFI1.mainGFI Options
opts [FilePath]
files
      Mode
ModeRun         -> Options -> [FilePath] -> IO ()
GFI1.mainRunGFI Options
opts [FilePath]
files
#ifdef C_RUNTIME
      ModeInteractive2 -> GFI2.mainGFI opts files
      ModeRun2         -> GFI2.mainRunGFI opts files
#else
      Mode
ModeInteractive2 -> IO ()
forall a. IO a
noCruntime
      Mode
ModeRun2         -> IO ()
forall a. IO a
noCruntime
  where
    noCruntime :: IO b
noCruntime = do FilePath -> IO ()
forall (m :: * -> *). Output m => FilePath -> m ()
ePutStrLn FilePath
"GF configured without C run-time support"
                    IO b
forall a. IO a
exitFailure
#endif