module Yamlet.Error
(
Error (..)
, Location (..)
, Path
, pathElements
, pathFromElements
, PathElement (..)
, prettyError
, renderPath
, errorAt
, errorsAt
, documentErrors
, locate
, nodePath
, nodePaths
) where
import Control.DeepSeq
import Data.Char
import Data.List qualified as L
import Data.Map.Strict qualified as M
import Data.Maybe
import Data.Set qualified as Set
import Data.Text qualified as T
import Data.Text.Array qualified as A
import Data.Text.Internal qualified as T
import Data.Text.Unsafe qualified as T
import GHC.Generics
import Yamlet.Internal.Chars
import Yamlet.Internal.Syntax
import Yamlet.Internal.Utils
data Error = Error
{ Error -> Location
location :: !Location
, Error -> [Char]
message :: !String
, Error -> Text
sourceLine :: !T.Text
, Error -> Int
sourceIndex :: !Int
, Error -> Path
path :: !Path
}
deriving stock (Error -> Error -> Bool
(Error -> Error -> Bool) -> (Error -> Error -> Bool) -> Eq Error
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Error -> Error -> Bool
== :: Error -> Error -> Bool
$c/= :: Error -> Error -> Bool
/= :: Error -> Error -> Bool
Eq, Int -> Error -> ShowS
[Error] -> ShowS
Error -> [Char]
(Int -> Error -> ShowS)
-> (Error -> [Char]) -> ([Error] -> ShowS) -> Show Error
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Error -> ShowS
showsPrec :: Int -> Error -> ShowS
$cshow :: Error -> [Char]
show :: Error -> [Char]
$cshowList :: [Error] -> ShowS
showList :: [Error] -> ShowS
Show, (forall x. Error -> Rep Error x)
-> (forall x. Rep Error x -> Error) -> Generic Error
forall x. Rep Error x -> Error
forall x. Error -> Rep Error x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Error -> Rep Error x
from :: forall x. Error -> Rep Error x
$cto :: forall x. Rep Error x -> Error
to :: forall x. Rep Error x -> Error
Generic)
deriving anyclass (Error -> ()
(Error -> ()) -> NFData Error
forall a. (a -> ()) -> NFData a
$crnf :: Error -> ()
rnf :: Error -> ()
NFData)
data Path
= Root
| Child !Path !PathElement
deriving stock (Path -> Path -> Bool
(Path -> Path -> Bool) -> (Path -> Path -> Bool) -> Eq Path
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Path -> Path -> Bool
== :: Path -> Path -> Bool
$c/= :: Path -> Path -> Bool
/= :: Path -> Path -> Bool
Eq)
instance NFData Path where
rnf :: Path -> ()
rnf = Path -> ()
forall a. a -> ()
rwhnf
instance Show Path where
showsPrec :: Int -> Path -> ShowS
showsPrec Int
d Path
p =
Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [Char] -> ShowS
showString [Char]
"pathFromElements " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PathElement] -> ShowS
forall a. Show a => a -> ShowS
shows (Path -> [PathElement]
pathElements Path
p)
pathElements :: Path -> [PathElement]
pathElements :: Path -> [PathElement]
pathElements = [PathElement] -> Path -> [PathElement]
go []
where
go :: [PathElement] -> Path -> [PathElement]
go :: [PathElement] -> Path -> [PathElement]
go [PathElement]
acc = \case
Path
Root -> [PathElement]
acc
Child Path
p PathElement
e -> [PathElement] -> Path -> [PathElement]
go (PathElement
e PathElement -> [PathElement] -> [PathElement]
forall a. a -> [a] -> [a]
: [PathElement]
acc) Path
p
pathFromElements :: [PathElement] -> Path
pathFromElements :: [PathElement] -> Path
pathFromElements = (Path -> PathElement -> Path) -> Path -> [PathElement] -> Path
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' Path -> PathElement -> Path
Child Path
Root
data PathElement
=
Key !T.Text
|
Index !Int
|
CollectionKey
|
AliasKey !T.Text
deriving stock (PathElement -> PathElement -> Bool
(PathElement -> PathElement -> Bool)
-> (PathElement -> PathElement -> Bool) -> Eq PathElement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PathElement -> PathElement -> Bool
== :: PathElement -> PathElement -> Bool
$c/= :: PathElement -> PathElement -> Bool
/= :: PathElement -> PathElement -> Bool
Eq, Int -> PathElement -> ShowS
[PathElement] -> ShowS
PathElement -> [Char]
(Int -> PathElement -> ShowS)
-> (PathElement -> [Char])
-> ([PathElement] -> ShowS)
-> Show PathElement
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PathElement -> ShowS
showsPrec :: Int -> PathElement -> ShowS
$cshow :: PathElement -> [Char]
show :: PathElement -> [Char]
$cshowList :: [PathElement] -> ShowS
showList :: [PathElement] -> ShowS
Show, (forall x. PathElement -> Rep PathElement x)
-> (forall x. Rep PathElement x -> PathElement)
-> Generic PathElement
forall x. Rep PathElement x -> PathElement
forall x. PathElement -> Rep PathElement x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PathElement -> Rep PathElement x
from :: forall x. PathElement -> Rep PathElement x
$cto :: forall x. Rep PathElement x -> PathElement
to :: forall x. Rep PathElement x -> PathElement
Generic)
instance NFData PathElement where
rnf :: PathElement -> ()
rnf = PathElement -> ()
forall a. a -> ()
rwhnf
data Location = Location
{ Location -> Offset
offset :: !Offset
, Location -> Int
line :: !Int
, Location -> Int
column :: !Int
}
deriving stock (Location -> Location -> Bool
(Location -> Location -> Bool)
-> (Location -> Location -> Bool) -> Eq Location
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Location -> Location -> Bool
== :: Location -> Location -> Bool
$c/= :: Location -> Location -> Bool
/= :: Location -> Location -> Bool
Eq, Int -> Location -> ShowS
[Location] -> ShowS
Location -> [Char]
(Int -> Location -> ShowS)
-> (Location -> [Char]) -> ([Location] -> ShowS) -> Show Location
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Location -> ShowS
showsPrec :: Int -> Location -> ShowS
$cshow :: Location -> [Char]
show :: Location -> [Char]
$cshowList :: [Location] -> ShowS
showList :: [Location] -> ShowS
Show, (forall x. Location -> Rep Location x)
-> (forall x. Rep Location x -> Location) -> Generic Location
forall x. Rep Location x -> Location
forall x. Location -> Rep Location x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Location -> Rep Location x
from :: forall x. Location -> Rep Location x
$cto :: forall x. Rep Location x -> Location
to :: forall x. Rep Location x -> Location
Generic)
deriving anyclass (Location -> ()
(Location -> ()) -> NFData Location
forall a. (a -> ()) -> NFData a
$crnf :: Location -> ()
rnf :: Location -> ()
NFData)
prettyError :: FilePath -> Error -> String
prettyError :: [Char] -> Error -> [Char]
prettyError [Char]
file Error
err
| Error
err.location.line Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = [Char]
file [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
": " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
message
| Bool
otherwise =
[[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [Char]
file
, [Char]
":"
, Int -> [Char]
forall a. Show a => a -> [Char]
show Error
err.location.line
, [Char]
":"
, Int -> [Char]
forall a. Show a => a -> [Char]
show Error
err.location.column
, [Char]
": "
, [Char]
message
, [Char]
"\n"
, [Char]
pad
, [Char]
" |\n"
, [Char]
lineNo
, [Char]
" | "
, [Char]
shown
, [Char]
"\n"
, [Char]
pad
, [Char]
" | "
, [Char]
caret
, [Char]
"^"
]
where
message :: String
message :: [Char]
message
| Error
err.path Path -> Path -> Bool
forall a. Eq a => a -> a -> Bool
== Path
Root = Error
err.message
| Bool
otherwise = Path -> [Char]
renderPath Error
err.path [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
": " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Error
err.message
lineNo :: String
lineNo :: [Char]
lineNo = Int -> [Char]
forall a. Show a => a -> [Char]
show Error
err.location.line
pad :: String
pad :: [Char]
pad = (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map (Char -> Char -> Char
forall a b. a -> b -> a
const Char
' ') [Char]
lineNo
width :: Int
width :: Int
width = Int
80
back, ahead :: Int
back :: Int
back = (Int, Int) -> Int
forall a b. (a, b) -> a
fst (Int -> (Int, Int)
stepBack (Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
ahead :: Int
ahead = (Int, Int) -> Int
forall a b. (a, b) -> a
fst (Int -> (Int, Int)
stepAhead (Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
short :: Bool
short :: Bool
short = Int
back Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ahead Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
width
inExcerpt :: Int
inExcerpt :: Int
inExcerpt = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
back (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Int
width Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) (Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ahead))
cutBefore, cutAfter :: Bool
cutBefore :: Bool
cutBefore = Int
back Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
inExcerpt
cutAfter :: Bool
cutAfter = Int
ahead Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
inExcerpt
shown :: String
shown :: [Char]
shown
| Bool
short = (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
visible (Text -> [Char]
T.unpack Error
err.sourceLine)
| Bool
otherwise =
(if Bool
cutBefore then [Char]
ellipsis else [Char]
"")
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
visible (Text -> [Char]
T.unpack (Array -> Int -> Int -> Text
T.Text Array
arr Int
excerptStart (Int
excerptEnd Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
excerptStart)))
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (if Bool
cutAfter then [Char]
ellipsis else [Char]
"")
where
excerptStart, excerptEnd :: Int
excerptStart :: Int
excerptStart = (Int, Int) -> Int
forall a b. (a, b) -> b
snd (Int -> (Int, Int)
stepBack Int
inExcerpt)
excerptEnd :: Int
excerptEnd = (Int, Int) -> Int
forall a b. (a, b) -> b
snd (Int -> (Int, Int)
stepAhead (Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
inExcerpt))
visible :: Char -> Char
visible :: Char -> Char
visible Char
c
| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t' = Char
c
| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\DEL' = Char
'\x2421'
| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< Char
' ' = Int -> Char
chr (Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0x2400)
| Char -> Bool
isControl Char
c = Char
'\xFFFD'
| Bool
otherwise = Char
c
ellipsis :: String
ellipsis :: [Char]
ellipsis = [Char]
"..."
before :: Int
before :: Int
before
| Bool
short = Int
back
| Bool
otherwise = (if Bool
cutBefore then [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
ellipsis else Int
0) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
inExcerpt
T.Text Array
arr Int
lineStart Int
lineLen = Error
err.sourceLine
lineEnd :: Int
lineEnd :: Int
lineEnd = Int
lineStart Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lineLen
index :: Int
index :: Int
index = Int -> Int
charStart (Int
lineStart Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
lineLen Error
err.sourceIndex))
charStart :: Int -> Int
charStart :: Int -> Int
charStart Int
i
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
lineStart Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
lineEnd Bool -> Bool -> Bool
&& Bool -> Bool
not (Word8 -> Bool
isCharStart (Array -> Int -> Word8
A.unsafeIndex Array
arr Int
i)) =
Int -> Int
charStart (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
| Bool
otherwise = Int
i
stepBack, stepAhead :: Int -> (Int, Int)
stepBack :: Int -> (Int, Int)
stepBack = Int -> Int -> Int -> (Int, Int)
go Int
index Int
0
where
go :: Int -> Int -> Int -> (Int, Int)
go :: Int -> Int -> Int -> (Int, Int)
go Int
i !Int
k Int
n
| Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
lineStart = (Int
k, Int
i)
| Bool
otherwise = Int -> Int -> Int -> (Int, Int)
go (Int -> Int
charStart (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
stepAhead :: Int -> (Int, Int)
stepAhead = Int -> Int -> Int -> (Int, Int)
go Int
index Int
0
where
go :: Int -> Int -> Int -> (Int, Int)
go :: Int -> Int -> Int -> (Int, Int)
go Int
i !Int
k Int
n
| Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
lineEnd = (Int
k, Int
i)
| Bool
otherwise = Int -> Int -> Int -> (Int, Int)
go (Int -> Int
charEnd (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
charEnd :: Int -> Int
charEnd :: Int -> Int
charEnd Int
i =
if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
lineEnd Bool -> Bool -> Bool
&& Bool -> Bool
not (Word8 -> Bool
isCharStart (Array -> Int -> Word8
A.unsafeIndex Array
arr Int
i))
then Int -> Int
charEnd (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
else Int
i
caret :: String
caret :: [Char]
caret = (Char -> [Char]) -> ShowS
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> [Char]
cell (Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
before [Char]
shown)
where
cell :: Char -> String
cell :: Char -> [Char]
cell Char
c = case Char -> GeneralCategory
generalCategory Char
c of
GeneralCategory
NonSpacingMark -> [Char]
""
GeneralCategory
EnclosingMark -> [Char]
""
GeneralCategory
_ -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t' then [Char]
"\t" else [Char]
" "
renderPath :: Path -> String
renderPath :: Path -> [Char]
renderPath Path
path = case Path -> [PathElement]
pathElements Path
path of
[] -> [Char]
""
PathElement
e : [PathElement]
rest -> PathElement -> [Char]
step PathElement
e [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (PathElement -> [Char]) -> [PathElement] -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PathElement -> [Char]
next [PathElement]
rest
where
next :: PathElement -> String
next :: PathElement -> [Char]
next = \case
Index Int
i -> Int -> [Char]
index Int
i
PathElement
e -> [Char]
"." [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ PathElement -> [Char]
step PathElement
e
step :: PathElement -> String
step :: PathElement -> [Char]
step = \case
Key Text
k -> Text -> [Char]
key Text
k
Index Int
i -> Int -> [Char]
index Int
i
PathElement
CollectionKey -> [Char]
"?"
AliasKey Text
name -> Char
'*' Char -> ShowS
forall a. a -> [a] -> [a]
: Text -> [Char]
T.unpack Text
name
key :: T.Text -> String
key :: Text -> [Char]
key Text
k
| Bool -> Bool
not (Text -> Bool
T.null Text
k)
Bool -> Bool -> Bool
&& (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
plain Text
k
Bool -> Bool -> Bool
&& Bool -> Bool
not (Text -> Text -> Bool
T.isPrefixOf Text
"?" Text
k Bool -> Bool -> Bool
|| Text -> Text -> Bool
T.isPrefixOf Text
"*" Text
k) =
Text -> [Char]
T.unpack Text
k
| Bool
otherwise = Text -> [Char]
showText Text
k
where
plain :: Char -> Bool
plain :: Char -> Bool
plain Char
c = forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem @[] Char
c [Char]
".[]\"\\" Bool -> Bool -> Bool
&& Char -> Bool
isPrint Char
c Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isSpace Char
c)
index :: Int -> String
index :: Int -> [Char]
index Int
i = [Char]
"[" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"]"
nodePath :: Offset -> Node -> Path
nodePath :: Offset -> Node -> Path
nodePath Offset
off Node
root = Path -> Maybe Path -> Path
forall a. a -> Maybe a -> a
fromMaybe Path
Root ([Path] -> Maybe Path
forall a. [a] -> Maybe a
listToMaybe ([Offset] -> Node -> [Path]
nodePaths [Offset
off] Node
root))
nodePaths :: [Offset] -> Node -> [Path]
nodePaths :: [Offset] -> Node -> [Path]
nodePaths [Offset]
offs Node
root = (Offset -> Path) -> [Offset] -> [Path]
forall a b. (a -> b) -> [a] -> [b]
map (\Offset
off -> Path -> Offset -> Map Offset Path -> Path
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault Path
Root Offset
off Map Offset Path
found) [Offset]
offs
where
found :: M.Map Offset Path
found :: Map Offset Path
found = Set Offset -> Path -> Node -> Map Offset Path -> Map Offset Path
walk (Offset -> Set Offset -> Set Offset
forall a. Ord a => a -> Set a -> Set a
Set.delete Offset
noOffset ([Offset] -> Set Offset
forall a. Ord a => [a] -> Set a
Set.fromList [Offset]
offs)) Path
Root Node
root Map Offset Path
forall k a. Map k a
M.empty
walk :: Set.Set Offset -> Path -> Node -> M.Map Offset Path -> M.Map Offset Path
walk :: Set Offset -> Path -> Node -> Map Offset Path -> Map Offset Path
walk Set Offset
wanted Path
path Node
n Map Offset Path
acc
| Set Offset -> Bool
forall a. Set a -> Bool
Set.null Set Offset
inside = Map Offset Path
here
| Bool
otherwise = case Node
n.content of
SequenceContent CollectionStyle
_ [Node]
xs ->
(Map Offset Path -> (Int, Node) -> Map Offset Path)
-> Map Offset Path -> [(Int, Node)] -> Map Offset Path
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl'
(\Map Offset Path
a (Int
i, Node
x) -> Set Offset -> Path -> Node -> Map Offset Path -> Map Offset Path
walk Set Offset
inside (Path -> PathElement -> Path
Child Path
path (Int -> PathElement
Index Int
i)) Node
x Map Offset Path
a)
Map Offset Path
here
([Int] -> [Node] -> [(Int, Node)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] [Node]
xs)
MappingContent CollectionStyle
_ [(Node, Node)]
kvs ->
(Map Offset Path -> (Node, Node) -> Map Offset Path)
-> Map Offset Path -> [(Node, Node)] -> Map Offset Path
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl'
( \Map Offset Path
a (Node
k, Node
v) ->
Set Offset -> Path -> Node -> Map Offset Path -> Map Offset Path
walk Set Offset
inside (Path -> PathElement -> Path
Child Path
path (Node -> PathElement
keyElement Node
k)) Node
v (Set Offset -> Path -> Node -> Map Offset Path -> Map Offset Path
key Set Offset
inside Path
path Node
k Map Offset Path
a)
)
Map Offset Path
here
[(Node, Node)]
kvs
Content
_ -> Map Offset Path
here
where
here :: M.Map Offset Path
here :: Map Offset Path
here
| Node
n.offset Offset -> Set Offset -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Offset
wanted = (Path -> Path -> Path)
-> Offset -> Path -> Map Offset Path -> Map Offset Path
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith (\Path
_ Path
old -> Path
old) Node
n.offset Path
path Map Offset Path
acc
| Bool
otherwise = Map Offset Path
acc
inside :: Set.Set Offset
inside :: Set Offset
inside = Node -> Set Offset -> Set Offset
within Node
n Set Offset
wanted
key :: Set.Set Offset -> Path -> Node -> M.Map Offset Path -> M.Map Offset Path
key :: Set Offset -> Path -> Node -> Map Offset Path -> Map Offset Path
key Set Offset
wanted Path
path Node
k Map Offset Path
acc =
(Map Offset Path -> Offset -> Map Offset Path)
-> Map Offset Path -> Set Offset -> Map Offset Path
forall a b. (a -> b -> a) -> a -> Set b -> a
Set.foldl' (\Map Offset Path
a Offset
off -> (Path -> Path -> Path)
-> Offset -> Path -> Map Offset Path -> Map Offset Path
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith (\Path
_ Path
old -> Path
old) Offset
off Path
path Map Offset Path
a) Map Offset Path
acc Set Offset
offsets
where
offsets :: Set.Set Offset
offsets :: Set Offset
offsets =
(Offset -> Bool) -> Set Offset -> Set Offset
forall a. (a -> Bool) -> Set a -> Set a
Set.takeWhileAntitone (\Offset
o -> Offset
o Offset -> Offset -> Bool
forall a. Ord a => a -> a -> Bool
< Node
k.endOffset Bool -> Bool -> Bool
|| Offset
o Offset -> Offset -> Bool
forall a. Eq a => a -> a -> Bool
== Node
k.offset) (Set Offset -> Set Offset) -> Set Offset -> Set Offset
forall a b. (a -> b) -> a -> b
$
(Offset -> Bool) -> Set Offset -> Set Offset
forall a. (a -> Bool) -> Set a -> Set a
Set.dropWhileAntitone (Offset -> Offset -> Bool
forall a. Ord a => a -> a -> Bool
< Node
k.offset) Set Offset
wanted
within :: Node -> Set.Set Offset -> Set.Set Offset
within :: Node -> Set Offset -> Set Offset
within Node
n
| Node
n.offset Offset -> Offset -> Bool
forall a. Eq a => a -> a -> Bool
== Offset
noOffset = Set Offset -> Set Offset
forall a. a -> a
id
| Bool
otherwise =
(Offset -> Bool) -> Set Offset -> Set Offset
forall a. (a -> Bool) -> Set a -> Set a
Set.takeWhileAntitone (Offset -> Offset -> Bool
forall a. Ord a => a -> a -> Bool
<= Node
n.endOffset) (Set Offset -> Set Offset)
-> (Set Offset -> Set Offset) -> Set Offset -> Set Offset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Offset -> Bool) -> Set Offset -> Set Offset
forall a. (a -> Bool) -> Set a -> Set a
Set.dropWhileAntitone (Offset -> Offset -> Bool
forall a. Ord a => a -> a -> Bool
< Node
n.offset)
keyElement :: Node -> PathElement
keyElement :: Node -> PathElement
keyElement Node
k = case Node
k.content of
ScalarContent ScalarStyle
_ Text
t -> Text -> PathElement
Key (Text -> Text
T.copy Text
t)
AliasContent Text
name -> Text -> PathElement
AliasKey (Text -> Text
T.copy Text
name)
Content
_ -> PathElement
CollectionKey
errorAt :: T.Text -> Offset -> String -> Error
errorAt :: Text -> Offset -> [Char] -> Error
errorAt Text
input Offset
off [Char]
msg
| Text -> Offset -> Bool
noPosition Text
input Offset
off = Location -> [Char] -> Text -> Int -> Error
errorOnLine (Text -> Offset -> Location
locate Text
input Offset
off) [Char]
msg Text
T.empty Int
0
| Bool
otherwise =
let (Location
loc, Int
index, Scan
_) = Text -> Scan -> Offset -> (Location, Int, Scan)
locateFrom Text
input (Text -> Scan
startScan Text
input) Offset
off
in Location -> [Char] -> Text -> Int -> Error
errorOnLine Location
loc [Char]
msg (Text -> Text
T.copy (Text -> Offset -> Text
lineAt Text
input Offset
off)) Int
index
errorOnLine :: Location -> String -> T.Text -> Int -> Error
errorOnLine :: Location -> [Char] -> Text -> Int -> Error
errorOnLine Location
loc [Char]
msg Text
sourceLine Int
index =
Error -> Error
forall a. NFData a => a -> a
force (Error -> Error) -> Error -> Error
forall a b. (a -> b) -> a -> b
$
Error
{ location :: Location
location = Location
loc
, message :: [Char]
message = [Char]
msg
, sourceLine :: Text
sourceLine = Text
sourceLine
, sourceIndex :: Int
sourceIndex = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Text -> Int
T.lengthWord8 Text
sourceLine) Int
index
, path :: Path
path = Path
Root
}
documentErrors :: T.Text -> Document -> [(Offset, String)] -> [Error]
documentErrors :: Text -> Document -> [(Offset, [Char])] -> [Error]
documentErrors Text
input Document
doc [(Offset, [Char])]
errs =
(Error -> Path -> Error) -> [Error] -> [Path] -> [Error]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
(\Error
err Path
p -> Error -> Error
forall a. NFData a => a -> a
force Error
err {path = p})
(Text -> [(Offset, [Char])] -> [Error]
errorsAt Text
input [(Offset, [Char])]
errs)
([Offset] -> Node -> [Path]
nodePaths (((Offset, [Char]) -> Offset) -> [(Offset, [Char])] -> [Offset]
forall a b. (a -> b) -> [a] -> [b]
map (Offset, [Char]) -> Offset
forall a b. (a, b) -> a
fst [(Offset, [Char])]
errs) Document
doc.root)
errorsAt :: T.Text -> [(Offset, String)] -> [Error]
errorsAt :: Text -> [(Offset, [Char])] -> [Error]
errorsAt Text
input [(Offset, [Char])]
errs =
((Int, Error) -> Error) -> [(Int, Error)] -> [Error]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Error) -> Error
forall a b. (a, b) -> b
snd ([(Int, Error)] -> [Error])
-> ([(Int, Error)] -> [(Int, Error)]) -> [(Int, Error)] -> [Error]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Error) -> Int) -> [(Int, Error)] -> [(Int, Error)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
L.sortOn (Int, Error) -> Int
forall a b. (a, b) -> a
fst ([(Int, Error)] -> [Error]) -> [(Int, Error)] -> [Error]
forall a b. (a -> b) -> a -> b
$
Scan
-> Maybe (Int, Text) -> [(Int, (Offset, [Char]))] -> [(Int, Error)]
go (Text -> Scan
startScan Text
input) Maybe (Int, Text)
forall a. Maybe a
Nothing (((Int, (Offset, [Char])) -> Offset)
-> [(Int, (Offset, [Char]))] -> [(Int, (Offset, [Char]))]
forall b a. Ord b => (a -> b) -> [a] -> [a]
L.sortOn ((Offset, [Char]) -> Offset
forall a b. (a, b) -> a
fst ((Offset, [Char]) -> Offset)
-> ((Int, (Offset, [Char])) -> (Offset, [Char]))
-> (Int, (Offset, [Char]))
-> Offset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, (Offset, [Char])) -> (Offset, [Char])
forall a b. (a, b) -> b
snd) ([Int] -> [(Offset, [Char])] -> [(Int, (Offset, [Char]))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 :: Int ..] [(Offset, [Char])]
errs))
where
go :: Scan -> Maybe (Int, T.Text) -> [(Int, (Offset, String))] -> [(Int, Error)]
go :: Scan
-> Maybe (Int, Text) -> [(Int, (Offset, [Char]))] -> [(Int, Error)]
go Scan
s Maybe (Int, Text)
prev = \case
[] -> []
(Int
i, (Offset
off, [Char]
msg)) : [(Int, (Offset, [Char]))]
rest
| Text -> Offset -> Bool
noPosition Text
input Offset
off ->
(Int
i, Location -> [Char] -> Text -> Int -> Error
errorOnLine (Text -> Offset -> Location
locate Text
input Offset
off) [Char]
msg Text
T.empty Int
0) (Int, Error) -> [(Int, Error)] -> [(Int, Error)]
forall a. a -> [a] -> [a]
: Scan
-> Maybe (Int, Text) -> [(Int, (Offset, [Char]))] -> [(Int, Error)]
go Scan
s Maybe (Int, Text)
prev [(Int, (Offset, [Char]))]
rest
| Bool
otherwise ->
let (Location
loc, Int
index, Scan
s') = Text -> Scan -> Offset -> (Location, Int, Scan)
locateFrom Text
input Scan
s Offset
off
sourceLine :: Text
sourceLine = case Maybe (Int, Text)
prev of
Just (Int
ln, Text
t) | Int
ln Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Location
loc.line -> Text
t
Maybe (Int, Text)
_ -> Text -> Text
T.copy (Text -> Offset -> Text
lineAt Text
input Offset
off)
in (Int
i, Location -> [Char] -> Text -> Int -> Error
errorOnLine Location
loc [Char]
msg Text
sourceLine Int
index)
(Int, Error) -> [(Int, Error)] -> [(Int, Error)]
forall a. a -> [a] -> [a]
: Scan
-> Maybe (Int, Text) -> [(Int, (Offset, [Char]))] -> [(Int, Error)]
go Scan
s' ((Int, Text) -> Maybe (Int, Text)
forall a. a -> Maybe a
Just (Location
loc.line, Text
sourceLine)) [(Int, (Offset, [Char]))]
rest
locate :: T.Text -> Offset -> Location
locate :: Text -> Offset -> Location
locate Text
input Offset
off
| Text -> Offset -> Bool
noPosition Text
input Offset
off = Location {offset :: Offset
offset = Offset
off, line :: Int
line = Int
0, column :: Int
column = Int
0}
| Bool
otherwise = let (Location
loc, Int
_, Scan
_) = Text -> Scan -> Offset -> (Location, Int, Scan)
locateFrom Text
input (Text -> Scan
startScan Text
input) Offset
off in Location
loc
noPosition :: T.Text -> Offset -> Bool
noPosition :: Text -> Offset -> Bool
noPosition (T.Text Array
_ Int
_ Int
len) (Offset Int
off) = Int
off Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
off Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
len
data Scan = Scan !Int !Int !Int !Int !Int
startScan :: T.Text -> Scan
startScan :: Text -> Scan
startScan (T.Text Array
arr Int
base Int
len) = Int -> Int -> Int -> Int -> Int -> Scan
Scan Int
base Int
1 Int
start Int
start Int
1
where
start :: Int
start :: Int
start = Array -> Int -> Int -> Int
skipBomsIn Array
arr (Int
base Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len) Int
base
locateFrom :: T.Text -> Scan -> Offset -> (Location, Int, Scan)
locateFrom :: Text -> Scan -> Offset -> (Location, Int, Scan)
locateFrom (T.Text Array
arr Int
base Int
len) Scan
s0 (Offset Int
off0) = Scan -> (Location, Int, Scan)
go Scan
s0
where
end, off :: Int
end :: Int
end = Int
base Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len
off :: Int
off = Int
base Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
len Int
off0)
go :: Scan -> (Location, Int, Scan)
go :: Scan -> (Location, Int, Scan)
go s :: Scan
s@(Scan Int
i Int
ln Int
ls Int
ci Int
col)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
off =
if Int
off Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
ci
then (Int -> Int -> Location
location Int
ln (if Int
off Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
ci then Int
col else Int
1), Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ls), Scan
s)
else
let col' :: Int
col' = Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
countChars Int
ci Int
off
in (Int -> Int -> Location
location Int
ln Int
col', Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ls, Int -> Int -> Int -> Int -> Int -> Scan
Scan Int
i Int
ln Int
ls Int
off Int
col')
| Bool
otherwise = case Array -> Int -> Word8
A.unsafeIndex Array
arr Int
i of
Word8
LF -> Int -> (Location, Int, Scan)
newLine (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
Word8
CR
| Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
end Bool -> Bool -> Bool
&& Array -> Int -> Word8
A.unsafeIndex Array
arr (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
LF ->
Scan -> (Location, Int, Scan)
go (Int -> Int -> Int -> Int -> Int -> Scan
Scan (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
ln Int
ls Int
ci Int
col)
| Bool
otherwise -> Int -> (Location, Int, Scan)
newLine (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
Word8
_ -> Scan -> (Location, Int, Scan)
go (Int -> Int -> Int -> Int -> Int -> Scan
Scan (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
ln Int
ls Int
ci Int
col)
where
newLine :: Int -> (Location, Int, Scan)
newLine :: Int -> (Location, Int, Scan)
newLine Int
j =
let start' :: Int
start' = Array -> Int -> Int -> Int
skipBomsIn Array
arr Int
end Int
j in Scan -> (Location, Int, Scan)
go (Int -> Int -> Int -> Int -> Int -> Scan
Scan Int
j (Int
ln Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
start' Int
start' Int
1)
location :: Int -> Int -> Location
location :: Int -> Int -> Location
location Int
ln Int
col = Location {offset :: Offset
offset = Int -> Offset
Offset (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
base), line :: Int
line = Int
ln, column :: Int
column = Int
col}
countChars :: Int -> Int -> Int
countChars :: Int -> Int -> Int
countChars Int
i0 Int
i1 =
[()] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length
[() | Int
i <- [Int
i0 .. Int
i1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1], Word8 -> Bool
isCharStart (Array -> Int -> Word8
A.unsafeIndex Array
arr Int
i)]
lineAt :: T.Text -> Offset -> T.Text
lineAt :: Text -> Offset -> Text
lineAt (T.Text Array
arr Int
base Int
len) (Offset Int
off0) = Array -> Int -> Int -> Text
T.Text Array
arr Int
start (Int
stop Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start)
where
end, i0, off, start, stop :: Int
end :: Int
end = Int
base Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len
i0 :: Int
i0 = Int
base Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
len Int
off0)
off :: Int
off
| Int
i0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
base
Bool -> Bool -> Bool
&& Int
i0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
end
Bool -> Bool -> Bool
&& Array -> Int -> Word8
A.unsafeIndex Array
arr Int
i0 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
LF
Bool -> Bool -> Bool
&& Array -> Int -> Word8
A.unsafeIndex Array
arr (Int
i0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
CR =
Int
i0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
| Bool
otherwise = Int
i0
start :: Int
start = Array -> Int -> Int -> Int
skipBomsIn Array
arr Int
end (Int -> Int
findStart Int
off)
stop :: Int
stop = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
start (Int -> Int
findStop Int
off)
findStart :: Int -> Int
findStart :: Int -> Int
findStart Int
i
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
base Bool -> Bool -> Bool
&& Bool -> Bool
not (Word8 -> Bool
isBreak (Array -> Int -> Word8
A.unsafeIndex Array
arr (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))) = Int -> Int
findStart (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
| Bool
otherwise = Int
i
findStop :: Int -> Int
findStop :: Int -> Int
findStop Int
i
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
end Bool -> Bool -> Bool
&& Bool -> Bool
not (Word8 -> Bool
isBreak (Array -> Int -> Word8
A.unsafeIndex Array
arr Int
i)) = Int -> Int
findStop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
| Bool
otherwise = Int
i