79 lines
2.3 KiB
Haskell
79 lines
2.3 KiB
Haskell
{-# LANGUAGE NamedFieldPuns #-}
|
|
module Main where
|
|
|
|
import qualified Compiler (main)
|
|
import Context (CodePath(..), Context (..), packages)
|
|
import Control.Applicative (many)
|
|
import Control.Monad.Except (runExceptT)
|
|
import Control.Monad.RWS (evalRWST)
|
|
import Data.Text (Text)
|
|
import qualified Data.Text as Text (unpack)
|
|
import Data.Version (showVersion)
|
|
import qualified Module (emptySpace)
|
|
import Options.Applicative (
|
|
Parser, execParser, fullDesc, info, header, help, helper, long, metavar
|
|
, short, strArgument, strOption, value
|
|
)
|
|
import qualified Paths_SJW as SJW (version)
|
|
import System.IO (stderr, hPutStrLn)
|
|
|
|
data Config = Config {
|
|
includes :: [String]
|
|
, mainIs :: String
|
|
, outputFile :: FilePath
|
|
, target :: FilePath
|
|
} deriving (Show)
|
|
|
|
configParser :: Parser Config
|
|
configParser = Config
|
|
<$> many (strOption (
|
|
long "include"
|
|
<> short 'I'
|
|
<> metavar "PACKAGE"
|
|
<> help "Include this package during compilation"
|
|
))
|
|
<*> strOption (
|
|
long "main-is"
|
|
<> short 'm'
|
|
<> metavar "MODULE_NAME"
|
|
<> help "The name of the main module containing the code to run"
|
|
<> value "Main"
|
|
)
|
|
<*> strOption (
|
|
long "output"
|
|
<> short 'o'
|
|
<> metavar "OUTPUT_PATH"
|
|
<> help "The path where to create the compiled script (stdout if \"-\" or if the option is missing)"
|
|
<> value "-"
|
|
)
|
|
<*> strArgument (
|
|
metavar "SOURCE_DIR"
|
|
<> help "The path where to look for the sources"
|
|
)
|
|
|
|
getConfig :: IO Config
|
|
getConfig = execParser $
|
|
info
|
|
(helper <*> configParser)
|
|
(fullDesc <> header ("SJW v" ++ showVersion SJW.version))
|
|
|
|
runCompiler :: Config -> IO (Either String (Text, [String]))
|
|
runCompiler (Config {includes, mainIs, target}) = do
|
|
codePaths <- CodePath . (target:) <$> packages includes
|
|
let initialContext = Context {codePaths, mainModule = read mainIs}
|
|
runExceptT $ evalRWST Compiler.main initialContext Module.emptySpace
|
|
|
|
main :: IO ()
|
|
main = do
|
|
config@(Config {outputFile}) <- getConfig
|
|
result <- runCompiler config
|
|
case result of
|
|
Left errorMessage -> printErr errorMessage
|
|
Right (sourceCode, logs) -> do
|
|
mapM_ printErr logs
|
|
output outputFile . Text.unpack $ sourceCode
|
|
where
|
|
printErr = hPutStrLn stderr
|
|
output "-" = putStr
|
|
output fileName = writeFile fileName
|