module main import StdFile import StdBool import StdMisc import StdFunc import StdTuple import StdList import StdString import Data.Either import Data.Maybe import Data.Func import System.CommandLine import GenPrint from Text import class Text(concat), instance Text String import parse import lex from yard import :: Error, instance toString Error :: Opts = { program :: String, lex :: Bool, parse :: Bool, fp :: Maybe String, help :: Bool} derive gPrint TokenValue Start :: *World -> *World Start w # (args, w) = parseArgs w | args.help # (out, w) = stdio w # out = out <<< "Usage: " <<< args.program <<< " [opts] [FILENAME]\n" <<< "\t--help Show this help\n" <<< "\t--[no-]lex Lexer output(default: disabled)\n" <<< "\t--[no-]parse Parser output(default: enabled)\n\n" <<< "\tFILENAME File to parse, when unspecified stdin is parsed\n" = snd $ fclose out w # (stdin, w) = stdio w # (contents, stdin, w) = readFileOrStdin stdin args.fp w = case contents of (Left cs) = snd $ fclose (stdin <<< cs) w (Right cs) # lexOut = lexer cs # stdin = if (not args.lex) stdin (case lexOut of (Right toks) = stdin <<< "---LEXER\n" <<< printTokens toks <<< "---LEXER\n" _ = stdin) # parseOut = parser lexOut # stdin = if (not args.parse) stdin (case parser lexOut of (Right ast) = stdin <<< "---PARSER\n" <<< toString ast <<< "---PARSER\n" (Left parse) = stdin <<< toString parse) = snd $ fclose stdin w where printTokens :: [Token] -> String printTokens ts = concat $ flatten $ map pt ts where pt {line,column,token} = [toString line, ":", toString column, ": ", printToString token, "\n"] parseArgs :: *World -> (Opts, *World) parseArgs w # ([p:args], w) = getCommandLine w = (pa args {program=p, lex=False, parse=True, fp=Nothing, help=False}, w) where pa :: [String] Opts -> Opts pa [] o = o pa ["--help":r] o = pa r {o & help=True} pa ["--lex":r] o = pa r {o & lex=True} pa ["--no-lex":r] o = pa r {o & lex=False} pa ["--parse":r] o = pa r {o & parse=True} pa ["--no-parse":r] o = pa r {o & parse=False} pa [x:r] o = pa r {o & fp=Just x} readFileOrStdin :: *File (Maybe String) *World -> *(Either String [Char], *File, *World) readFileOrStdin stdin Nothing w # (cs, stdin) = readEntireFile stdin = (Right cs, stdin, w) readFileOrStdin stdin (Just fp) w # (b, fin, w) = fopen fp FReadText w | not b = (Left "Unable to open file", stdin, w) # (cs, fin) = readEntireFile fin # (b, w) = fclose fin w | not b = (Left "Unable to close file", stdin, w) = (Right cs, stdin, w) readEntireFile :: *File -> *([Char], *File) readEntireFile f # (b, c, f) = freadc f | not b = ([], f) # (cs, f) = readEntireFile f = ([c:cs], f)