-- {-# 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)