-
Notifications
You must be signed in to change notification settings - Fork 1
/
Main.hs
70 lines (64 loc) · 1.75 KB
/
Main.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
module Main where
import Data.Bifunctor (bimap)
import qualified Data.Map as Map
import qualified Data.Text.IO as Text
import Inferno.Core (Interpreter (..), mkInferno)
import Inferno.Module.Prelude (builtinModules)
import Inferno.Types.VersionControl (pinnedToMaybe)
import Inferno.Utils.Prettyprinter (showPretty)
import Options.Applicative
( Parser,
argument,
execParser,
fullDesc,
header,
help,
helper,
info,
long,
metavar,
progDesc,
short,
str,
switch,
(<**>),
)
import System.Exit (exitFailure)
import System.IO (hPrint, stderr)
data CliArgs = CliArgs {file :: String, typecheck :: Bool}
cliargs :: Parser CliArgs
cliargs =
CliArgs
<$> argument str (metavar "FILE" <> help "Input file path")
<*> switch (long "typecheck" <> short 't' <> help "Only run type inference")
main :: IO ()
main = do
let opts =
info
(cliargs <**> helper)
( fullDesc
<> progDesc "Run Inferno on FILE"
<> header "inferno - a functional scripting language"
)
args <- execParser opts
src <- Text.readFile $ file args
Interpreter {evalExpr, defaultEnv, parseAndInfer} <-
mkInferno builtinModules [] :: IO (Interpreter IO ())
case parseAndInfer src of
Left err -> do
hPrint stderr err
exitFailure
Right (ast, ty, _, _) -> do
if typecheck args
then do
putStrLn "Inferred type:"
showPretty ty
else do
let ast' = bimap pinnedToMaybe (const ()) ast
evalExpr defaultEnv Map.empty ast' >>= \case
Left err -> do
hPrint stderr err
exitFailure
Right res -> showPretty res