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

main :: IO ()
main = do
  args <- getArgs
  for_ args $ \str -> do
    Main.lex str pPrint parseMod =<< Lbs.readFile str

testParse :: String -> IO ()
testParse s = Main.lex "<interactive>" print 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
  case x of
    Left e -> showParseError e
    Right x -> show x

showParseError :: ParseError -> IO ()
showParseError pe = do
  code <- lines <$> readFile (parseErrorFilename pe)
  color <- fmap (1 ==) . c_isatty . fdFD =<< handleToFd GHC.IO.Handle.FD.stdout

  let
    linum    = posnLine (parseErrorBegin pe)
    startcol = posnColm (parseErrorBegin pe)

    multiline = linum /= posnLine (parseErrorEnd pe)

    width
      | multiline = 0
      | otherwise = max 0 (posnColm (parseErrorEnd pe) - startcol - 1)

    linum' = show linum

    line = [ show linum ++ sep ++ code !! (linum - 1) | linum <- [ linum .. posnLine (parseErrorEnd pe) ] ]

    padding = replicate (length linum') ' ' ++ sep
    padding' = replicate (length linum') ' ' ++ "   "

    caret = replicate (startcol - 1) ' ' ++ red ++ "^"
    squiggle = replicate width '~'

    (red, bold, reset, sep)
      | color     = ("\x1b[31m", "\x1b[1m", "\x1b[0m", "\x1b[1;34m \9474 \x1b[0m")
      | otherwise = ("", "", "", "")

  putStr . unlines $
    [ bold
      ++ parseErrorFilename pe
      ++ ":" ++ show linum ++ ":" ++ show startcol ++ ": "
      ++ red ++ "parse error:" ++ reset

    , padding'
    , init (unlines line)
    , padding' ++ caret ++ squiggle ++ reset ++ fromMaybe "" ((" " ++) <$> parseErrorInlineDesc pe)

    , ""
    , padding' ++ parseErrorMessage pe
    ]

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)