{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Main where

import Control.Exception

import qualified Data.ByteString.Lazy as Bsl
import qualified Data.Text.Encoding as T
import qualified Data.Map.Strict as Map
import qualified Data.Text.IO as T
import qualified Data.Text as T
import Data.Text ( Text )
import Data.Foldable

import Elab.Monad
import Elab.Eval
import Elab

import Presyntax.Presyntax (Posn(Posn))
import Presyntax.Parser
import Presyntax.Tokens
import Presyntax.Lexer

import System.Exit
import Syntax.Pretty

main :: IO ()
main = do
  t <- Bsl.readFile "test.tt"
  let Right tks = runAlex t parseProg
  env <- runElab (checkProgram tks) emptyEnv `catch` \e -> displayAndDie (T.decodeUtf8 (Bsl.toStrict t)) (e :: SomeException)
  for_ (Map.toList (getEnv env)) $ \(n, x) -> putStrLn $ show n ++ " : " ++ showValue (zonk (fst x))

displayAndDie :: Exception e => Text -> e -> IO a
displayAndDie lines e = do
  () <- throwIO e `catches` displayExceptions lines
  exitFailure

displayExceptions :: Text -> [Handler ()]
displayExceptions lines =
  [ Handler \(WhileChecking a b e) -> do
      T.putStrLn $ squiggleUnder a b lines
      displayExceptions' lines e
  , Handler \(NotEqual ta tb) -> do
      putStrLn . unlines $
        [ "\x1b[1;31merror\x1b[0m: Mismatch between actual and expected types:"
        , "  * \x1b[1mActual\x1b[0m:   " ++ showValue (zonk ta)
        , "  * \x1b[1mExpected\x1b[0m: " ++ showValue (zonk tb)
        ]
  ]

displayExceptions' :: Exception e => Text -> e -> IO ()
displayExceptions' lines e = displayAndDie lines e `catch` \(_ :: ExitCode) -> pure ()

squiggleUnder :: Posn -> Posn -> Text -> Text
squiggleUnder (Posn l c) (Posn l' c') file
  | l == l' =
    let
      line     = T.pack (show l) <> " | " <> T.lines file !! (l - 1)
      padding  = T.replicate (length (show l)) (T.singleton ' ') <> " |"
      squiggle = T.replicate c " " <> T.pack "\x1b[1;31m" <> T.replicate (c' - c) "~" <> T.pack "\x1b[0m"

     in T.unlines [ padding, line, padding <> squiggle ]
  | otherwise = T.pack (show (Posn l c, Posn l' c'))