| 26 | | main = mainWith run |
| 27 | | |
| 28 | | runFile :: String -> IO () |
| 29 | | runFile file = do |
| 30 | | withArgs [file] main |
| 31 | | |
| 32 | | -- see also Run/Args.hs |
| 33 | | run :: [String] -> IO () |
| 34 | | run (("-d"):rest) = run rest |
| 35 | | |
| 36 | | {- -l does not appear here anymore |
| 37 | | as it will have been replaced by an -e snippet further |
| 38 | | above . |
| 39 | | -- run (("-l"):rest) = run rest |
| 40 | | -} |
| 41 | | |
| 42 | | run (("-w"):rest) = run rest |
| 43 | | run (("-I"):_:rest) = run rest |
| 44 | | |
| 45 | | -- XXX should raise an error here: |
| 46 | | -- run ("-I":[]) = do |
| 47 | | -- print "Empty -I" |
| 48 | | |
| 49 | | run ("-h":_) = printCommandLineHelp |
| 50 | | run (("-V"):_) = printConfigInfo [] |
| 51 | | run (("-V:"):item:_) = printConfigInfo [item] |
| 52 | | run ("-v":_) = banner |
| 53 | | |
| 54 | | -- turn :file: and "-e":frag into a common subroutine/token |
| 55 | | run ("-c":"-e":prog:_) = doCheck "-e" prog |
| 56 | | run ("-c":file:_) = readFile file >>= doCheck file |
| 57 | | |
| 58 | | -- -CPerl5 outputs PIL formatted as Perl 5, PIL-Run is not involved. |
| 59 | | -- Should we rename -CPerl5, -CJSON etc. to -CPIL.Perl5, -CPIL.JSON etc.? |
| 60 | | run ("-C":backend:args) | map toUpper backend == "JS" = do |
| 61 | | exec <- getArg0 |
| 62 | | doHelperRun "JS" ("--compile-only":("--pugs="++exec):args) |
| 63 | | run ("-C":backend:"-e":prog:_) = doCompileDump backend "-e" prog |
| 64 | | run ("-C":backend:file:_) = slurpFile file >>= doCompileDump backend file |
| 65 | | |
| 66 | | run ("-B":backend:_) | (== map toLower backend) `any` ["js","perl5"] = do |
| 67 | | exec <- getArg0 |
| 68 | | args <- getArgs |
| 69 | | doHelperRun backend (("--pugs="++exec):args) |
| 70 | | run ("-B":backend:"-e":prog:_) = doCompileRun backend "-e" prog |
| 71 | | run ("-B":backend:file:_) = slurpFile file >>= doCompileRun backend file |
| 72 | | |
| 73 | | run ("--external":mod:"-e":prog:_) = doExternal mod "-e" prog |
| 74 | | run ("--external":mod:file:_) = readFile file >>= doExternal mod file |
| 75 | | |
| 76 | | run (("-e"):prog:args) = do doRun "-e" args prog |
| 77 | | -- -E is like -e, but not accessible as a normal parameter and used only |
| 78 | | -- internally: |
| 79 | | -- "-e foo bar.p6" executes "foo" with @*ARGS[0] eq "bar.p6", |
| 80 | | -- "-E foo bar.p6" executes "foo" and then bar.p6. |
| 81 | | -- XXX - Wrong -- Need to preserve environment across -E runs |
| 82 | | run (("-E"):prog:rest) = run ("-e":prog:[]) >> run rest |
| 83 | | run ("-":args) = do doRun "-" args =<< readStdin |
| 84 | | run (file:args) = readFile file >>= doRun file args |
| 85 | | run [] = do |
| 86 | | isTTY <- hIsTerminalDevice stdin |
| 87 | | if isTTY |
| 88 | | then do banner >> intro >> repLoop |
| 89 | | else run ["-"] |
| 90 | | |
| 91 | | readStdin :: IO String |
| 92 | | readStdin = do |
| 93 | | eof <- isEOF |
| 94 | | if eof then return [] else do |
| 95 | | ch <- getChar |
| 96 | | rest <- readStdin |
| 97 | | return (ch:rest) |
| 98 | | |
| 99 | | repLoop :: IO () |
| 100 | | repLoop = do |
| 101 | | initializeShell |
| 102 | | env <- liftSTM . newTVar . (\e -> e{ envDebug = Nothing }) =<< tabulaRasa "<interactive>" |
| 103 | | fix $ \loop -> do |
| 104 | | command <- getCommand |
| 105 | | case command of |
| 106 | | CmdQuit -> putStrLn "Leaving pugs." |
| 107 | | CmdLoad fn -> doLoad env fn >> loop |
| 108 | | CmdRun opts prog -> doRunSingle env opts prog >> loop |
| 109 | | CmdParse prog -> doParse pretty "<interactive>" prog >> loop |
| 110 | | CmdParseRaw prog -> doParse show "<interactive>" prog >> loop |
| 111 | | CmdHelp -> printInteractiveHelp >> loop |
| 112 | | CmdReset -> tabulaRasa "<interactive>" >>= (liftSTM . writeTVar env) >> loop |
| | 21 | main = pugsMain |
