{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Strict            #-}
{-# LANGUAGE ViewPatterns      #-}
{-# LANGUAGE CPP               #-}
-- | Simplifies raising and presenting localized exceptions to the user.
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 :: forall a. ByteString -> ByteString -> Either XenoException a
failHere ByteString
msg ByteString
here = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> XenoException
XenoParseError (ByteString -> Int
getStartIndex ByteString
here) ByteString
msg

-- | Print schema errors with excerpts
printExceptions :: BS.ByteString -> [XenoException] -> IO ()
printExceptions :: ByteString -> [XenoException] -> IO ()
printExceptions ByteString
i [XenoException]
s = (Handle -> ByteString -> IO ()
BS.hPutStrLn Handle
stderr forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> XenoException -> ByteString
displayException ByteString
i) forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
`mapM_` [XenoException]
s

-- | Find line number of the error from ByteString index.
lineNo :: Int -> BS.ByteString -> Int
lineNo :: Int -> ByteString -> Int
lineNo Int
index ByteString
bs = Char -> ByteString -> Int
BS.count Char
'\n'
                forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take Int
index ByteString
bs

-- | Show for ByteStrings
bshow :: Show a => a -> BS.ByteString
bshow :: forall a. Show a => a -> ByteString
bshow = String -> ByteString
BS.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show

{-# INLINE CONLIKE getStartIndex #-}
-- FIXME remove this; there's no offset in the bytestring.
getStartIndex :: BS.ByteString -> Int
getStartIndex :: ByteString -> Int
getStartIndex (PS ForeignPtr Word8
_ Int
from Int
_) = Int
from

displayException :: BS.ByteString -> XenoException -> BS.ByteString
displayException :: ByteString -> XenoException -> ByteString
displayException ByteString
input (XenoParseError Int
i ByteString
msg) =
               ByteString
"Parse error in line " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> ByteString
bshow (Int -> ByteString -> Int
lineNo Int
i ByteString
input) forall a. Semigroup a => a -> a -> a
<> ByteString
": "
            forall a. Semigroup a => a -> a -> a
<> ByteString
msg
            forall a. Semigroup a => a -> a -> a
<> ByteString
" at:\n"
            forall a. Semigroup a => a -> a -> a
<> ByteString
lineContentBeforeError
            forall a. Semigroup a => a -> a -> a
<> ByteString
lineContentAfterError
            forall a. Semigroup a => a -> a -> a
<> ByteString
"\n" forall a. Semigroup a => a -> a -> a
<> ByteString
pointer
  where
    lineContentBeforeError :: ByteString
lineContentBeforeError = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS.spanEnd   Char -> Bool
eoln forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
revTake Int
40 forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take Int
i ByteString
input
    lineContentAfterError :: ByteString
lineContentAfterError  =       (Char -> Bool) -> ByteString -> ByteString
BS.takeWhile Char -> Bool
eoln forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take Int
40 forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop Int
i ByteString
input
    pointer :: ByteString
pointer                = Int -> Char -> ByteString
BS.replicate (ByteString -> Int
BS.length ByteString
lineContentBeforeError) Char
' ' forall a. Semigroup a => a -> a -> a
<> ByteString
"^"
    eoln :: Char -> Bool
eoln Char
ch                = Char
ch forall a. Eq a => a -> a -> Bool
/= Char
'\n' Bool -> Bool -> Bool
&& Char
ch forall a. Eq a => a -> a -> Bool
/= Char
'\r'
displayException ByteString
_      XenoException
err                        = forall a. Show a => a -> ByteString
bshow XenoException
err

-- | Take n last bytes.
revTake :: Int -> BS.ByteString -> BS.ByteString
revTake :: Int -> ByteString -> ByteString
revTake Int
i ByteString
bs =
    if Int
i forall a. Ord a => a -> a -> Bool
>= Int
len
    then ByteString
bs
    else Int -> ByteString -> ByteString
BS.drop (Int
len forall a. Num a => a -> a -> a
- Int
i) ByteString
bs
  where
    len :: Int
len = forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
bs)