{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE ViewPatterns #-}
module Xeno.Errors(printExceptions
,displayException
,getStartIndex
,failHere
) where
import Data.Semigroup((<>))
import qualified Data.ByteString.Char8 as BS hiding (elem)
import Data.ByteString.Internal(ByteString(..))
import System.IO(stderr)
import Xeno.Types
{-# NOINLINE failHere #-}
failHere :: BS.ByteString -> BS.ByteString -> Either XenoException a
failHere msg here = Left $ XenoParseError (getStartIndex here) msg
printExceptions :: BS.ByteString -> [XenoException] -> IO ()
printExceptions i s = (BS.hPutStrLn stderr . displayException i) `mapM_` s
lineNo :: Int -> BS.ByteString -> Int
lineNo index bs = BS.count '\n'
$ BS.take index bs
bshow :: Show a => a -> BS.ByteString
bshow = BS.pack . show
{-# INLINE CONLIKE getStartIndex #-}
getStartIndex :: BS.ByteString -> Int
getStartIndex (PS _ from _) = from
displayException :: BS.ByteString -> XenoException -> BS.ByteString
displayException input (XenoParseError i msg) =
"Parse error in line " <> bshow (lineNo i input) <> ": "
<> msg
<> " at:\n"
<> lineContentBeforeError
<> lineContentAfterError
<> "\n" <> pointer
where
lineContentBeforeError = snd $ BS.spanEnd eoln $ revTake 40 $ BS.take i input
lineContentAfterError = BS.takeWhile eoln $ BS.take 40 $ BS.drop i input
pointer = BS.replicate (BS.length lineContentBeforeError) ' ' <> "^"
eoln ch = ch /= '\n' && ch /= '\r'
displayException _ err = bshow err
revTake :: Int -> BS.ByteString -> BS.ByteString
revTake i (PS ptr from to) = PS ptr (end-len) len
where
end = from + to
len = min to i