amelia
/
ahc


-- {-# 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 "<interactive>" pPrint parseMod (Lbs.fromStrict (T.encodeUtf8 (T.pack s)))


testLex :: String -> IO ()

testLex s = Main.lex "<interactive>" (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 == "<interactive>"

 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)