-- {-# LANGUAGE BlockArguments #-} module Main where import Control.Monad ( unless ) import qualified Data.ByteString.Lazy as Lbs import qualified Data.Text.Encoding as T import qualified Data.Text as T import Data.Foldable import Debug.Trace import Frontend.Autogen.Parser import Frontend.Autogen.Lexer import Frontend.Lexer.Wrapper import Frontend.Lexer.Tokens import System.Environment (getArgs) import Text.Show.Pretty (pPrint) import Frontend.Parser.Posn import System.Posix.Internals import GHC.IO.Handle.FD (stdout, handleToFd) import GHC.IO.FD import Data.Maybe (fromMaybe) import Errors main :: IO () main = do args <- getArgs for_ args $ \str -> do Main.lex str (\_ -> putStrLn $ str ++ " parsed!") parseMod =<< Lbs.readFile str testParse :: String -> IO () testParse s = Main.lex "" pPrint parseMod (Lbs.fromStrict (T.encodeUtf8 (T.pack s))) testLex :: String -> IO () testLex s = Main.lex "" (const (pure ())) (scan []) (Lbs.fromStrict (T.encodeUtf8 (T.pack s))) lex :: String -> (a -> IO ()) -> Alex a -> Lbs.ByteString -> IO () lex fname show cont arg = do let x = runAlex fname arg cont color <- fmap (1 ==) . c_isatty . fdFD =<< handleToFd GHC.IO.Handle.FD.stdout code <- if fname == "" then pure . lines $ T.unpack (T.decodeUtf8 (Lbs.toStrict arg)) else lines <$> readFile fname case x of Left e -> putStr $ showAhcError color code e Right x -> show x scan :: [Token] -> Alex [Token] scan acc = do tok <- alexMonadScan sc <- alexGetStartCode state <- getUserState traceM . unlines $ [ "----------------" , "just lexed: " ++ show tok , "sc: " ++ show sc , "sc stack: " ++ show (startCodes state) , "layout stack: " ++ show (layoutColumns state) ] case tokenClass tok of TokEof -> pure (reverse acc) _ -> scan (tok:acc)