amelia
/
ahc


-- {-# LANGUAGE BlockArguments #-}

module Main where


import Control.Exception


import qualified Data.Text.Lazy as Lt

import Data.Typeable


import Debug.Trace


import Development.Shake


import Errors


import Frontend.Autogen.Parser

import Frontend.Autogen.Lexer

import Frontend.Lexer.Wrapper

import Frontend.Lexer.Tokens


import GHC.IO.Handle.FD (stdout, handleToFd)

import GHC.IO.FD


import Main.Rules


import System.Environment (getArgs)

import System.Posix.Internals


import Text.Show.Pretty (pPrint)


main :: IO ()

main =

 do

 args <- getArgs

 print args

 shake opts (compilerRules args)

 `catch` \(ShakeException _ _ some) -> handle some

 where

 opts =

 shakeOptions { shakeFiles = ".ahc-cache"

 , shakeVerbosity = Verbose

 , shakeProgress = progressDisplay 0.01 putStrLn

 }

 handle (SomeException e) =

 case cast e of

 Just x -> printAhcError x

 Nothing -> throwIO e


testParse :: String -> IO ()

testParse s = Main.lex "<interactive>" pPrint parseMod (Lt.pack s)


testLex :: String -> IO ()

testLex s = Main.lex "<interactive>" (const (pure ())) (scan []) (Lt.pack s)


lex :: String -> (a -> IO ()) -> Alex a -> Lt.Text -> 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 $ Lt.unpack 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)