module Errors where

import Frontend.Parser.Posn
import Data.Maybe
import qualified GHC.IO.Handle.FD
import System.Posix.Internals (c_isatty)
import GHC.IO.FD

data AhcError
  = AhcError { errorMessage    :: String
             , errorFilename   :: String
             , errorInlineDesc :: Maybe String
             , errorBegin      :: Posn
             , errorEnd        :: Posn
             , errorPointers   :: [ErrorPointer]
             }
  deriving (Eq, Show)

emptyError :: AhcError
emptyError =
  AhcError (error "parse errors must have a message")
           (error "parse errors must have a filename")
           Nothing
           (error "parse errors must have a start pos")
           (error "parse errors must have an end pos")
           []

data ErrorPointer
  = ErrorPointer { errorPointerBegin        :: Posn
                 , errorPointerEnd          :: Posn
                 , errorPointerNote         :: Maybe String
                 , errorPointerDrawSquiggle :: Bool
                 }
  deriving (Eq, Show)

showAhcError :: Bool -> [String] -> AhcError -> String
showAhcError color code pe = do
  unlines $
    [ bold
      ++ errorFilename pe
      ++ ":" ++ show linum ++ ":" ++ show startcol ++ ": "
      ++ red ++ "parse error:" ++ reset

    ] ++ map (render bold red sep reset) (mainPointer:errorPointers pe) ++
    [ padToMax "" ++ "   " ++ errorMessage pe
    ]
  where
    linum    = posnLine (errorBegin pe)
    startcol = posnColm (errorBegin pe)

    maxln = maximum [ length (show (posnLine e)) | e <- errorEnd pe:map errorPointerEnd (errorPointers pe)]

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

    padToMax x
      | length x < maxln = replicate (maxln - length x) ' ' ++ x
      | otherwise = x

    mainPointer = ErrorPointer (errorBegin pe) (errorEnd pe) (errorInlineDesc pe) True

    render bold red sep reset (ErrorPointer start end note squig) = do
      let
        linum    = posnLine start
        startcol = posnColm start

        multiline = linum /= posnLine end

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

        linum' = padToMax $ show linum

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

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

        caret = replicate (startcol - 1) ' ' ++ red ++ "^"
        squiggle
          | squig = replicate width '~'
          | otherwise = ""
        
      init $ unlines
        [ padding
        , init (unlines line)
        , padding ++ caret ++ squiggle ++ reset ++ fromMaybe "" ((" " ++) <$> note)
        ]

printParseError :: AhcError -> IO ()
printParseError pe = do
  code <- lines <$> readFile (errorFilename pe)
  color <- fmap (1 ==) . c_isatty . fdFD =<< GHC.IO.Handle.FD.handleToFd GHC.IO.Handle.FD.stdout
  putStr $ showAhcError color code pe

pointTo :: HasPosn x => x -> x -> String -> [ErrorPointer]
pointTo s e msg = [ErrorPointer (startPosn s) (endPosn e) (Just msg) False]