You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
99 lines
3.1 KiB
99 lines
3.1 KiB
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]
|