{-# LANGUAGE BangPatterns      #-}
{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE Safe              #-}

-- |
-- Copyright: © Herbert Valerio Riedel 2015-2018
-- SPDX-License-Identifier: GPL-2.0-or-later
--
module Data.YAML.Pos
    ( Pos(..)
    , prettyPosWithSource
    ) where

import qualified Data.ByteString.Lazy     as BL
import qualified Data.YAML.Token.Encoding as Enc
import           Util

-- | Position in parsed YAML source
--
-- See also 'prettyPosWithSource'.
--
-- __NOTE__: if 'posCharOffset' is negative the 'Pos' value doesn't refer to a proper location; this may be emitted in corner cases when no proper location can be inferred.
data Pos = Pos
    { Pos -> Int
posByteOffset :: !Int -- ^ 0-based byte offset
    , Pos -> Int
posCharOffset :: !Int -- ^ 0-based character (Unicode code-point) offset
    , Pos -> Int
posLine       :: !Int -- ^ 1-based line number
    , Pos -> Int
posColumn     :: !Int -- ^ 0-based character (Unicode code-point) column number
    } deriving (Pos -> Pos -> Bool
(Pos -> Pos -> Bool) -> (Pos -> Pos -> Bool) -> Eq Pos
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pos -> Pos -> Bool
$c/= :: Pos -> Pos -> Bool
== :: Pos -> Pos -> Bool
$c== :: Pos -> Pos -> Bool
Eq, Int -> Pos -> ShowS
[Pos] -> ShowS
Pos -> String
(Int -> Pos -> ShowS)
-> (Pos -> String) -> ([Pos] -> ShowS) -> Show Pos
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pos] -> ShowS
$cshowList :: [Pos] -> ShowS
show :: Pos -> String
$cshow :: Pos -> String
showsPrec :: Int -> Pos -> ShowS
$cshowsPrec :: Int -> Pos -> ShowS
Show, (forall x. Pos -> Rep Pos x)
-> (forall x. Rep Pos x -> Pos) -> Generic Pos
forall x. Rep Pos x -> Pos
forall x. Pos -> Rep Pos x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Pos x -> Pos
$cfrom :: forall x. Pos -> Rep Pos x
Generic)

-- | @since 0.2.0
instance NFData Pos where rnf :: Pos -> ()
rnf !Pos
_ = ()

-- | Pretty prints a 'Pos' together with the line the 'Pos' refers and the column position.
--
-- The input 'BL.ByteString' must be the same that was passed to the
-- YAML decoding function that produced the 'Pos' value. The 'String'
-- argument is inserted right after the @<line>:<column>:@ in the
-- first line. The pretty-printed position result 'String' will be
-- terminated by a trailing newline.
--
-- For instance,
--
-- @
-- 'prettyPosWithSource' somePos someInput " error" ++ "unexpected character\\n"
-- @ results in
--
-- > 11:7: error
-- >     |
-- >  11 | foo: | bar
-- >     |        ^
-- > unexpected character
--
-- @since 0.2.1
prettyPosWithSource :: Pos -> BL.ByteString -> String -> String
prettyPosWithSource :: Pos -> ByteString -> ShowS
prettyPosWithSource Pos{Int
posColumn :: Int
posLine :: Int
posCharOffset :: Int
posByteOffset :: Int
posColumn :: Pos -> Int
posLine :: Pos -> Int
posCharOffset :: Pos -> Int
posByteOffset :: Pos -> Int
..} ByteString
source String
msg
  | Int
posCharOffset Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
posByteOffset Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = String
"0:0:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n" -- unproper location
  | Bool
otherwise = [String] -> String
unlines
    [ Int -> String
forall a. Show a => a -> String
show Int
posLine String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
posColumn String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg
    , String
lpfx
    , String
lnostr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"| " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
line
    , String
lpfx String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
posColumn Char
' ' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"^"
    ]

  where
    lnostr :: String
lnostr = String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
posLine String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" "
    lpfx :: String
lpfx   = (Char
' ' Char -> ShowS
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String
lnostr) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"| "

    (Int
_,[(Int, Char)]
lstart) = Int -> ByteString -> (Int, [(Int, Char)])
findLineStartByByteOffset Int
posByteOffset ByteString
source
    line :: String
line = ((Int, Char) -> Char) -> [(Int, Char)] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Int, Char) -> Char
forall a b. (a, b) -> b
snd ([(Int, Char)] -> String) -> [(Int, Char)] -> String
forall a b. (a -> b) -> a -> b
$ ((Int, Char) -> Bool) -> [(Int, Char)] -> [(Int, Char)]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> ((Int, Char) -> Bool) -> (Int, Char) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isNL (Char -> Bool) -> ((Int, Char) -> Char) -> (Int, Char) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Char) -> Char
forall a b. (a, b) -> b
snd) [(Int, Char)]
lstart

    isNL :: Char -> Bool
isNL Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\r' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n'

findLineStartByByteOffset :: Int -> BL.ByteString -> (Int,[(Int,Char)])
findLineStartByByteOffset :: Int -> ByteString -> (Int, [(Int, Char)])
findLineStartByByteOffset Int
bofs0 ByteString
input = Int -> [(Int, Char)] -> [(Int, Char)] -> (Int, [(Int, Char)])
go Int
0 [(Int, Char)]
inputChars [(Int, Char)]
inputChars
  where
    (Encoding
_,[(Int, Char)]
inputChars) = ByteString -> (Encoding, [(Int, Char)])
Enc.decode ByteString
input

    go :: Int -> [(Int, Char)] -> [(Int, Char)] -> (Int, [(Int, Char)])
go Int
lsOfs [(Int, Char)]
lsChars [] = (Int
lsOfs,[(Int, Char)]
lsChars)
    go Int
lsOfs [(Int, Char)]
lsChars ((Int
ofs',Char
_):[(Int, Char)]
_)
      | Int
bofs0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ofs' = (Int
lsOfs,[(Int, Char)]
lsChars)

    go Int
_ [(Int, Char)]
_ ((Int
_,Char
'\r'):(Int
ofs',Char
'\n'):[(Int, Char)]
rest) = Int -> [(Int, Char)] -> [(Int, Char)] -> (Int, [(Int, Char)])
go Int
ofs' [(Int, Char)]
rest [(Int, Char)]
rest
    go Int
_ [(Int, Char)]
_ ((Int
ofs',Char
'\r'):[(Int, Char)]
rest) = Int -> [(Int, Char)] -> [(Int, Char)] -> (Int, [(Int, Char)])
go Int
ofs' [(Int, Char)]
rest [(Int, Char)]
rest
    go Int
_ [(Int, Char)]
_ ((Int
ofs',Char
'\n'):[(Int, Char)]
rest) = Int -> [(Int, Char)] -> [(Int, Char)] -> (Int, [(Int, Char)])
go Int
ofs' [(Int, Char)]
rest [(Int, Char)]
rest
    go Int
lsOfs [(Int, Char)]
lsChars ((Int, Char)
_:[(Int, Char)]
rest) = Int -> [(Int, Char)] -> [(Int, Char)] -> (Int, [(Int, Char)])
go Int
lsOfs [(Int, Char)]
lsChars [(Int, Char)]
rest