{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE Safe #-}
module Data.YAML.Pos
( Pos(..)
, prettyPosWithSource
) where
import qualified Data.ByteString.Lazy as BL
import qualified Data.YAML.Token.Encoding as Enc
import Util
data Pos = Pos
{ posByteOffset :: !Int
, posCharOffset :: !Int
, posLine :: !Int
, posColumn :: !Int
} deriving (Eq, Show, Generic)
instance NFData Pos where rnf !_ = ()
prettyPosWithSource :: Pos -> BL.ByteString -> String -> String
prettyPosWithSource Pos{..} source msg
| posCharOffset < 0 || posByteOffset < 0 = "0:0:" ++ msg ++ "\n"
| otherwise = unlines
[ show posLine ++ ":" ++ show posColumn ++ ":" ++ msg
, lpfx
, lnostr ++ "| " ++ line
, lpfx ++ replicate posColumn ' ' ++ "^"
]
where
lnostr = " " ++ show posLine ++ " "
lpfx = (' ' <$ lnostr) ++ "| "
(_,lstart) = findLineStartByByteOffset posByteOffset source
line = map snd $ takeWhile (not . isNL . snd) lstart
isNL c = c == '\r' || c == '\n'
findLineStartByByteOffset :: Int -> BL.ByteString -> (Int,[(Int,Char)])
findLineStartByByteOffset bofs0 input = go 0 inputChars inputChars
where
(_,inputChars) = Enc.decode input
go lsOfs lsChars [] = (lsOfs,lsChars)
go lsOfs lsChars ((ofs',_):_)
| bofs0 < ofs' = (lsOfs,lsChars)
go _ _ ((_,'\r'):(ofs','\n'):rest) = go ofs' rest rest
go _ _ ((ofs','\r'):rest) = go ofs' rest rest
go _ _ ((ofs','\n'):rest) = go ofs' rest rest
go lsOfs lsChars (_:rest) = go lsOfs lsChars rest