    {-# 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 = XenoException -> Either XenoException a
    forall a b. a -> Either a b
    Left (XenoException -> Either XenoException a)
    -> XenoException -> Either XenoException a
    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 (ByteString -> IO ())
    -> (XenoException -> ByteString) -> XenoException -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> XenoException -> ByteString
    displayException ByteString
    i) (XenoException -> IO ()) -> [XenoException] -> IO ()
    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'
                    (ByteString -> Int) -> ByteString -> Int
    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 (String -> ByteString) -> (a -> String) -> a -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> String
    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 " ByteString -> ByteString -> ByteString
    forall a. Semigroup a => a -> a -> a
    <> Int -> ByteString
    forall a. Show a => a -> ByteString
    bshow (Int -> ByteString -> Int
    lineNo Int
    i ByteString
    input) ByteString -> ByteString -> ByteString
    forall a. Semigroup a => a -> a -> a
    <> ByteString
    ": "
                ByteString -> ByteString -> ByteString
    forall a. Semigroup a => a -> a -> a
    <> ByteString
    msg
                ByteString -> ByteString -> ByteString
    forall a. Semigroup a => a -> a -> a
    <> ByteString
    " at:\n"
                ByteString -> ByteString -> ByteString
    forall a. Semigroup a => a -> a -> a
    <> ByteString
    lineContentBeforeError
                ByteString -> ByteString -> ByteString
    forall a. Semigroup a => a -> a -> a
    <> ByteString
    lineContentAfterError
                ByteString -> ByteString -> ByteString
    forall a. Semigroup a => a -> a -> a
    <> ByteString
    "\n" ByteString -> ByteString -> ByteString
    forall a. Semigroup a => a -> a -> a
    <> ByteString
    pointer
      where
        lineContentBeforeError :: ByteString
    lineContentBeforeError = (ByteString, ByteString) -> ByteString
    forall a b. (a, b) -> b
    snd ((ByteString, ByteString) -> ByteString)
    -> (ByteString, ByteString) -> ByteString
    forall a b. (a -> b) -> a -> b
    $ (Char -> Bool) -> ByteString -> (ByteString, ByteString)
    BS.spanEnd   Char -> Bool
    eoln (ByteString -> (ByteString, ByteString))
    -> ByteString -> (ByteString, ByteString)
    forall a b. (a -> b) -> a -> b
    $ Int -> ByteString -> ByteString
    revTake Int
    40 (ByteString -> ByteString) -> ByteString -> ByteString
    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 (ByteString -> ByteString) -> ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Int -> ByteString -> ByteString
    BS.take Int
    40 (ByteString -> ByteString) -> ByteString -> ByteString
    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
    ' ' ByteString -> ByteString -> ByteString
    forall a. Semigroup a => a -> a -> a
    <> ByteString
    "^"
        eoln :: Char -> Bool
    eoln Char
    ch                = Char
    ch Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '\n' Bool -> Bool -> Bool
    && Char
    ch Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '\r'
    displayException ByteString
    _      XenoException
    err                        = XenoException -> ByteString
    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 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    len
        then ByteString
    bs
        else Int -> ByteString -> ByteString
    BS.drop (Int
    len Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    i) ByteString
    bs
      where
        len :: Int
    len = Int -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (ByteString -> Int
    BS.length ByteString
    bs)