{-# OPTIONS_HADDOCK not-home #-}

-- | The parser of YAML 1.2.2 streams.
--
-- The functions follow the productions of the specification and keep their
-- names, e.g. @nsFlowNode@ implements @ns-flow-node(n,c)@. A few productions
-- are fused into loops over the bytes of the input for speed. Each production
-- is a top-level function, also if only one function uses it, so that the
-- parser reads like the grammar of the specification.
--
-- This module is intended for internal use only, and may change without warning
-- in subsequent releases.
module Yamlet.Internal.Parser
  ( parseStream

    -- * Block scalars
  , BlockLine (..)
  , foldedText
  ) where

import Control.Monad
import Data.ByteString qualified as BS
import Data.Char
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.Encoding qualified as T
import Data.Text.Internal qualified as T
import Data.Text.Unsafe qualified as T
import Data.Word

import Yamlet.Error
import Yamlet.Internal.Chars
import Yamlet.Internal.Comments
import Yamlet.Internal.Parser.Hints
import Yamlet.Internal.Parser.Monad
import Yamlet.Internal.Parser.Scan
import Yamlet.Internal.Syntax hiding (document)
import Yamlet.Internal.Utils

-- | A character that only some places of a stream can contain, with its
-- index.
data Restricted
  = -- | A byte order mark, with a flag that is true if the mark is at the
    -- start of a line, as 'isStartOfLine' tells.
    BomRestricted !Int !Bool
  | -- | A character that only a quoted scalar can contain.
    QuotedRestricted !Int

-- | Parse all documents of a stream.
parseStream :: T.Text -> Either Error [Document]
parseStream :: Text -> Either Error [Document]
parseStream input :: Text
input@(T.Text Array
arr Int
off Int
len) = case Either Int ([Int], [Restricted])
prescan of
  Left Int
i -> Error -> Either Error [Document]
forall a b. a -> Either a b
Left (Error -> Either Error [Document])
-> Error -> Either Error [Document]
forall a b. (a -> b) -> a -> b
$ Int -> Error
invalidCharacter Int
i
  Right ([Int]
markers, [Restricted]
restricted) -> case Env
-> Int
-> P [Document]
-> Either ParseError (Maybe [Document], Int, Int)
forall a.
Env -> Int -> P a -> Either ParseError (Maybe a, Int, Int)
runParser Env
e Int
start ([Int] -> P [Document]
lYamlStream [Int]
markers) of
    Left (ParseError Int
i [Char]
msg) -> Error -> Either Error [Document]
forall a b. a -> Either a b
Left (Error -> Either Error [Document])
-> Error -> Either Error [Document]
forall a b. (a -> b) -> a -> b
$ [Int] -> [Restricted] -> Int -> [Char] -> Error
parseError [Int]
markers [Restricted]
restricted Int
i [Char]
msg
    Left (UnexpectedParseError Env
de Int
i) ->
      Error -> Either Error [Document]
forall a b. a -> Either a b
Left (Error -> Either Error [Document])
-> Error -> Either Error [Document]
forall a b. (a -> b) -> a -> b
$ (Int -> [Char] -> Error) -> (Int, [Char]) -> Error
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ([Int] -> [Restricted] -> Int -> [Char] -> Error
parseError [Int]
markers [Restricted]
restricted) ([Int] -> Env -> Int -> (Int, [Char])
furthestError [Int]
markers Env
de Int
i)
    Right (Just [Document]
docs, Int
_, Int
_) ->
      let ranges :: Map Offset (Offset, Bool)
ranges = [Document] -> Map Offset (Offset, Bool)
scalarRanges [Document]
docs
      in case (Restricted -> Bool) -> [Restricted] -> [Restricted]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Restricted -> Bool) -> Restricted -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Offset (Offset, Bool) -> Restricted -> Bool
allowed Map Offset (Offset, Bool)
ranges) [Restricted]
restricted of
           BomRestricted Int
i Bool
_ : [Restricted]
_ ->
             Error -> Either Error [Document]
forall a b. a -> Either a b
Left (Error -> Either Error [Document])
-> Error -> Either Error [Document]
forall a b. (a -> b) -> a -> b
$ Text -> Offset -> [Char] -> Error
errorAt Text
input (Env -> Int -> Offset
toOffset Env
e Int
i) [Char]
"unexpected byte order mark"
           QuotedRestricted Int
i : [Restricted]
_ -> Error -> Either Error [Document]
forall a b. a -> Either a b
Left (Error -> Either Error [Document])
-> Error -> Either Error [Document]
forall a b. (a -> b) -> a -> b
$ Int -> Error
invalidCharacter Int
i
           [] -> [Document] -> Either Error [Document]
forall a b. b -> Either a b
Right [Document]
docs
    Right (Maybe [Document]
Nothing, Int
_, Int
fu) ->
      Error -> Either Error [Document]
forall a b. a -> Either a b
Left (Error -> Either Error [Document])
-> Error -> Either Error [Document]
forall a b. (a -> b) -> a -> b
$ (Int -> [Char] -> Error) -> (Int, [Char]) -> Error
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ([Int] -> [Restricted] -> Int -> [Char] -> Error
parseError [Int]
markers [Restricted]
restricted) ([Int] -> Env -> Int -> (Int, [Char])
furthestError [Int]
markers Env
e Int
fu)
  where
    invalidCharacter :: Int -> Error
    invalidCharacter :: Int -> Error
invalidCharacter Int
i =
      Text -> Offset -> [Char] -> Error
errorAt
        Text
input
        (Env -> Int -> Offset
toOffset Env
e Int
i)
        ([Char]
"invalid character " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Char -> [Char]
codePointName (HasCallStack => Text -> Char
Text -> Char
T.head (Env -> Int -> Int -> Text
slice Env
e Int
i Env
e.end)))

    -- The error for the furthest failure, with the environment of its
    -- document. A tab before the failure on its line is the likely cause,
    -- unless the parser fails there also with spaces in place of the tabs:
    -- a space for each tab, or the indentation of the line above in place
    -- of the indentation with tabs.
    furthestError :: [Int] -> Env -> Int -> (Int, String)
    furthestError :: [Int] -> Env -> Int -> (Int, [Char])
furthestError [Int]
markers Env
de Int
i = case Env -> Int -> (Maybe Int, (Int, [Char]))
unexpected Env
de Int
i of
      (Just Int
tab, (Int, [Char])
_) | Bool
tabCause -> (Int
tab, [Char]
tabMessage)
      (Maybe Int
_, (Int, [Char])
other)
        | Just Int
tab <- Maybe Int
tabAbove
        , [Int] -> Int -> Int -> Text -> Int -> Bool
parsesPast
            [Int]
markers
            (Env -> Int -> Int
lineEndAt Env
e Int
i)
            Int
blankStart
            (Text -> Text
withSpaces (Array -> Int -> Int -> Text
T.Text Array
arr Int
blankStart (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
blankStart)))
            Int
s ->
            (Int
tab, [Char]
tabMessage)
        | Bool
otherwise -> (Int, [Char])
other
      where
        tabCause :: Bool
        tabCause :: Bool
tabCause =
          [Int] -> Int -> Int -> Text -> Int -> Bool
parsesPast [Int]
markers Int
i Int
s (Text -> Text
withSpaces (Array -> Int -> Int -> Text
T.Text Array
arr Int
s (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
s))) Int
i
            Bool -> Bool -> Bool
|| [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or
              [ [Int] -> Int -> Int -> Text -> Int -> Bool
parsesPast [Int]
markers Int
i Int
s (Int -> Text -> Text
T.replicate Int
n Text
" ") Int
indentEnd
              | Int
indentEnd Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i
              , Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust (Env -> Int -> Int -> Maybe Int
firstTab Env
e Int
s Int
indentEnd)
              , Just Int
above <- [Env -> Int -> Maybe Int
contentLineAbove Env
e Int
s]
              , let n :: Int
n = Env -> Int -> Int
skipSpaces Env
e Int
above Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
above
              ]

        s, indentEnd :: Int
        s :: Int
s = Env -> Int -> Int
lineStartAt Env
e Int
i
        indentEnd :: Int
indentEnd = Env -> Int -> Int
skipWhites Env
e Int
s

        -- A blank line or a comment line with a tab can end a scalar above
        -- it, as in "|\n  a\n\t\n  b", so that the parser fails on the next
        -- line. The tab is the cause if the line parses with spaces.
        blankStart :: Int
        blankStart :: Int
blankStart = Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
s (Env -> Int -> Int
nextLineStart Env
e) (Env -> Int -> Maybe Int
contentLineAbove Env
e Int
s)

        tabAbove :: Maybe Int
        tabAbove :: Maybe Int
tabAbove =
          [Int] -> Maybe Int
forall a. [a] -> Maybe a
listToMaybe
            [ Int
tab
            | Int
l <- (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
s) ((Int -> Int) -> Int -> [Int]
forall a. (a -> a) -> a -> [a]
iterate (Env -> Int -> Int
nextLineStart Env
e) Int
blankStart)
            , Just Int
tab <- [Env -> Int -> Int -> Maybe Int
firstTab Env
e Int
l (Env -> Int -> Int
skipWhites Env
e Int
l)]
            ]

        withSpaces :: T.Text -> T.Text
        withSpaces :: Text -> Text
withSpaces = (Char -> Char) -> Text -> Text
T.map (\Char
c -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t' then Char
' ' else Char
c)

    -- The parser gets past the first index with the text in place of the
    -- input from the second index to the third.
    parsesPast :: [Int] -> Int -> Int -> T.Text -> Int -> Bool
    parsesPast :: [Int] -> Int -> Int -> Text -> Int -> Bool
parsesPast [Int]
markers Int
target Int
from Text
replacement Int
upto =
      case Env
-> Int
-> P [Document]
-> Either ParseError (Maybe [Document], Int, Int)
forall a.
Env -> Int -> P a -> Either ParseError (Maybe a, Int, Int)
runParser Env
spaced (Int -> Int
moved Int
start) ([Int] -> P [Document]
lYamlStream ((Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Int
moved [Int]
markers)) of
        Left (ParseError Int
j [Char]
_) -> Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> Int
moved Int
target
        Left (UnexpectedParseError Env
_ Int
j) -> Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> Int
moved Int
target
        Right (Maybe [Document]
Nothing, Int
_, Int
j) -> Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> Int
moved Int
target
        Right (Just [Document]
_, Int
_, Int
_) -> Bool
True
      where
        T.Text Array
_ Int
_ Int
replacementLen = Text
replacement
        T.Text Array
spacedArr Int
spacedOff Int
spacedLen =
          Text -> Text
T.copy (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
            [Text] -> Text
T.concat
              [ Array -> Int -> Int -> Text
T.Text Array
arr Int
off (Int
from Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
off)
              , Text
replacement
              , Array -> Int -> Int -> Text
T.Text Array
arr Int
upto (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
upto)
              ]

        spaced :: Env
        spaced :: Env
spaced =
          Env
e
            { array = spacedArr
            , base = spacedOff
            , end = spacedOff + spacedLen
            , streamEnd = spacedOff + spacedLen
            }

        -- The index in the input with the replacement.
        moved :: Int -> Int
        moved :: Int -> Int
moved Int
j
          | Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
upto = Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
spacedOff
          | Bool
otherwise = Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
upto Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
spacedOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
from Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
off) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
replacementLen

    -- A byte order mark at the start of the line of an error is the likely
    -- cause if the parser fails before the content of the line, unless a
    -- document without a marker can start on the line. The mark can also be
    -- a character of a quoted scalar, so it is the cause only if the parser
    -- gets past the error without it.
    parseError :: [Int] -> [Restricted] -> Int -> String -> Error
    parseError :: [Int] -> [Restricted] -> Int -> [Char] -> Error
parseError [Int]
markers [Restricted]
restricted Int
i [Char]
msg
      | (Restricted -> Bool) -> [Restricted] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\case QuotedRestricted Int
j -> Int
j Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i; Restricted
_ -> Bool
False) [Restricted]
restricted =
          Int -> Error
invalidCharacter Int
i
      | let s :: Int
s = Env -> Int -> Int
lineStartAt Env
e Int
i
      , Env -> Int -> Bool
bomBeforeContent Env
e Int
s
      , Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Env -> Int -> Int
skipWhites Env
e (Env -> Int -> Int
skipBoms Env
e Int
s)
      , Bool -> Bool
not (Int -> Bool
inPrefix Int
s)
      , [Int] -> Int -> Int -> Text -> Int -> Bool
parsesPast [Int]
markers Int
i Int
s Text
T.empty (Env -> Int -> Int
skipBoms Env
e Int
s) =
          Text -> Offset -> [Char] -> Error
errorAt Text
input (Env -> Int -> Offset
toOffset Env
e Int
s) [Char]
"unexpected byte order mark"
      | Bool
otherwise = Text -> Offset -> [Char] -> Error
errorAt Text
input (Env -> Int -> Offset
toOffset Env
e Int
i) [Char]
msg

    -- Only empty lines and comment lines are between the start of the line
    -- and the start of the stream or a @...@ marker, so the line is in the
    -- prefix of a document, which can start with a byte order mark.
    inPrefix :: Int -> Bool
    inPrefix :: Int -> Bool
inPrefix Int
s = Bool -> (Int -> Bool) -> Maybe Int -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Env -> Int -> Bool
isEndMarker Env
e (Int -> Bool) -> (Int -> Int) -> Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Env -> Int -> Int
skipBoms Env
e) (Env -> Int -> Maybe Int
contentLineAbove Env
e Int
s)

    -- A byte order mark can start a line between documents, or be a
    -- character of a quoted scalar. The other restricted characters can only
    -- be characters of a quoted scalar.
    allowed :: M.Map Offset (Offset, Bool) -> Restricted -> Bool
    allowed :: Map Offset (Offset, Bool) -> Restricted -> Bool
allowed Map Offset (Offset, Bool)
ranges = \case
      BomRestricted Int
i Bool
lineStart -> Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
lineStart (Int -> Maybe Bool
inScalar Int
i)
      QuotedRestricted Int
i -> Int -> Maybe Bool
inScalar Int
i Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
      where
        -- Whether the scalar that contains the index is quoted, if a scalar
        -- contains it.
        inScalar :: Int -> Maybe Bool
        inScalar :: Int -> Maybe Bool
inScalar Int
i = case Offset
-> Map Offset (Offset, Bool) -> Maybe (Offset, (Offset, Bool))
forall k v. Ord k => k -> Map k v -> Maybe (k, v)
M.lookupLE (Env -> Int -> Offset
toOffset Env
e Int
i) Map Offset (Offset, Bool)
ranges of
          Just (Offset
_, (Offset
end, Bool
quoted)) | Env -> Int -> Offset
toOffset Env
e Int
i Offset -> Offset -> Bool
forall a. Ord a => a -> a -> Bool
< Offset
end -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
quoted
          Maybe (Offset, (Offset, Bool))
_ -> Maybe Bool
forall a. Maybe a
Nothing

    scalarRanges :: [Document] -> M.Map Offset (Offset, Bool)
    scalarRanges :: [Document] -> Map Offset (Offset, Bool)
scalarRanges [Document]
docs = [(Offset, (Offset, Bool))] -> Map Offset (Offset, Bool)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ((Document
 -> [(Offset, (Offset, Bool))] -> [(Offset, (Offset, Bool))])
-> [(Offset, (Offset, Bool))]
-> [Document]
-> [(Offset, (Offset, Bool))]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Document
d -> Node -> [(Offset, (Offset, Bool))] -> [(Offset, (Offset, Bool))]
ranges Document
d.root) [] [Document]
docs)
      where
        ranges :: Node -> [(Offset, (Offset, Bool))] -> [(Offset, (Offset, Bool))]
        ranges :: Node -> [(Offset, (Offset, Bool))] -> [(Offset, (Offset, Bool))]
ranges Node
n [(Offset, (Offset, Bool))]
acc = case Node
n.content of
          ScalarContent ScalarStyle
style Text
_ ->
            (Node
n.offset, (Node
n.endOffset, ScalarStyle
style ScalarStyle -> ScalarStyle -> Bool
forall a. Eq a => a -> a -> Bool
== ScalarStyle
SingleQuoted Bool -> Bool -> Bool
|| ScalarStyle
style ScalarStyle -> ScalarStyle -> Bool
forall a. Eq a => a -> a -> Bool
== ScalarStyle
DoubleQuoted))
              (Offset, (Offset, Bool))
-> [(Offset, (Offset, Bool))] -> [(Offset, (Offset, Bool))]
forall a. a -> [a] -> [a]
: [(Offset, (Offset, Bool))]
acc
          SequenceContent CollectionStyle
_ [Node]
xs -> (Node -> [(Offset, (Offset, Bool))] -> [(Offset, (Offset, Bool))])
-> [(Offset, (Offset, Bool))]
-> [Node]
-> [(Offset, (Offset, Bool))]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Node -> [(Offset, (Offset, Bool))] -> [(Offset, (Offset, Bool))]
ranges [(Offset, (Offset, Bool))]
acc [Node]
xs
          MappingContent CollectionStyle
_ [(Node, Node)]
kvs -> ((Node, Node)
 -> [(Offset, (Offset, Bool))] -> [(Offset, (Offset, Bool))])
-> [(Offset, (Offset, Bool))]
-> [(Node, Node)]
-> [(Offset, (Offset, Bool))]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Node
k, Node
v) -> Node -> [(Offset, (Offset, Bool))] -> [(Offset, (Offset, Bool))]
ranges Node
k ([(Offset, (Offset, Bool))] -> [(Offset, (Offset, Bool))])
-> ([(Offset, (Offset, Bool))] -> [(Offset, (Offset, Bool))])
-> [(Offset, (Offset, Bool))]
-> [(Offset, (Offset, Bool))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node -> [(Offset, (Offset, Bool))] -> [(Offset, (Offset, Bool))]
ranges Node
v) [(Offset, (Offset, Bool))]
acc [(Node, Node)]
kvs
          AliasContent Text
_ -> [(Offset, (Offset, Bool))]
acc

    e :: Env
    e :: Env
e =
      Env
        { array :: Array
array = Array
arr
        , base :: Int
base = Int
off
        , end :: Int
end = Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len
        , streamEnd :: Int
streamEnd = Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len
        , handles :: Map Text Text
handles = Map Text Text
defaultHandles
        }

    start :: Int
    start :: Int
start = Env -> Int
streamStart Env
e

    -- Check that the input has only characters that YAML allows, and find
    -- the lines that start with a document marker, and the restricted
    -- characters. A document cannot contain such a line. A marker after a
    -- byte order mark does not count: a quoted scalar can contain the line,
    -- and other nodes end at the mark anyway. Return the index of an invalid
    -- character on error.
    prescan :: Either Int ([Int], [Restricted])
    prescan :: Either Int ([Int], [Restricted])
prescan = Int
-> Int -> [Int] -> [Restricted] -> Either Int ([Int], [Restricted])
go Int
start Int
start [Int
start | Env -> Int -> Bool
isMarker Env
e Int
start] []
      where
        -- A byte order mark at index ls is at the start of a line.
        go :: Int -> Int -> [Int] -> [Restricted] -> Either Int ([Int], [Restricted])
        go :: Int
-> Int -> [Int] -> [Restricted] -> Either Int ([Int], [Restricted])
go Int
i Int
ls [Int]
acc [Restricted]
rs
          | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Env
e.end = ([Int], [Restricted]) -> Either Int ([Int], [Restricted])
forall a b. b -> Either a b
Right ([Int] -> [Int]
forall a. [a] -> [a]
reverse [Int]
acc, [Restricted] -> [Restricted]
forall a. [a] -> [a]
reverse [Restricted]
rs)
          | Bool
otherwise =
              let w :: Word8
w = Array -> Int -> Word8
A.unsafeIndex Env
e.array Int
i
              in if
                   | Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
SPACE Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
DEL -> Int
-> Int -> [Int] -> [Restricted] -> Either Int ([Int], [Restricted])
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
ls [Int]
acc [Restricted]
rs
                   | Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
LF Bool -> Bool -> Bool
|| (Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
CR Bool -> Bool -> Bool
&& Env -> Int -> Word8
byteAt Env
e (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) ->
                       let s :: Int
s = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                       in Int
-> Int -> [Int] -> [Restricted] -> Either Int ([Int], [Restricted])
go Int
s Int
s (if Env -> Int -> Bool
isMarker Env
e Int
s then Int
s Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
acc else [Int]
acc) [Restricted]
rs
                   | Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
CR Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
TAB -> Int
-> Int -> [Int] -> [Restricted] -> Either Int ([Int], [Restricted])
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
ls [Int]
acc [Restricted]
rs
                   | Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
SPACE -> Int -> Either Int ([Int], [Restricted])
forall a b. a -> Either a b
Left Int
i
                   | Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
DEL -> Int
-> Int -> [Int] -> [Restricted] -> Either Int ([Int], [Restricted])
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
ls [Int]
acc (Int -> Restricted
QuotedRestricted Int
i Restricted -> [Restricted] -> [Restricted]
forall a. a -> [a] -> [a]
: [Restricted]
rs)
                   -- C1 control characters except NEL.
                   | Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0xC2 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Env
e.end
                   , let w1 :: Word8
w1 = Array -> Int -> Word8
A.unsafeIndex Env
e.array (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                   , Word8
w1 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
0x80 Bool -> Bool -> Bool
&& Word8
w1 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
0x9F Bool -> Bool -> Bool
&& Word8
w1 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0x85 ->
                       Int
-> Int -> [Int] -> [Restricted] -> Either Int ([Int], [Restricted])
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
ls [Int]
acc (Int -> Restricted
QuotedRestricted Int
i Restricted -> [Restricted] -> [Restricted]
forall a. a -> [a] -> [a]
: [Restricted]
rs)
                   -- U+FFFE and U+FFFF.
                   | Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0xEF Bool -> Bool -> Bool
&& Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Env
e.end
                   , Array -> Int -> Word8
A.unsafeIndex Env
e.array (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
0xBF
                   , let w2 :: Word8
w2 = Array -> Int -> Word8
A.unsafeIndex Env
e.array (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
                   , Word8
w2 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0xBE Bool -> Bool -> Bool
|| Word8
w2 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0xBF ->
                       Int
-> Int -> [Int] -> [Restricted] -> Either Int ([Int], [Restricted])
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
ls [Int]
acc (Int -> Restricted
QuotedRestricted Int
i Restricted -> [Restricted] -> [Restricted]
forall a. a -> [a] -> [a]
: [Restricted]
rs)
                   | Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0xEF Bool -> Bool -> Bool
&& Env -> Int -> Bool
isBom Env
e Int
i ->
                       let next :: Int
next = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
bomLength
                       in Int
-> Int -> [Int] -> [Restricted] -> Either Int ([Int], [Restricted])
go
                            Int
next
                            (if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
ls then Int
next else Int
ls)
                            [Int]
acc
                            (Int -> Bool -> Restricted
BomRestricted Int
i (Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
ls) Restricted -> [Restricted] -> [Restricted]
forall a. a -> [a] -> [a]
: [Restricted]
rs)
                   | Bool
otherwise -> Int
-> Int -> [Int] -> [Restricted] -> Either Int ([Int], [Restricted])
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
ls [Int]
acc [Restricted]
rs

-- | The index after the byte order mark at the start of the input.
streamStart :: Env -> Int
streamStart :: Env -> Int
streamStart Env
e = if Env -> Int -> Bool
isBom Env
e Env
e.base then Env
e.base Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
bomLength else Env
e.base

----------------------------------------
-- Contexts

data Ctx = BlockOut | BlockIn | FlowOut | FlowIn | BlockKey | FlowKey
  deriving stock (Ctx -> Ctx -> Bool
(Ctx -> Ctx -> Bool) -> (Ctx -> Ctx -> Bool) -> Eq Ctx
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Ctx -> Ctx -> Bool
== :: Ctx -> Ctx -> Bool
$c/= :: Ctx -> Ctx -> Bool
/= :: Ctx -> Ctx -> Bool
Eq)

isKeyCtx :: Ctx -> Bool
isKeyCtx :: Ctx -> Bool
isKeyCtx Ctx
c = Ctx
c Ctx -> Ctx -> Bool
forall a. Eq a => a -> a -> Bool
== Ctx
BlockKey Bool -> Bool -> Bool
|| Ctx
c Ctx -> Ctx -> Bool
forall a. Eq a => a -> a -> Bool
== Ctx
FlowKey

-- | ns-plain-safe(c), with 'isFlowCtx' of c as the flag. The function takes
-- the flag, not the context, so that a caller can compute it once for all the
-- bytes of a scalar.
isPlainSafe :: Bool -> Word8 -> Bool
isPlainSafe :: Bool -> Word8 -> Bool
isPlainSafe Bool
flow Word8
w = Word8 -> Bool
isNsChar Word8
w Bool -> Bool -> Bool
&& Bool -> Bool
not (Bool
flow Bool -> Bool -> Bool
&& Word8 -> Bool
isFlowIndicator Word8
w)

-- | The flow indicators end a plain scalar in the context.
isFlowCtx :: Ctx -> Bool
isFlowCtx :: Ctx -> Bool
isFlowCtx Ctx
c = Ctx
c Ctx -> Ctx -> Bool
forall a. Eq a => a -> a -> Bool
== Ctx
FlowIn Bool -> Bool -> Bool
|| Ctx
c Ctx -> Ctx -> Bool
forall a. Eq a => a -> a -> Bool
== Ctx
FlowKey

-- | in-flow(c)
inFlow :: Ctx -> Ctx
inFlow :: Ctx -> Ctx
inFlow Ctx
c = if Ctx -> Bool
isKeyCtx Ctx
c then Ctx
FlowKey else Ctx
FlowIn

----------------------------------------
-- Scanning helpers

-- | Skip the empty lines of a flow scalar after a line break and the line
-- prefix of the next line (@l-empty(n,FLOW-IN)* s-flow-line-prefix(n)@).
-- Return the number of empty lines and the index of the content, or
-- 'Nothing' if the next line is indented less than the scalar.
flowFold :: Env -> Int -> Int -> Maybe (Int, Int)
flowFold :: Env -> Int -> Int -> Maybe (Int, Int)
flowFold Env
e Int
n = Int -> Int -> Maybe (Int, Int)
go Int
0
  where
    go :: Int -> Int -> Maybe (Int, Int)
    go :: Int -> Int -> Maybe (Int, Int)
go !Int
k Int
i =
      let s :: Int
s = Env -> Int -> Int
skipSpaces Env
e Int
i
          indented :: Bool
indented = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n
          w :: Int
w = Env -> Int -> Int
skipWhites Env
e Int
s
      in if
           | Bool
indented Bool -> Bool -> Bool
&& Word8 -> Bool
isBreak (Env -> Int -> Word8
byteAt Env
e Int
w) -> Int -> Int -> Maybe (Int, Int)
go (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Env -> Int -> Int
breakEnd Env
e Int
w)
           | Bool -> Bool
not Bool
indented Bool -> Bool -> Bool
&& Word8 -> Bool
isBreak (Env -> Int -> Word8
byteAt Env
e Int
s) -> Int -> Int -> Maybe (Int, Int)
go (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Env -> Int -> Int
breakEnd Env
e Int
s)
           | Bool
indented -> (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int
k, Int
w)
           | Bool
otherwise -> Maybe (Int, Int)
forall a. Maybe a
Nothing

-- | The text of a line folding with the given number of empty lines.
foldText :: Int -> T.Text
foldText :: Int -> Text
foldText = \case
  Int
0 -> Text
" "
  Int
k -> Int -> Text -> Text
T.replicate Int
k Text
"\n"

----------------------------------------
-- Basic structures

startOfLine :: P ()
startOfLine :: P ()
startOfLine = do
  e <- P Env
env
  p <- pos
  guardP $ isStartOfLine e p

-- | The indicator of a block collection entry, which a character of a plain
-- scalar cannot follow, as in "- a" but not "-a".
blockIndicator :: Word8 -> P ()
blockIndicator :: Word8 -> P ()
blockIndicator Word8
w = do
  Word8 -> P ()
char Word8
w
  next <- P Word8
peek
  guardP . not $ isNsChar next

-- | s-indent(n)
sIndent :: Int -> P ()
sIndent :: Int -> P ()
sIndent Int
n = do
  e <- P Env
env
  p <- pos
  let q = Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
n
  if skipSpacesTo e p q == q then setPos q else failure
  where
    skipSpacesTo :: Env -> Int -> Int -> Int
    skipSpacesTo :: Env -> Int -> Int -> Int
skipSpacesTo Env
e Int
i Int
q
      | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
q Bool -> Bool -> Bool
&& Env -> Int -> Word8
byteAt Env
e Int
i Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
SPACE = Env -> Int -> Int -> Int
skipSpacesTo Env
e (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
q
      | Bool
otherwise = Int
i

-- | Count the spaces at the current position.
countSpaces :: P Int
countSpaces :: P Int
countSpaces = do
  e <- P Env
env
  p <- pos
  pure $ skipSpaces e p - p

-- | s-separate-in-line
sSeparateInLine :: P ()
sSeparateInLine :: P ()
sSeparateInLine = do
  e <- P Env
env
  p <- pos
  let q = Env -> Int -> Int
skipWhites Env
e Int
p
  if q > p then setPos q else startOfLine

-- | c-nb-comment-text
cNbCommentText :: P ()
cNbCommentText :: P ()
cNbCommentText = do
  Word8 -> P ()
char Word8
HASH
  (Word8 -> Bool) -> P ()
skipWhile ((Word8 -> Bool) -> P ()) -> (Word8 -> Bool) -> P ()
forall a b. (a -> b) -> a -> b
$ \Word8
w -> Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0 Bool -> Bool -> Bool
&& Bool -> Bool
not (Word8 -> Bool
isBreak Word8
w)

-- | b-break
bBreak :: P ()
bBreak :: P ()
bBreak = do
  e <- P Env
env
  p <- pos
  if isBreak (byteAt e p) then setPos (breakEnd e p) else failure

-- | b-comment
bComment :: P ()
bComment :: P ()
bComment = P ()
bBreak P () -> P () -> P ()
forall a. P a -> P a -> P a
<|> P ()
atEnd
  where
    atEnd :: P ()
    atEnd :: P ()
atEnd = do
      e <- P Env
env
      p <- pos
      guardP $ p >= e.end

-- | s-b-comment
sBComment :: P ()
sBComment :: P ()
sBComment = do
  P () -> P ()
forall a. P a -> P ()
optional_ (P () -> P ()) -> P () -> P ()
forall a b. (a -> b) -> a -> b
$ P ()
sSeparateInLine P () -> P () -> P ()
forall a b. P a -> P b -> P b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P () -> P ()
forall a. P a -> P ()
optional_ P ()
cNbCommentText
  P ()
bComment

-- | l-comment
lComment :: P ()
lComment :: P ()
lComment = do
  P ()
sSeparateInLine
  P () -> P ()
forall a. P a -> P ()
optional_ P ()
cNbCommentText
  P ()
bComment

-- | s-l-comments
sLComments :: P ()
sLComments :: P ()
sLComments = do
  P ()
sBComment P () -> P () -> P ()
forall a. P a -> P a -> P a
<|> P ()
startOfLine
  P () -> P ()
forall a. P a -> P ()
many_ P ()
lComment

-- | s-separate(n,c)
sSeparate :: Int -> Ctx -> P ()
sSeparate :: Int -> Ctx -> P ()
sSeparate Int
n Ctx
c
  | Ctx -> Bool
isKeyCtx Ctx
c = P ()
sSeparateInLine
  | Bool
otherwise = Int -> P ()
sSeparateLines Int
n

-- | s-separate-lines(n)
sSeparateLines :: Int -> P ()
sSeparateLines :: Int -> P ()
sSeparateLines Int
n = (P ()
sLComments P () -> P () -> P ()
forall a b. P a -> P b -> P b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> P ()
sFlowLinePrefix Int
n) P () -> P () -> P ()
forall a. P a -> P a -> P a
<|> P ()
sSeparateInLine

-- | s-flow-line-prefix(n)
sFlowLinePrefix :: Int -> P ()
sFlowLinePrefix :: Int -> P ()
sFlowLinePrefix Int
n = do
  Int -> P ()
sIndent Int
n
  P () -> P ()
forall a. P a -> P ()
optional_ P ()
sSeparateInLine

----------------------------------------
-- Stream

defaultHandles :: M.Map T.Text T.Text
defaultHandles :: Map Text Text
defaultHandles = [(Text, Text)] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Text
"!", Text
"!"), (Text
"!!", Text
coreTagPrefix)]

-- | l-yaml-stream. The markers are the indices of the lines that start with
-- a document marker.
lYamlStream :: [Int] -> P [Document]
lYamlStream :: [Int] -> P [Document]
lYamlStream [Int]
markers0 = do
  s <- P Int
pos
  documents markers0 True s
  where
    -- The last argument is the index where the comments of the next
    -- document start.
    documents :: [Int] -> Bool -> Int -> P [Document]
    documents :: [Int] -> Bool -> Int -> P [Document]
documents [Int]
markers Bool
afterEnd Int
prefix = do
      s <- P Int
pos
      -- A byte order mark can come before a marker after a bare document.
      lDocumentPrefix
      e <- env
      p <- pos
      if
        | p >= e.end -> pure []
        | isEndMarker e p -> do
            lDocumentSuffix
            documents markers True prefix
        | isMarker e p -> document markers Nothing defaultHandles prefix
        | afterEnd && byteAt e p == PERCENT -> do
            (version, hs) <- directives
            q <- pos
            unless (isStartMarker e q) $
              throwAt q "expected a document start marker (---) after the directives"
            document markers version hs prefix
        | afterEnd -> bareDocument markers prefix
        -- A byte order mark on an empty line or a comment line ends a bare
        -- document, so it is the likely mistake.
        | Just b <- bomLine e s p -> throwAt b "unexpected byte order mark"
        | otherwise -> throwAt p "expected a document start marker (---)"

    -- The first line between the indices that starts with a byte order mark.
    bomLine :: Env -> Int -> Int -> Maybe Int
    bomLine :: Env -> Int -> Int -> Maybe Int
bomLine Env
e Int
i Int
j
      | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
j = Maybe Int
forall a. Maybe a
Nothing
      | Env -> Int -> Bool
isBom Env
e Int
i = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i
      | Bool
otherwise = Env -> Int -> Int -> Maybe Int
bomLine Env
e (Env -> Int -> Int
nextLineStart Env
e Int
i) Int
j

    document :: [Int] -> Maybe YamlVersion -> M.Map T.Text T.Text -> Int -> P [Document]
    document :: [Int] -> Maybe YamlVersion -> Map Text Text -> Int -> P [Document]
document [Int]
markers Maybe YamlVersion
version Map Text Text
hs Int
prefix = do
      m <- P Int
pos
      advance markerLength
      p <- pos
      e <- env
      let (limit, markers') = nextMarker e markers p
      root <-
        withEnd limit . withHandles hs $
          lBareDocument <|> (eNode <* sLComments)
      finishDocument markers' version prefix (Just m) limit root

    bareDocument :: [Int] -> Int -> P [Document]
    bareDocument :: [Int] -> Int -> P [Document]
bareDocument [Int]
markers Int
prefix = do
      p <- P Int
pos
      e <- env
      let (limit, markers') = nextMarker e markers p
      root <-
        withEnd limit lBareDocument <|> do
          fu <- furthest
          throwUnexpected fu
      finishDocument markers' Nothing prefix Nothing limit root

    -- The end of the document that starts at the index, and the markers
    -- after it.
    nextMarker :: Env -> [Int] -> Int -> (Int, [Int])
    nextMarker :: Env -> [Int] -> Int -> (Int, [Int])
nextMarker Env
e [Int]
markers Int
p = case (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
p) [Int]
markers of
      Int
m : [Int]
ms -> (Int
m, Int
m Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
ms)
      [] -> (Env
e.end, [])

    finishDocument
      :: [Int] -> Maybe YamlVersion -> Int -> Maybe Int -> Int -> Node -> P [Document]
    finishDocument :: [Int]
-> Maybe YamlVersion
-> Int
-> Maybe Int
-> Int
-> Node
-> P [Document]
finishDocument [Int]
markers Maybe YamlVersion
version Int
prefix Maybe Int
marker Int
limit Node
root = do
      Int -> P () -> P ()
forall a. Int -> P a -> P a
withEnd Int
limit (P () -> P ()) -> P () -> P ()
forall a b. (a -> b) -> a -> b
$ P () -> P ()
forall a. P a -> P ()
many_ P ()
lComment
      e <- P Env
env
      p <- pos
      when (p < limit && not (startsPrefix e p)) $ do
        fu <- furthest
        throwUnexpected (max fu p)
      let explicitEnd = Env -> Int -> Bool
isEndMarker Env
e Int
p
      when explicitEnd lDocumentSuffix
      q <- pos
      -- The first empty line after the end marker ends the lines of the
      -- document.
      let gap = Env -> Int -> Int
gapEnd Env
e Int
q
      rest <- documents markers explicitEnd gap
      let !(!doc, next) =
            attachComments
              e
              (prefix == streamStart e)
              (not (null rest))
              prefix
              marker
              p
              -- The lines after the last document belong to its end, also
              -- after more end markers.
              (if null rest then e.end else gap)
              Document
                { version = version
                , explicitStart = isJust marker
                , explicitEnd = explicitEnd
                , docComments = noComments
                , root = root
                }
          !rest' = [Line] -> [Document] -> [Document]
linesAbove [Line]
next [Document]
rest
      pure (doc : rest')

-- | l-document-prefix, repeated.
lDocumentPrefix :: P ()
lDocumentPrefix :: P ()
lDocumentPrefix = P () -> P ()
forall a. P a -> P ()
many_ (P () -> P ()) -> P () -> P ()
forall a b. (a -> b) -> a -> b
$ do
  e <- P Env
env
  p <- pos
  if isBom e p then advance bomLength else lComment

-- | l-document-suffix, without the comment lines after it. They belong to the
-- next document.
lDocumentSuffix :: P ()
lDocumentSuffix :: P ()
lDocumentSuffix = do
  Int -> P ()
advance Int
markerLength
  e <- P Env
env
  p <- pos
  sBComment
    <|> throwAt (skipWhites e p) "unexpected content after the document end marker (...)"

-- | l-directive, repeated, with the version and the tag handles they define.
directives :: P (Maybe YamlVersion, M.Map T.Text T.Text)
directives :: P (Maybe YamlVersion, Map Text Text)
directives = Maybe YamlVersion
-> Map Text Text
-> Set Text
-> P (Maybe YamlVersion, Map Text Text)
go Maybe YamlVersion
forall a. Maybe a
Nothing Map Text Text
defaultHandles Set Text
forall a. Set a
Set.empty
  where
    go
      :: Maybe YamlVersion
      -> M.Map T.Text T.Text
      -> Set.Set T.Text
      -> P (Maybe YamlVersion, M.Map T.Text T.Text)
    go :: Maybe YamlVersion
-> Map Text Text
-> Set Text
-> P (Maybe YamlVersion, Map Text Text)
go Maybe YamlVersion
version Map Text Text
hs Set Text
defined = do
      w <- P Word8
peek
      if w /= PERCENT
        then pure (version, hs)
        else do
          p <- pos
          advance 1
          name <- directiveName
          case name of
            Text
"YAML" -> do
              Bool -> P () -> P ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe YamlVersion -> Bool
forall a. Maybe a -> Bool
isJust Maybe YamlVersion
version) (P () -> P ()) -> P () -> P ()
forall a b. (a -> b) -> a -> b
$
                Int -> [Char] -> P ()
forall a. Int -> [Char] -> P a
throwAt Int
p [Char]
"duplicate %YAML directive"
              v <- Int -> P YamlVersion
yamlVersion Int
p
              sLComments <|> throwAfter "unexpected content after the %YAML version"
              go (Just v) hs defined
            Text
"TAG" -> do
              (handle, prefix) <- P (Text, Text)
tagDirective
              when (handle `Set.member` defined) . throwAt p $
                "duplicate %TAG directive for " ++ T.unpack handle
              sLComments <|> throwAfter "unexpected content after the tag prefix"
              go version (M.insert handle prefix hs) (Set.insert handle defined)
            Text
_ -> do
              P () -> P ()
forall a. P a -> P ()
many_ (P () -> P ()) -> P () -> P ()
forall a b. (a -> b) -> a -> b
$ P ()
sSeparateInLine P () -> P () -> P ()
forall a b. P a -> P b -> P b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
directiveParameter
              P ()
sLComments P () -> P () -> P ()
forall a. P a -> P a -> P a
<|> Int -> [Char] -> P ()
forall a. Int -> [Char] -> P a
throwAt Int
p [Char]
"invalid directive"
              Maybe YamlVersion
-> Map Text Text
-> Set Text
-> P (Maybe YamlVersion, Map Text Text)
go Maybe YamlVersion
version Map Text Text
hs Set Text
defined

    -- Fail at the content after the white space at the position.
    throwAfter :: String -> P a
    throwAfter :: forall a. [Char] -> P a
throwAfter [Char]
msg = do
      e <- P Env
env
      q <- pos
      throwAt (skipWhites e q) msg

    -- s-separate-in-line between the parts of a directive, or the error.
    separator :: String -> P ()
    separator :: [Char] -> P ()
separator [Char]
msg = do
      w <- P Word8
peek
      unless (isWhite w) $ throwAfter msg
      sSeparateInLine

    directiveName :: P T.Text
    directiveName :: P Text
directiveName = do
      e <- P Env
env
      p <- pos
      skipWhile isNsChar
      q <- pos
      when (q == p) $ throwAt p "expected a directive name"
      pure $ slice e p q

    directiveParameter :: P ()
    directiveParameter :: P ()
directiveParameter = do
      p <- P Int
pos
      skipWhile isNsChar
      q <- pos
      guardP (q > p)

    yamlVersion :: Int -> P YamlVersion
    yamlVersion :: Int -> P YamlVersion
yamlVersion Int
p = do
      [Char] -> P ()
separator [Char]
badVersion
      v <- P Int
pos
      major <- number v
      char DOT <|> throwAt v badVersion
      minor <- number v
      w' <- peek
      when (isNsChar w') $ throwAt v badVersion
      when (major /= 1) . throwAt p $
        "unsupported YAML version " ++ show major ++ "." ++ show minor
      pure $ YamlVersion major minor
      where
        badVersion :: String
        badVersion :: [Char]
badVersion = [Char]
"expected a version such as 1.2 after %YAML"

        number :: Int -> P Int
        number :: Int -> P Int
number Int
v = do
          e <- P Env
env
          q <- pos
          skipWhile isDecDigit
          r <- pos
          when (r == q) $ throwAt v badVersion
          maybe (throwAt p "unsupported YAML version") pure $ readVersion (slice e q r)
          where
            -- The value of the digits, or 'Nothing' beyond 'maxVersion'.
            readVersion :: T.Text -> Maybe Int
            readVersion :: Text -> Maybe Int
readVersion = (Maybe Int -> Char -> Maybe Int) -> Maybe Int -> Text -> Maybe Int
forall a. (a -> Char -> a) -> a -> Text -> a
T.foldl' Maybe Int -> Char -> Maybe Int
step (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0)

            step :: Maybe Int -> Char -> Maybe Int
            step :: Maybe Int -> Char -> Maybe Int
step Maybe Int
acc Char
c = do
              n <- Maybe Int
acc
              let n' = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
digitToInt Char
c
              guard (n' <= maxVersion)
              pure n'

    tagDirective :: P (T.Text, T.Text)
    tagDirective :: P (Text, Text)
tagDirective = do
      e <- P Env
env
      separator
        "expected a tag handle and a prefix after %TAG, e.g. %TAG !e! tag:example.com,2000:"
      h <- pos
      handle <- cTagHandle <|> throwAt h "invalid tag handle"
      w <- peek
      let lineEnd = Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0 Bool -> Bool -> Bool
|| Word8 -> Bool
isBreak Word8
w
      -- A named handle without its closing '!' reads as the primary handle.
      when (handle == "!" && not (lineEnd || isWhite w)) $ throwAt h "invalid tag handle"
      separator (if lineEnd then noPrefix else "expected a space after the tag handle")
      q <- pos
      first <- peek
      when (first == 0 || isBreak first || first == HASH) $ throwAt q noPrefix
      unless (first == EXCL || isTagChar first || first == PERCENT) $
        throwAt q "invalid tag prefix"
      when (first == EXCL) $ advance 1
      scan uriChars
      r <- pos
      invalidEscape r
      -- The escapes of the prefix and of the suffix of a tag can form one
      -- character, so the prefix stays encoded.
      pure (handle, slice e q r)
      where
        noPrefix :: String
        noPrefix :: [Char]
noPrefix = [Char]
"expected a prefix after the tag handle, e.g. tag:example.com,2000:"

-- | c-tag-handle
cTagHandle :: P T.Text
cTagHandle :: P Text
cTagHandle = do
  e <- P Env
env
  p <- pos
  char EXCL
  named e p <|> secondary e p <|> pure "!"
  where
    named :: Env -> Int -> P T.Text
    named :: Env -> Int -> P Text
named Env
e Int
p = do
      (Word8 -> Bool) -> P ()
skipWhile Word8 -> Bool
isWordChar
      q <- P Int
pos
      guardP (q > p + 1)
      char EXCL
      slice e p <$> pos

    secondary :: Env -> Int -> P T.Text
    secondary :: Env -> Int -> P Text
secondary Env
e Int
p = do
      Word8 -> P ()
char Word8
EXCL
      Env -> Int -> Int -> Text
slice Env
e Int
p (Int -> Text) -> P Int -> P Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P Int
pos

-- | Skip ns-uri-char*.
uriChars :: Env -> Int -> Int
uriChars :: Env -> Int -> Int
uriChars Env
e Int
i
  | Word8 -> Bool
isUriChar (Env -> Int -> Word8
byteAt Env
e Int
i) = Env -> Int -> Int
uriChars Env
e (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
  | Env -> Int -> Bool
isPercentEscape Env
e Int
i = Env -> Int -> Int
uriChars Env
e (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
percentEscapeLength)
  | Bool
otherwise = Int
i

percentEscapeLength :: Int
percentEscapeLength :: Int
percentEscapeLength = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
percentDigits

isPercentEscape :: Env -> Int -> Bool
isPercentEscape :: Env -> Int -> Bool
isPercentEscape Env
e Int
i =
  Env -> Int -> Word8
byteAt Env
e Int
i Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
PERCENT Bool -> Bool -> Bool
&& (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Word8 -> Bool
isHexDigit' (Word8 -> Bool) -> (Int -> Word8) -> Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Env -> Int -> Word8
byteAt Env
e) [Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 .. Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
percentDigits]

-- | Stop with an error if a @%@ without two hexadecimal digits after it is at
-- the index, after the valid characters of a tag.
invalidEscape :: Int -> P ()
invalidEscape :: Int -> P ()
invalidEscape Int
i = do
  e <- P Env
env
  when (byteAt e i == PERCENT) $
    throwAt i "invalid escape in the tag, write '%' and two hexadecimal digits"

-- | l-bare-document
lBareDocument :: P Node
lBareDocument :: P Node
lBareDocument = Int -> Ctx -> P Node
sLBlockNode (-Int
1) Ctx
BlockIn

----------------------------------------
-- Nodes

-- | e-node
eNode :: P Node
eNode :: P Node
eNode = Props -> P Node
eScalar Props
noProps

-- | e-scalar with properties.
eScalar :: Props -> P Node
eScalar :: Props -> P Node
eScalar Props
props = do
  e <- P Env
env
  p <- pos
  pure $! mkNode e p (toOffset e p) props (emptyContent e)

-- | c-ns-properties(n,c)
cNsProperties :: Int -> Ctx -> P Props
cNsProperties :: Int -> Ctx -> P Props
cNsProperties Int
n Ctx
c = P Props
tagFirst P Props -> P Props -> P Props
forall a. P a -> P a -> P a
<|> P Props
anchorFirst
  where
    tagFirst :: P Props
    tagFirst :: P Props
tagFirst = do
      t <- P Tag
cNsTagProperty
      a <- optional $ sSeparate n c >> cNsAnchorProperty
      pure $ Props a t

    anchorFirst :: P Props
    anchorFirst :: P Props
anchorFirst = do
      a <- P Text
cNsAnchorProperty
      t <- option NoTag $ sSeparate n c >> cNsTagProperty
      pure $ Props (Just a) t

-- | c-ns-anchor-property
cNsAnchorProperty :: P T.Text
cNsAnchorProperty :: P Text
cNsAnchorProperty = do
  Word8 -> P ()
char Word8
AMP
  P Text
nsAnchorName

-- | ns-anchor-name
nsAnchorName :: P T.Text
nsAnchorName :: P Text
nsAnchorName = do
  e <- P Env
env
  p <- pos
  skipWhile isAnchorChar
  q <- pos
  guardP (q > p)
  pure $ slice e p q

-- | c-ns-tag-property
cNsTagProperty :: P Tag
cNsTagProperty :: P Tag
cNsTagProperty = do
  e <- P Env
env
  p <- pos
  peek >>= guardP . (== EXCL)
  w <- peekAt 1
  if w == LESS
    then verbatim e p
    else shorthand e p <|> nonSpecific
  where
    verbatim :: Env -> Int -> P Tag
    verbatim :: Env -> Int -> P Tag
verbatim Env
e Int
p = do
      Word8 -> P ()
char Word8
EXCL
      Word8 -> P ()
char Word8
LESS
      q <- P Int
pos
      scan uriChars
      r <- pos
      w <- peek
      let t = Env -> Int -> Int -> Text
slice Env
e Int
q Int
r
      when (w /= GREATER || not (isLocal t || isGlobal t)) $
        throwAt p "invalid verbatim tag"
      advance 1
      case percentDecode t of
        Just Text
decoded -> Tag -> P Tag
forall a. a -> P a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Tag
Tag Text
decoded)
        Maybe Text
Nothing -> Int -> [Char] -> P Tag
forall a. Int -> [Char] -> P a
throwAt Int
p [Char]
"the escapes of the tag are not valid UTF-8"

    -- A local tag has a name after the "!".
    isLocal :: T.Text -> Bool
    isLocal :: Text -> Bool
isLocal Text
t = case Text -> Maybe (Char, Text)
T.uncons Text
t of
      Just (Char
'!', Text
rest) -> Bool -> Bool
not (Text -> Bool
T.null Text
rest)
      Maybe (Char, Text)
_ -> Bool
False

    -- A global tag is a URI, which starts with a scheme.
    isGlobal :: T.Text -> Bool
    isGlobal :: Text -> Bool
isGlobal Text
t = case Text -> Maybe (Char, Text)
T.uncons Text
t of
      Just (Char
c, Text
rest) ->
        Char -> Bool
isAsciiLetter Char
c Bool -> Bool -> Bool
&& case Text -> Maybe (Char, Text)
T.uncons ((Char -> Bool) -> Text -> Text
T.dropWhile Char -> Bool
isSchemeChar Text
rest) of
          Just (Char
':', Text
_) -> Bool
True
          Maybe (Char, Text)
_ -> Bool
False
      Maybe (Char, Text)
Nothing -> Bool
False

    isAsciiLetter :: Char -> Bool
    isAsciiLetter :: Char -> Bool
isAsciiLetter Char
c = Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
isAlpha Char
c

    isSchemeChar :: Char -> Bool
    isSchemeChar :: Char -> Bool
isSchemeChar Char
c = Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& (Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'+' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.')

    shorthand :: Env -> Int -> P Tag
    shorthand :: Env -> Int -> P Tag
shorthand Env
e Int
p = do
      handle <- P Text
cTagHandle
      q <- pos
      scan tagChars
      r <- pos
      invalidEscape r
      -- Only the primary handle "!" can stand alone, as the non-specific tag.
      when (r == q && handle /= "!") $
        throwAt r ("expected the rest of the tag after " ++ T.unpack handle)
      guardP (r > q)
      case M.lookup handle e.handles of
        Just Text
prefix -> do
          -- Each tag has its own copy of the prefix. The default prefixes
          -- are short, but a long prefix of a directive with many tags would
          -- take memory quadratic in the size of the input.
          Bool -> P () -> P ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
handle Map Text Text
defaultHandles Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just Text
prefix) (P () -> P ()) -> P () -> P ()
forall a b. (a -> b) -> a -> b
$ do
            added <- Int -> P Int
addTagBytes (Text -> Int
T.lengthWord8 Text
prefix)
            let limit = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
minExpansion (Env
e.streamEnd Int -> Int -> Int
forall a. Num a => a -> a -> a
- Env
e.base)
            when (added > limit) . throwAt p $
              "the prefixes of %TAG directives add more than "
                ++ show limit
                ++ " bytes to the tags"
          case Text -> Maybe Text
percentDecode (Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Env -> Int -> Int -> Text
slice Env
e Int
q Int
r) of
            Just Text
t -> Tag -> P Tag
forall a. a -> P a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Tag
Tag Text
t)
            Maybe Text
Nothing -> Int -> [Char] -> P Tag
forall a. Int -> [Char] -> P a
throwAt Int
p [Char]
"the escapes of the tag are not valid UTF-8"
        Maybe Text
Nothing -> Int -> [Char] -> P Tag
forall a. Int -> [Char] -> P a
throwAt Int
p ([Char] -> P Tag) -> [Char] -> P Tag
forall a b. (a -> b) -> a -> b
$ [Char]
"undefined tag handle " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
handle

    -- Skip ns-tag-char*.
    tagChars :: Env -> Int -> Int
    tagChars :: Env -> Int -> Int
tagChars Env
e Int
i
      | Word8 -> Bool
isTagChar (Env -> Int -> Word8
byteAt Env
e Int
i) = Env -> Int -> Int
tagChars Env
e (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      | Env -> Int -> Bool
isPercentEscape Env
e Int
i = Env -> Int -> Int
tagChars Env
e (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
percentEscapeLength)
      | Bool
otherwise = Int
i

    -- Decode the %XX escapes of a tag, or 'Nothing' if the bytes are not valid
    -- UTF-8.
    percentDecode :: T.Text -> Maybe T.Text
    percentDecode :: Text -> Maybe Text
percentDecode Text
t
      | (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'%') Text
t =
          (UnicodeException -> Maybe Text)
-> (Text -> Maybe Text)
-> Either UnicodeException Text
-> Maybe Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Text -> UnicodeException -> Maybe Text
forall a b. a -> b -> a
const Maybe Text
forall a. Maybe a
Nothing) Text -> Maybe Text
forall a. a -> Maybe a
Just (Either UnicodeException Text -> Maybe Text)
-> ([Word8] -> Either UnicodeException Text)
-> [Word8]
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either UnicodeException Text
T.decodeUtf8' (ByteString -> Either UnicodeException Text)
-> ([Word8] -> ByteString)
-> [Word8]
-> Either UnicodeException Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack ([Word8] -> Maybe Text) -> [Word8] -> Maybe Text
forall a b. (a -> b) -> a -> b
$ [Char] -> [Word8]
go (Text -> [Char]
T.unpack Text
t)
      | Bool
otherwise = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t
      where
        go :: String -> [Word8]
        go :: [Char] -> [Word8]
go = \case
          Char
'%' : Char
a : Char
b : [Char]
rest ->
            Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
digitToInt Char
a Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
digitToInt Char
b) Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: [Char] -> [Word8]
go [Char]
rest
          Char
c : [Char]
rest -> Char -> [Word8]
encodeChar Char
c [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Word8]
go [Char]
rest
          [] -> []

        encodeChar :: Char -> [Word8]
        encodeChar :: Char -> [Word8]
encodeChar Char
c = case Char -> Text
T.singleton Char
c of
          T.Text Array
arr Int
_ Int
len -> Array -> Int -> Int -> [Word8]
A.toList Array
arr Int
0 Int
len

    nonSpecific :: P Tag
    nonSpecific :: P Tag
nonSpecific = do
      Word8 -> P ()
char Word8
EXCL
      Tag -> P Tag
forall a. a -> P a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Tag
NonSpecificTag

-- | c-ns-alias-node
cNsAliasNode :: P Node
cNsAliasNode :: P Node
cNsAliasNode = do
  e <- P Env
env
  p <- pos
  char STAR
  name <- nsAnchorName
  q <- pos
  pure $! mkNode e p (toOffset e q) noProps (AliasContent name)

----------------------------------------
-- Flow scalars

-- | c-double-quoted(n,c)
cDoubleQuoted :: Int -> Ctx -> Props -> P Node
cDoubleQuoted :: Int -> Ctx -> Props -> P Node
cDoubleQuoted = ScalarStyle -> Int -> Ctx -> Props -> P Node
cQuoted ScalarStyle
DoubleQuoted

-- | c-single-quoted(n,c)
cSingleQuoted :: Int -> Ctx -> Props -> P Node
cSingleQuoted :: Int -> Ctx -> Props -> P Node
cSingleQuoted = ScalarStyle -> Int -> Ctx -> Props -> P Node
cQuoted ScalarStyle
SingleQuoted

-- | A double-quoted or a single-quoted scalar.
cQuoted :: ScalarStyle -> Int -> Ctx -> Props -> P Node
cQuoted :: ScalarStyle -> Int -> Ctx -> Props -> P Node
cQuoted ScalarStyle
style Int
n Ctx
c Props
props = (Env -> Int -> Scanned Node) -> P Node
forall a. (Env -> Int -> Scanned a) -> P a
withScan ((Env -> Int -> Scanned Node) -> P Node)
-> (Env -> Int -> Scanned Node) -> P Node
forall a b. (a -> b) -> a -> b
$ \Env
e Int
p ->
  let double :: Bool
      double :: Bool
double = ScalarStyle
style ScalarStyle -> ScalarStyle -> Bool
forall a. Eq a => a -> a -> Bool
== ScalarStyle
DoubleQuoted

      quote :: Word8
      quote :: Word8
quote = if Bool
double then Word8
DQUOTE else Word8
SQUOTE

      name :: String
      name :: [Char]
name = if Bool
double then [Char]
"double-quoted" else [Char]
"single-quoted"

      go :: Int -> Int -> [T.Text] -> Lines -> Scanned Content
      go :: Int -> Int -> [Text] -> Lines -> Scanned Content
go Int
seg Int
i [Text]
acc Lines
ls = case Env -> Int -> Word8
byteAt Env
e Int
i of
        Word8
w
          | Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
quote ->
              if Bool -> Bool
not Bool
double Bool -> Bool -> Bool
&& Env -> Int -> Word8
byteAt Env
e (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
SQUOTE
                then Int -> Int -> [Text] -> Lines -> Scanned Content
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) (Text
"'" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Env -> Int -> Int -> Text
slice Env
e Int
seg Int
i Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
acc) Lines
ls
                else Int -> Content -> Scanned Content
forall a. Int -> a -> Scanned a
Done (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Content -> Scanned Content) -> Content -> Scanned Content
forall a b. (a -> b) -> a -> b
$ case Lines
ls of
                  Lines
FirstLine -> ScalarStyle -> Text -> [Int] -> Content
ScalarLinesContent ScalarStyle
style ([Text] -> Text
finish (Env -> Int -> Int -> Text
slice Env
e Int
seg Int
i Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
acc)) []
                  Lines [Text]
ps [Int]
starts Int
_ -> [Text] -> [Text] -> [Int] -> Content
severalLines (Env -> Int -> Int -> Text
slice Env
e Int
seg Int
i Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
acc) [Text]
ps [Int]
starts
          | Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
BACKSLASH Bool -> Bool -> Bool
&& Bool
double -> Int -> Int -> [Text] -> Lines -> Scanned Content
backslash Int
seg Int
i [Text]
acc Lines
ls
          | Word8 -> Bool
isWhite Word8
w ->
              let j :: Int
j = Env -> Int -> Int
skipWhites Env
e Int
i
              in if Word8 -> Bool
isBreak (Env -> Int -> Word8
byteAt Env
e Int
j) then Int -> Int -> [Text] -> Scanned Content
fold Int
i Int
j [Text]
acc else Int -> Int -> [Text] -> Lines -> Scanned Content
go Int
seg Int
j [Text]
acc Lines
ls
          | Word8 -> Bool
isBreak Word8
w -> Int -> Int -> [Text] -> Scanned Content
fold Int
i Int
i [Text]
acc
          | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Env
e.end -> Int -> Scanned Content
endOfDocument Int
i
          | Bool
otherwise -> Int -> Int -> [Text] -> Lines -> Scanned Content
go Int
seg (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Text]
acc Lines
ls
        where
          fold :: Int -> Int -> [T.Text] -> Scanned Content
          fold :: Int -> Int -> [Text] -> Scanned Content
fold Int
contentEnd Int
brk [Text]
acc'
            | Ctx -> Bool
isKeyCtx Ctx
c = Int -> Scanned Content
forall a. Int -> Scanned a
NoMatch Int
brk
            | Bool
otherwise = case Env -> Int -> Int -> Maybe (Int, Int)
flowFold Env
e Int
n (Env -> Int -> Int
breakEnd Env
e Int
brk) of
                Just (Int
k, Int
j) ->
                  Int -> Int -> [Text] -> Lines -> Scanned Content
go Int
j Int
j [] ([Text] -> Lines -> Lines
newLine (Int -> Text
foldText Int
k Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Env -> Int -> Int -> Text
slice Env
e Int
seg Int
contentEnd Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
acc') Lines
ls)
                Maybe (Int, Int)
Nothing -> Int -> Scanned Content
badIndent Int
brk

      backslash :: Int -> Int -> [T.Text] -> Lines -> Scanned Content
      backslash :: Int -> Int -> [Text] -> Lines -> Scanned Content
backslash Int
seg Int
i [Text]
acc Lines
ls
        | Word8 -> Bool
isBreak (Env -> Int -> Word8
byteAt Env
e (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) =
            if Ctx -> Bool
isKeyCtx Ctx
c
              then Int -> Scanned Content
forall a. Int -> Scanned a
NoMatch Int
i
              else case Env -> Int -> Int -> Maybe (Int, Int)
flowFold Env
e Int
n (Env -> Int -> Int
breakEnd Env
e (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) of
                Just (Int
k, Int
j) ->
                  Int -> Int -> [Text] -> Lines -> Scanned Content
go Int
j Int
j [] ([Text] -> Lines -> Lines
newLine (Int -> Text -> Text
T.replicate Int
k Text
"\n" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Env -> Int -> Int -> Text
slice Env
e Int
seg Int
i Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
acc) Lines
ls)
                Maybe (Int, Int)
Nothing -> Int -> Scanned Content
badIndent (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        | Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Env
e.end = Int -> Scanned Content
endOfDocument Int
i
        | Bool
otherwise = case Env -> Int -> Maybe (Text, Int)
escape Env
e (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) of
            Just (Text
t, Int
j) -> Int -> Int -> [Text] -> Lines -> Scanned Content
go Int
j Int
j (Text
t Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Env -> Int -> Int -> Text
slice Env
e Int
seg Int
i Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
acc) Lines
ls
            Maybe (Text, Int)
Nothing -> Int -> [Char] -> Scanned Content
forall a. Int -> [Char] -> Scanned a
Failed Int
i (Int -> [Char]
badEscape Int
i)

      -- The scalar reaches the end of the document at the index.
      endOfDocument :: Int -> Scanned Content
      endOfDocument :: Int -> Scanned Content
endOfDocument Int
i
        | Ctx -> Bool
isKeyCtx Ctx
c = Int -> Scanned Content
forall a. Int -> Scanned a
NoMatch Int
i
        | Just Int
m <- Env -> Word8 -> Maybe Int
cutByMarker Env
e Word8
quote = Int -> [Char] -> Scanned Content
forall a. Int -> [Char] -> Scanned a
Failed Int
m (Env -> [Char] -> [Char]
markerInside Env
e ([Char]
name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" scalar"))
        | Bool
otherwise = Scanned Content
unterminated

      unterminated :: Scanned Content
      unterminated :: Scanned Content
unterminated = Int -> [Char] -> Scanned Content
forall a. Int -> [Char] -> Scanned a
Failed Int
p ([Char]
"unterminated " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" scalar")

      -- A hex escape with digits fails only for a bad code point. Any other
      -- invalid escape likely comes from a Windows path or a regular
      -- expression, e.g. "C:\Users" or "\d+".
      badEscape :: Int -> String
      badEscape :: Int -> [Char]
badEscape Int
i
        | forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem @[] (Int -> Char
chr (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Env -> Int -> Word8
byteAt Env
e (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)))) [Char]
"xuU"
        , Char -> Bool
isHexDigit (Int -> Char
chr (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Env -> Int -> Word8
byteAt Env
e (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)))) =
            [Char]
"invalid escape sequence"
        | Bool
otherwise =
            [Char]
"invalid escape sequence, write \\\\ for a backslash or use single quotes"

      badIndent :: Int -> Scanned Content
      badIndent :: Int -> Scanned Content
badIndent Int
i
        | Int -> Int
nextContent Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Env
e.end = Int -> Scanned Content
endOfDocument Int
i
        -- Without a closing quote, the line with a wrong indentation more
        -- likely follows a missing quote.
        | Bool -> Bool
not (Env -> Word8 -> Int -> Bool
closingQuoteFrom Env
e Word8
quote (Int -> Int
nextContent Int
i)) = Scanned Content
unterminated
        | Just Int
tab <- Env -> Int -> Int -> Maybe Int
firstTab Env
e (Int -> Int
foldStop Int
i) (Env -> Int -> Int
skipWhites Env
e (Int -> Int
foldStop Int
i)) =
            Int -> [Char] -> Scanned Content
forall a. Int -> [Char] -> Scanned a
Failed Int
tab [Char]
tabMessage
        | Bool
otherwise =
            Int -> [Char] -> Scanned Content
forall a. Int -> [Char] -> Scanned a
Failed
              (Int -> Int
nextContent Int
i)
              ([Char]
"invalid indentation of a line in a " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" scalar")

      nextContent :: Int -> Int
      nextContent :: Int -> Int
nextContent Int
i = Env -> Int -> Int
skipWhites Env
e (Int -> Int
skipBlankLines Int
i)

      -- The start of the line at which 'flowFold' stops after the line break
      -- at the index. A blank line can stop it with a tab before the
      -- indentation, as in "\"a\n\t\n  b\"".
      foldStop :: Int -> Int
      foldStop :: Int -> Int
foldStop Int
i =
        let l :: Int
l = Env -> Int -> Int
breakEnd Env
e Int
i
            s :: Int
s = Env -> Int -> Int
skipSpaces Env
e Int
l
        in if Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Env
e.end Bool -> Bool -> Bool
&& (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n Bool -> Bool -> Bool
|| Word8 -> Bool
isBreak (Env -> Int -> Word8
byteAt Env
e Int
s))
             then Int -> Int
foldStop (Env -> Int -> Int
lineEndAt Env
e Int
s)
             else Int
l

      -- Skip the line break at the index and the blank lines after it.
      skipBlankLines :: Int -> Int
      skipBlankLines :: Int -> Int
skipBlankLines Int
i =
        let j :: Int
j = Env -> Int -> Int
skipWhites Env
e (Env -> Int -> Int
breakEnd Env
e Int
i)
        in if Word8 -> Bool
isBreak (Env -> Int -> Word8
byteAt Env
e Int
j) then Int -> Int
skipBlankLines Int
j else Env -> Int -> Int
breakEnd Env
e Int
i

      -- Add the pieces of the current line, in reverse order, and start a new
      -- line after them.
      newLine :: [T.Text] -> Lines -> Lines
      newLine :: [Text] -> Lines -> Lines
newLine [Text]
acc = \case
        Lines
FirstLine -> [Text] -> [Int] -> Int -> Lines
next [] [] Int
0
        Lines [Text]
ps [Int]
ls Int
len -> [Text] -> [Int] -> Int -> Lines
next [Text]
ps [Int]
ls Int
len
        where
          next :: [T.Text] -> [Int] -> Int -> Lines
          next :: [Text] -> [Int] -> Int -> Lines
next [Text]
ps [Int]
ls Int
len =
            let len' :: Int
len' = Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((Text -> Int) -> [Text] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Int
T.length [Text]
acc)
            in [Text] -> [Int] -> Int -> Lines
Lines ([Text]
acc [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
ps) (Int
len' Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
ls) Int
len'

      -- The scalar from the pieces of its last line, and the pieces and the
      -- starts of the lines before it, all in reverse order.
      severalLines :: [T.Text] -> [T.Text] -> [Int] -> Content
      severalLines :: [Text] -> [Text] -> [Int] -> Content
severalLines [Text]
acc [Text]
ps [Int]
starts =
        ScalarStyle -> Text -> [Int] -> Content
ScalarLinesContent ScalarStyle
style ([Text] -> Text
finish ([Text]
acc [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
ps)) ([Int] -> [Int]
forall a. [a] -> [a]
reverse [Int]
starts)

      finish :: [T.Text] -> T.Text
      finish :: [Text] -> Text
finish = \case
        [Text
t] -> Text
t
        [Text]
ts -> [Text] -> Text
T.concat ([Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
ts)
  in case Int -> Int -> [Text] -> Lines -> Scanned Content
go (Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [] Lines
FirstLine of
       Done Int
q Content
content -> Int -> Node -> Scanned Node
forall a. Int -> a -> Scanned a
Done Int
q (Env -> Int -> Offset -> Props -> Content -> Node
mkNode Env
e Int
p (Env -> Int -> Offset
toOffset Env
e Int
q) Props
props Content
content)
       NoMatch Int
q -> Int -> Scanned Node
forall a. Int -> Scanned a
NoMatch Int
q
       Failed Int
q [Char]
msg -> Int -> [Char] -> Scanned Node
forall a. Int -> [Char] -> Scanned a
Failed Int
q [Char]
msg
-- Inlining gives a loop for each style. Without it, the parse benchmark of
-- the JSON input allocates more.
{-# INLINE cQuoted #-}

-- | A document marker ends the document, and the input after it has the
-- closing byte without a pair of its own, e.g. the closing quote of a scalar
-- that the marker cuts. Return the index of the marker.
cutByMarker :: Env -> Word8 -> Maybe Int
cutByMarker :: Env -> Word8 -> Maybe Int
cutByMarker Env
e Word8
w
  | Env
e.end Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Env
e.streamEnd, Bool
unpaired = Int -> Maybe Int
forall a. a -> Maybe a
Just Env
e.end
  | Bool
otherwise = Maybe Int
forall a. Maybe a
Nothing
  where
    unpaired :: Bool
    unpaired :: Bool
unpaired
      | Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
RBRACKET Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
RBRACE = Env -> Word8 -> Int -> Int -> Bool
unmatchedClosing Env
e Word8
w Env
e.end Env
e.streamEnd
      | Bool
otherwise = Env -> Word8 -> Int -> Bool
closingQuoteFrom Env
e {end = e.streamEnd} Word8
w Env
e.end

-- | The first quote from the index closes a quoted scalar with that quote.
-- Content right after the quote shows that it is not the closing quote, e.g.
-- the quote in "it's" of a plain scalar, or the opening quote of the next
-- scalar.
closingQuoteFrom :: Env -> Word8 -> Int -> Bool
closingQuoteFrom :: Env -> Word8 -> Int -> Bool
closingQuoteFrom Env
e Word8
w = Int -> Bool
go
  where
    go :: Int -> Bool
    go :: Int -> Bool
go Int
i
      | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Env
e.end = Bool
False
      | Word8
b Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
w Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
SQUOTE Bool -> Bool -> Bool
&& Env -> Int -> Word8
byteAt Env
e (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
SQUOTE = Int -> Bool
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
      | Word8
b Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
w = Env -> Int -> Bool
canEndFlowNode Env
e (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      | Word8
b Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
BACKSLASH Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
DQUOTE = Int -> Bool
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
      | Bool
otherwise = Int -> Bool
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      where
        b :: Word8
        b :: Word8
b = Env -> Int -> Word8
byteAt Env
e Int
i

-- | A closing bracket without an opening bracket of its own is in the input
-- from the first index to the second. Content right after a closing bracket
-- shows that it is a character of a plain scalar, e.g. in "a]b".
unmatchedClosing :: Env -> Word8 -> Int -> Int -> Bool
unmatchedClosing :: Env -> Word8 -> Int -> Int -> Bool
unmatchedClosing Env
e Word8
w Int
from Int
to = Int -> Int -> Bool
go Int
0 Int
from
  where
    go :: Int -> Int -> Bool
    go :: Int -> Int -> Bool
go Int
depth Int
i
      | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
to = Bool
False
      | Word8
b Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
w Bool -> Bool -> Bool
&& Env -> Int -> Bool
canEndFlowNode Env
range (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) = Int
depth Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Int -> Int -> Bool
go (Int
depth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      | Word8
b Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
opening = Int -> Int -> Bool
go (Int
depth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      | Bool
otherwise = Int -> Int -> Bool
go Int
depth (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      where
        b :: Word8
        b :: Word8
b = Array -> Int -> Word8
A.unsafeIndex Env
e.array Int
i

    range :: Env
    range :: Env
range = Env
e {end = to}

    opening :: Word8
    opening :: Word8
opening = if Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
RBRACKET then Word8
LBRACKET else Word8
LBRACE

-- | The error for the document marker that ends the document inside the
-- node.
markerInside :: Env -> String -> String
markerInside :: Env -> [Char] -> [Char]
markerInside Env
e [Char]
node =
  [Char]
"unexpected '"
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
markerLength (Int -> Char
chr (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Array -> Int -> Word8
A.unsafeIndex Env
e.array Env
e.end)))
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"' in a "
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
node
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
", indent the line"

-- | The lines of a scalar before its current line: the pieces of their text,
-- in reverse order, the positions where they start, in reverse order, and
-- the length of the pieces.
data Lines
  = FirstLine
  | Lines ![T.Text] ![Int] !Int

-- | The positions where the lines start, from the length of the first line
-- and the separators and the texts of the next lines.
lineStarts :: Int -> [T.Text] -> [Int]
lineStarts :: Int -> [Text] -> [Int]
lineStarts = [Int] -> Int -> [Text] -> [Int]
go []
  where
    go :: [Int] -> Int -> [T.Text] -> [Int]
    go :: [Int] -> Int -> [Text] -> [Int]
go [Int]
acc !Int
len = \case
      Text
sep : Text
t : [Text]
rest ->
        let !start :: Int
start = Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
T.length Text
sep
        in [Int] -> Int -> [Text] -> [Int]
go (Int
start Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
acc) (Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
T.length Text
t) [Text]
rest
      [Text]
_ -> [Int] -> [Int]
forall a. [a] -> [a]
reverse [Int]
acc

-- | Decode the escape sequence after a backslash.
escape :: Env -> Int -> Maybe (T.Text, Int)
escape :: Env -> Int -> Maybe (Text, Int)
escape Env
e Int
i = case Int -> Char
chr (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Env -> Int -> Word8
byteAt Env
e Int
i)) of
  Char
'0' -> Char -> Maybe (Text, Int)
simple Char
'\0'
  Char
'a' -> Char -> Maybe (Text, Int)
simple Char
'\a'
  Char
'b' -> Char -> Maybe (Text, Int)
simple Char
'\b'
  Char
't' -> Char -> Maybe (Text, Int)
simple Char
'\t'
  Char
'\t' -> Char -> Maybe (Text, Int)
simple Char
'\t'
  Char
'n' -> Char -> Maybe (Text, Int)
simple Char
'\n'
  Char
'v' -> Char -> Maybe (Text, Int)
simple Char
'\v'
  Char
'f' -> Char -> Maybe (Text, Int)
simple Char
'\f'
  Char
'r' -> Char -> Maybe (Text, Int)
simple Char
'\r'
  Char
'e' -> Char -> Maybe (Text, Int)
simple Char
'\ESC'
  Char
' ' -> Char -> Maybe (Text, Int)
simple Char
' '
  Char
'"' -> Char -> Maybe (Text, Int)
simple Char
'"'
  Char
'/' -> Char -> Maybe (Text, Int)
simple Char
'/'
  Char
'\\' -> Char -> Maybe (Text, Int)
simple Char
'\\'
  Char
'N' -> Char -> Maybe (Text, Int)
simple Char
'\x85'
  Char
'_' -> Char -> Maybe (Text, Int)
simple Char
'\xA0'
  Char
'L' -> Char -> Maybe (Text, Int)
simple Char
'\x2028'
  Char
'P' -> Char -> Maybe (Text, Int)
simple Char
'\x2029'
  Char
'x' -> Int -> Maybe (Text, Int)
codePoint Int
xEscapeDigits
  Char
'u' -> case Int -> Int -> Maybe Int
hexAt (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
uEscapeDigits of
    -- JSON escapes a character outside the Basic Multilingual Plane as a
    -- pair of surrogates.
    Just Int
hi
      | Int -> Bool
isHighSurrogate Int
hi
      , let second :: Int
second = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
uEscapeDigits
      , Env -> Int -> Word8
byteAt Env
e Int
second Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
BACKSLASH
      , Env -> Int -> Word8
byteAt Env
e (Int
second Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
LOWER_U
      , Just Int
lo <- Int -> Int -> Maybe Int
hexAt (Int
second Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Int
uEscapeDigits
      , Int -> Bool
isLowSurrogate Int
lo ->
          Int -> Int -> Maybe (Text, Int)
fromCodePoint (Int -> Int -> Int
fromSurrogates Int
hi Int
lo) (Int
second Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
uEscapeDigits)
    Maybe Int
_ -> Int -> Maybe (Text, Int)
codePoint Int
uEscapeDigits
  Char
'U' -> Int -> Maybe (Text, Int)
codePoint Int
bigUEscapeDigits
  Char
_ -> Maybe (Text, Int)
forall a. Maybe a
Nothing
  where
    simple :: Char -> Maybe (T.Text, Int)
    simple :: Char -> Maybe (Text, Int)
simple Char
ch = (Text, Int) -> Maybe (Text, Int)
forall a. a -> Maybe a
Just (Char -> Text
T.singleton Char
ch, Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

    codePoint :: Int -> Maybe (T.Text, Int)
    codePoint :: Int -> Maybe (Text, Int)
codePoint Int
k = do
      cp <- Int -> Int -> Maybe Int
hexAt (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
k
      fromCodePoint cp (i + 1 + k)

    fromCodePoint :: Int -> Int -> Maybe (T.Text, Int)
    fromCodePoint :: Int -> Int -> Maybe (Text, Int)
fromCodePoint Int
cp Int
next
      | Int -> Bool
isScalarValue Int
cp = (Text, Int) -> Maybe (Text, Int)
forall a. a -> Maybe a
Just (Char -> Text
T.singleton (Int -> Char
chr Int
cp), Int
next)
      | Bool
otherwise = Maybe (Text, Int)
forall a. Maybe a
Nothing

    -- The value of k hex digits at the index.
    hexAt :: Int -> Int -> Maybe Int
    hexAt :: Int -> Int -> Maybe Int
hexAt Int
j Int
k
      | (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Word8 -> Bool
isHexDigit' (Word8 -> Bool) -> (Int -> Word8) -> Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Env -> Int -> Word8
byteAt Env
e) [Int
j .. Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] =
          Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int) -> Int -> [Int] -> Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Int
acc Int
x -> Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word8 -> Int
hexValue (Env -> Int -> Word8
byteAt Env
e Int
x)) Int
0 [Int
j .. Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
      | Bool
otherwise = Maybe Int
forall a. Maybe a
Nothing

-- | ns-plain(n,c)
nsPlain :: Int -> Ctx -> Props -> P Node
nsPlain :: Int -> Ctx -> Props -> P Node
nsPlain Int
n Ctx
c Props
props = (Env -> Int -> Scanned Node) -> P Node
forall a. (Env -> Int -> Scanned a) -> P a
withScan ((Env -> Int -> Scanned Node) -> P Node)
-> (Env -> Int -> Scanned Node) -> P Node
forall a b. (a -> b) -> a -> b
$ \Env
e Int
p ->
  let w0 :: Word8
w0 = Env -> Int -> Word8
byteAt Env
e Int
p
      -- A byte order mark in a plain scalar is an error after the parse, but
      -- a scalar that starts with one would take in the lines below it.
      firstOk :: Bool
firstOk =
        Bool -> Bool
not (Env -> Int -> Bool
startsPrefix Env
e Int
p)
          Bool -> Bool -> Bool
&& ( (Word8 -> Bool
isNsChar Word8
w0 Bool -> Bool -> Bool
&& Bool -> Bool
not (Word8 -> Bool
isIndicator Word8
w0) Bool -> Bool -> Bool
&& Bool -> Bool
not (Env -> Int -> Bool
isBom Env
e Int
p))
                 Bool -> Bool -> Bool
|| ( (Word8
w0 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
QUESTION Bool -> Bool -> Bool
|| Word8
w0 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
COLON Bool -> Bool -> Bool
|| Word8
w0 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
MINUS)
                        Bool -> Bool -> Bool
&& Bool -> Word8 -> Bool
isPlainSafe (Ctx -> Bool
isFlowCtx Ctx
c) (Env -> Int -> Word8
byteAt Env
e (Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
                    )
             )
  in if Bool -> Bool
not Bool
firstOk
       then Int -> Scanned Node
forall a. Int -> Scanned a
NoMatch Int
p
       else
         let q :: Int
q = Env -> Ctx -> Int -> Int
plainLine Env
e Ctx
c (Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
             first :: Text
first = Env -> Int -> Int -> Text
slice Env
e Int
p Int
q
             node :: Int -> Text -> [Int] -> Node
node Int
end Text
t [Int]
ls =
               Env -> Int -> Offset -> Props -> Content -> Node
mkNode Env
e Int
p (Env -> Int -> Offset
toOffset Env
e Int
end) Props
props (ScalarStyle -> Text -> [Int] -> Content
ScalarLinesContent ScalarStyle
Plain Text
t [Int]
ls)
         in if Ctx -> Bool
isKeyCtx Ctx
c
              then Int -> Node -> Scanned Node
forall a. Int -> a -> Scanned a
Done Int
q (Int -> Text -> [Int] -> Node
node Int
q Text
first [])
              else case Env -> Int -> Ctx -> Int -> ([Text], Int)
plainNextLines Env
e Int
n Ctx
c Int
q of
                ([], Int
_) -> Int -> Node -> Scanned Node
forall a. Int -> a -> Scanned a
Done Int
q (Int -> Text -> [Int] -> Node
node Int
q Text
first [])
                ([Text]
ts, Int
r) ->
                  Int -> Node -> Scanned Node
forall a. Int -> a -> Scanned a
Done Int
r (Int -> Text -> [Int] -> Node
node Int
r ([Text] -> Text
T.concat (Text
first Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
ts)) (Int -> [Text] -> [Int]
lineStarts (Text -> Int
T.length Text
first) [Text]
ts))

-- | The end of the plain scalar content on the current line.
plainLine :: Env -> Ctx -> Int -> Int
plainLine :: Env -> Ctx -> Int -> Int
plainLine Env
e Ctx
c = Int -> Int
go
  where
    go :: Int -> Int
    go :: Int -> Int
go Int
i
      | Bool -> Word8 -> Bool
isPlainSafe Bool
flow Word8
w Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
COLON = Int -> Int
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      | Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
COLON Bool -> Bool -> Bool
&& Bool -> Word8 -> Bool
isPlainSafe Bool
flow (Env -> Int -> Word8
byteAt Env
e (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) = Int -> Int
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      | Word8 -> Bool
isWhite Word8
w =
          let j :: Int
j = Env -> Int -> Int
skipWhites Env
e Int
i
          in if Int -> Bool
plainCharAfterWhite Int
j then Int -> Int
go (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) else Int
i
      | Bool
otherwise = Int
i
      where
        w :: Word8
        w :: Word8
w = Env -> Int -> Word8
byteAt Env
e Int
i

    plainCharAfterWhite :: Int -> Bool
    plainCharAfterWhite :: Int -> Bool
plainCharAfterWhite Int
j =
      let w :: Word8
w = Env -> Int -> Word8
byteAt Env
e Int
j
      in Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
HASH
           Bool -> Bool -> Bool
&& Bool -> Word8 -> Bool
isPlainSafe Bool
flow Word8
w
           Bool -> Bool -> Bool
&& (Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
COLON Bool -> Bool -> Bool
|| Bool -> Word8 -> Bool
isPlainSafe Bool
flow (Env -> Int -> Word8
byteAt Env
e (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)))

    flow :: Bool
    flow :: Bool
flow = Ctx -> Bool
isFlowCtx Ctx
c

-- | s-ns-plain-next-line(n,c)*. Return the text of the next lines and the
-- index after them.
plainNextLines :: Env -> Int -> Ctx -> Int -> ([T.Text], Int)
plainNextLines :: Env -> Int -> Ctx -> Int -> ([Text], Int)
plainNextLines Env
e Int
n Ctx
c = Int -> ([Text], Int)
go
  where
    go :: Int -> ([T.Text], Int)
    go :: Int -> ([Text], Int)
go Int
q =
      let j :: Int
j = Env -> Int -> Int
skipWhites Env
e Int
q
      in if Bool -> Bool
not (Word8 -> Bool
isBreak (Env -> Int -> Word8
byteAt Env
e Int
j))
           then ([], Int
q)
           else case Env -> Int -> Int -> Maybe (Int, Int)
flowFold Env
e Int
n (Env -> Int -> Int
breakEnd Env
e Int
j) of
             Just (Int
k, Int
t)
               | Int -> Bool
startsPlain Int
t ->
                   let q' :: Int
q' = Env -> Ctx -> Int -> Int
plainLine Env
e Ctx
c (Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                       ([Text]
ts, Int
r) = Int -> ([Text], Int)
go Int
q'
                   in (Int -> Text
foldText Int
k Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Env -> Int -> Int -> Text
slice Env
e Int
t Int
q' Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
ts, Int
r)
             Maybe (Int, Int)
_ -> ([], Int
q)

    startsPlain :: Int -> Bool
    startsPlain :: Int -> Bool
startsPlain Int
t =
      let w :: Word8
w = Env -> Int -> Word8
byteAt Env
e Int
t
      in Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
HASH
           Bool -> Bool -> Bool
&& Bool -> Bool
not (Env -> Int -> Bool
startsPrefix Env
e Int
t)
           Bool -> Bool -> Bool
&& Bool -> Word8 -> Bool
isPlainSafe Bool
flow Word8
w
           Bool -> Bool -> Bool
&& (Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
COLON Bool -> Bool -> Bool
|| Bool -> Word8 -> Bool
isPlainSafe Bool
flow (Env -> Int -> Word8
byteAt Env
e (Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)))

    flow :: Bool
    flow :: Bool
flow = Ctx -> Bool
isFlowCtx Ctx
c

----------------------------------------
-- Flow collections

-- | c-flow-sequence(n,c)
cFlowSequence :: Int -> Ctx -> Props -> P Node
cFlowSequence :: Int -> Ctx -> Props -> P Node
cFlowSequence Int
n Ctx
c Props
props = do
  e <- P Env
env
  p <- pos
  char LBRACKET
  optional_ $ sSeparate n c
  entries <- flowEntries n c' (nsFlowSeqEntry n c')
  closing c' p RBRACKET "flow sequence" entries "expected ',' or ']'"
  q <- pos
  pure $! mkNode e p (toOffset e q) props (SequenceContent Flow entries)
  where
    c' :: Ctx
    c' :: Ctx
c' = Ctx -> Ctx
inFlow Ctx
c

-- | c-flow-mapping(n,c)
cFlowMapping :: Int -> Ctx -> Props -> P Node
cFlowMapping :: Int -> Ctx -> Props -> P Node
cFlowMapping Int
n Ctx
c Props
props = do
  e <- P Env
env
  p <- pos
  char LBRACE
  optional_ $ sSeparate n c
  entries <- flowEntries n c' (nsFlowMapEntry n c')
  closing c' p RBRACE "flow mapping" [] (expected entries)
  q <- pos
  pure $! mkNode e p (toOffset e q) props (MappingContent Flow entries)
  where
    c' :: Ctx
    c' :: Ctx
c' = Ctx -> Ctx
inFlow Ctx
c

    -- After a key with no value, the most likely mistake is a missing colon,
    -- e.g. in {"a" 1}.
    expected :: [(Node, Node)] -> String
    expected :: [(Node, Node)] -> [Char]
expected [(Node, Node)]
entries = case [(Node, Node)] -> [(Node, Node)]
forall a. [a] -> [a]
reverse [(Node, Node)]
entries of
      (Node
k, Node
v) : [(Node, Node)]
_
        | Node
v.content Content -> Content -> Bool
forall a. Eq a => a -> a -> Bool
== ScalarStyle -> Text -> Content
ScalarContent ScalarStyle
Plain Text
T.empty
        , Node
v.props Props -> Props -> Bool
forall a. Eq a => a -> a -> Bool
== Props
noProps
        , Node
v.offset Offset -> Offset -> Bool
forall a. Eq a => a -> a -> Bool
== Node
k.endOffset ->
            [Char]
"expected ':', ',' or '}'"
      [(Node, Node)]
_ -> [Char]
"expected ',' or '}'"

-- | ns-s-flow-seq-entries(n,c) and ns-s-flow-map-entries(n,c).
flowEntries :: forall a. Int -> Ctx -> P a -> P [a]
flowEntries :: forall a. Int -> Ctx -> P a -> P [a]
flowEntries Int
n Ctx
c P a
entry = [a] -> P [a]
go []
  where
    -- Each choice ends before the next entry, so that the stack does not
    -- grow with the number of entries.
    go :: [a] -> P [a]
    go :: [a] -> P [a]
go [a]
acc =
      P a -> P (Maybe a)
forall a. P a -> P (Maybe a)
optional P a
entry P (Maybe a) -> (Maybe a -> P [a]) -> P [a]
forall a b. P a -> (a -> P b) -> P b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe a
Nothing -> [a] -> P [a]
forall a. a -> P a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a] -> P [a]) -> [a] -> P [a]
forall a b. (a -> b) -> a -> b
$! [a] -> [a]
forall a. [a] -> [a]
reverse [a]
acc
        Just a
x -> do
          P () -> P ()
forall a. P a -> P ()
optional_ (P () -> P ()) -> P () -> P ()
forall a b. (a -> b) -> a -> b
$ Int -> Ctx -> P ()
sSeparate Int
n Ctx
c
          more <- (Bool
True Bool -> P () -> P Bool
forall a b. a -> P b -> P a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Word8 -> P ()
char Word8
COMMA P () -> P () -> P ()
forall a b. P a -> P b -> P b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P () -> P ()
forall a. P a -> P ()
optional_ (Int -> Ctx -> P ()
sSeparate Int
n Ctx
c))) P Bool -> P Bool -> P Bool
forall a. P a -> P a -> P a
<|> Bool -> P Bool
forall a. a -> P a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
          if more then go (x : acc) else pure $! reverse (x : acc)

-- | The closing bracket of a flow collection that starts at the index. Its
-- absence is an error unless the collection is an implicit key, which the
-- parser can try again as a value. If the collection stops at the end of a
-- line, the error points to its start, which can be far away. The nodes are
-- the entries of a flow sequence, whose last one can be a key too long for a
-- pair.
closing :: Ctx -> Int -> Word8 -> String -> [Node] -> String -> P ()
closing :: Ctx -> Int -> Word8 -> [Char] -> [Node] -> [Char] -> P ()
closing Ctx
c Int
start Word8
w [Char]
kind [Node]
entries [Char]
msg = do
  e <- P Env
env
  p <- pos
  char w
    <|> if
      | c == FlowKey -> failure
      | atLineEnd e p -> case nextContent e p of
          Just (Int
lineStart, Int
q)
            | Env -> Int -> Bool
bomBeforeContent Env
e Int
lineStart ->
                Int -> [Char] -> P ()
forall a. Int -> [Char] -> P a
throwAt Int
lineStart [Char]
"unexpected byte order mark"
            | Just Int
tab <- Env -> Int -> Int -> Maybe Int
firstTab Env
e Int
lineStart Int
q -> Int -> [Char] -> P ()
forall a. Int -> [Char] -> P a
throwAt Int
tab [Char]
tabMessage
            | Env -> Int -> Word8
byteAt Env
e Int
q Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
w ->
                Int -> [Char] -> P ()
forall a. Int -> [Char] -> P a
throwAt Int
q ([Char] -> P ()) -> [Char] -> P ()
forall a b. (a -> b) -> a -> b
$
                  [Char]
"'"
                    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Int -> Char
chr (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w)]
                    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"' is indented too little to end the "
                    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
kind
            | Env -> Int -> Bool
closedLater Env
e Int
q ->
                Int -> [Char] -> P ()
forall a. Int -> [Char] -> P a
throwAt Int
q ([Char]
"the line is indented too little to continue the " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
kind)
          Maybe (Int, Int)
Nothing | Just Int
m <- Env -> Word8 -> Maybe Int
cutByMarker Env
e Word8
w -> Int -> [Char] -> P ()
forall a. Int -> [Char] -> P a
throwAt Int
m (Env -> [Char] -> [Char]
markerInside Env
e [Char]
kind)
          Maybe (Int, Int)
_ -> Int -> [Char] -> P ()
forall a. Int -> [Char] -> P a
throwAt Int
start ([Char]
"unterminated " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
kind)
      | dash e p ->
          throwAt
            p
            "unexpected '-', a list item cannot be inside a flow collection, quote '-' if it is a string"
      | byteAt e p == COLON
      , Node {offset = Offset o} : _ <- reverse entries
      , not (fitsKey e (o + e.base) p) ->
          throwAt p keyLengthMessage
      | otherwise -> uncurry throwAt (flowError e p msg)
  where
    -- The separation after an entry goes on to the next line if the
    -- collection can continue there. If it stops at the end of a line, the
    -- document ends or the next line is indented too little.
    atLineEnd :: Env -> Int -> Bool
    atLineEnd :: Env -> Int -> Bool
atLineEnd Env
e Int
i
      | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Env
e.end = Bool
True
      | Bool
otherwise = case Env -> Int -> Word8
byteAt Env
e Int
i of
          Word8
HASH -> let b :: Word8
b = Env -> Int -> Word8
byteAt Env
e (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) in Word8 -> Bool
isWhite Word8
b Bool -> Bool -> Bool
|| Word8 -> Bool
isBreak Word8
b
          Word8
b | Word8 -> Bool
isWhite Word8
b -> Env -> Int -> Bool
atLineEnd Env
e (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
          Word8
b -> Word8 -> Bool
isBreak Word8
b

    -- The start of the next line with content after the line of the index,
    -- and the index of the content, unless a document marker or the end of
    -- the input comes first. A closing bracket or a tab there shows that the
    -- line is indented too little. Other content can be the next key after a
    -- missing bracket.
    nextContent :: Env -> Int -> Maybe (Int, Int)
    nextContent :: Env -> Int -> Maybe (Int, Int)
nextContent Env
e Int
i
      | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Env
e.end = Maybe (Int, Int)
forall a. Maybe a
Nothing
      | Bool -> Bool
not (Word8 -> Bool
isBreak (Env -> Int -> Word8
byteAt Env
e Int
i)) = Env -> Int -> Maybe (Int, Int)
nextContent Env
e (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      | Bool
otherwise =
          let s :: Int
s = Env -> Int -> Int
breakEnd Env
e Int
i
              q :: Int
q = Env -> Int -> Int
skipWhites Env
e Int
s
              b :: Word8
b = Env -> Int -> Word8
byteAt Env
e Int
q
          in if
               | Int
q Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Env
e.end Bool -> Bool -> Bool
|| Env -> Int -> Bool
isMarker Env
e Int
s -> Maybe (Int, Int)
forall a. Maybe a
Nothing
               | Word8 -> Bool
isBreak Word8
b Bool -> Bool -> Bool
|| Word8
b Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
HASH -> Env -> Int -> Maybe (Int, Int)
nextContent Env
e Int
q
               | Bool
otherwise -> (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int
s, Int
q)

    -- A closing bracket without an opening bracket of its own follows in the
    -- document, so the collection likely continues there.
    closedLater :: Env -> Int -> Bool
    closedLater :: Env -> Int -> Bool
closedLater Env
e Int
q = Env -> Word8 -> Int -> Int -> Bool
unmatchedClosing Env
e Word8
w Int
q Env
e.end

    -- A '-' that cannot start a plain scalar, e.g. "- " as in a block
    -- sequence.
    dash :: Env -> Int -> Bool
    dash :: Env -> Int -> Bool
dash Env
e Int
i = Env -> Int -> Word8
byteAt Env
e Int
i Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
MINUS Bool -> Bool -> Bool
&& Bool -> Bool
not (Word8 -> Bool
isAnchorChar (Env -> Int -> Word8
byteAt Env
e (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)))

-- | ns-flow-seq-entry(n,c)
--
-- The grammar reads a JSON-like node first as the key of a pair and then
-- again as a node. For nested flow sequences, this takes exponential time.
-- The parser reads the node only once, as a node. The node becomes a key if
-- it is on one line, it is not too long for an implicit key, and a colon
-- follows. Otherwise it stays a node, and the parser does not read it again.
nsFlowSeqEntry :: Int -> Ctx -> P Node
nsFlowSeqEntry :: Int -> Ctx -> P Node
nsFlowSeqEntry Int
n Ctx
c = do
  e <- P Env
env
  p <- pos
  (pair e p <$!> nsFlowPair n c) <|> nodeEntry e p
  where
    pair :: Env -> Int -> (Node, Node) -> Node
    pair :: Env -> Int -> (Node, Node) -> Node
pair Env
e Int
p (Node
k, Node
v) = Env -> Int -> Offset -> Props -> Content -> Node
mkNode Env
e Int
p Node
v.endOffset Props
noProps (CollectionStyle -> [(Node, Node)] -> Content
MappingContent CollectionStyle
Flow [(Node
k, Node
v)])

    nodeEntry :: Env -> Int -> P Node
    nodeEntry :: Env -> Int -> P Node
nodeEntry Env
e Int
p = do
      k <- Int -> Ctx -> P Node
nsFlowNode Int
n Ctx
c
      q <- pos
      let value = do
            P () -> P ()
forall a. P a -> P ()
optional_ P ()
sSeparateInLine
            r <- P Int
pos
            guardP $ fitsKey e p r
            cNsFlowMapAdjacentValue n c
      if isJsonNode k && fitsKey e p q && not (any (isBreak . byteAt e) [p .. q - 1])
        then (pair e p . (k,) <$!> value) <|> pure k
        else pure k

    -- The content of c-flow-json-node(n,c).
    isJsonNode :: Node -> Bool
    isJsonNode :: Node -> Bool
isJsonNode Node
k = case Node
k.content of
      SequenceContent CollectionStyle
Flow [Node]
_ -> Bool
True
      MappingContent CollectionStyle
Flow [(Node, Node)]
_ -> Bool
True
      ScalarContent ScalarStyle
SingleQuoted Text
_ -> Bool
True
      ScalarContent ScalarStyle
DoubleQuoted Text
_ -> Bool
True
      Content
_ -> Bool
False

-- | ns-flow-map-entry(n,c)
nsFlowMapEntry :: Int -> Ctx -> P (Node, Node)
nsFlowMapEntry :: Int -> Ctx -> P (Node, Node)
nsFlowMapEntry Int
n Ctx
c = P (Node, Node)
explicit P (Node, Node) -> P (Node, Node) -> P (Node, Node)
forall a. P a -> P a -> P a
<|> Int -> Ctx -> P (Node, Node)
nsFlowMapImplicitEntry Int
n Ctx
c
  where
    explicit :: P (Node, Node)
    explicit :: P (Node, Node)
explicit = do
      Word8 -> P ()
char Word8
QUESTION
      Int -> Ctx -> P ()
sSeparate Int
n Ctx
c
      Int -> Ctx -> P (Node, Node)
nsFlowMapExplicitEntry Int
n Ctx
c

-- | ns-flow-map-explicit-entry(n,c)
nsFlowMapExplicitEntry :: Int -> Ctx -> P (Node, Node)
nsFlowMapExplicitEntry :: Int -> Ctx -> P (Node, Node)
nsFlowMapExplicitEntry Int
n Ctx
c =
  Int -> Ctx -> P (Node, Node)
nsFlowMapImplicitEntry Int
n Ctx
c P (Node, Node) -> P (Node, Node) -> P (Node, Node)
forall a. P a -> P a -> P a
<|> do
    k <- P Node
eNode
    v <- eNode
    pure (k, v)

-- | ns-flow-map-implicit-entry(n,c)
nsFlowMapImplicitEntry :: Int -> Ctx -> P (Node, Node)
nsFlowMapImplicitEntry :: Int -> Ctx -> P (Node, Node)
nsFlowMapImplicitEntry Int
n Ctx
c = P (Node, Node)
yamlKeyEntry P (Node, Node) -> P (Node, Node) -> P (Node, Node)
forall a. P a -> P a -> P a
<|> Int -> Ctx -> P (Node, Node)
cNsFlowMapEmptyKeyEntry Int
n Ctx
c P (Node, Node) -> P (Node, Node) -> P (Node, Node)
forall a. P a -> P a -> P a
<|> P (Node, Node)
jsonKeyEntry
  where
    yamlKeyEntry :: P (Node, Node)
    yamlKeyEntry :: P (Node, Node)
yamlKeyEntry = do
      k <- Int -> Ctx -> P Node
nsFlowYamlNode Int
n Ctx
c
      v <- (optional_ (sSeparate n c) >> cNsFlowMapSeparateValue n c) <|> eNode
      pure (k, v)

    jsonKeyEntry :: P (Node, Node)
    jsonKeyEntry :: P (Node, Node)
jsonKeyEntry = do
      k <- Int -> Ctx -> P Node
cFlowJsonNode Int
n Ctx
c
      v <- (optional_ (sSeparate n c) >> cNsFlowMapAdjacentValue n c) <|> eNode
      pure (k, v)

-- | c-ns-flow-map-empty-key-entry(n,c)
cNsFlowMapEmptyKeyEntry :: Int -> Ctx -> P (Node, Node)
cNsFlowMapEmptyKeyEntry :: Int -> Ctx -> P (Node, Node)
cNsFlowMapEmptyKeyEntry Int
n Ctx
c = do
  k <- P Node
eNode
  v <- cNsFlowMapSeparateValue n c
  pure (k, v)

-- | c-ns-flow-map-separate-value(n,c)
cNsFlowMapSeparateValue :: Int -> Ctx -> P Node
cNsFlowMapSeparateValue :: Int -> Ctx -> P Node
cNsFlowMapSeparateValue Int
n Ctx
c = do
  Word8 -> P ()
char Word8
COLON
  w <- P Word8
peek
  guardP . not $ isPlainSafe (isFlowCtx c) w
  (sSeparate n c >> nsFlowNode n c) <|> eNode

-- | c-ns-flow-map-adjacent-value(n,c)
cNsFlowMapAdjacentValue :: Int -> Ctx -> P Node
cNsFlowMapAdjacentValue :: Int -> Ctx -> P Node
cNsFlowMapAdjacentValue Int
n Ctx
c = do
  Word8 -> P ()
char Word8
COLON
  (P () -> P ()
forall a. P a -> P ()
optional_ (Int -> Ctx -> P ()
sSeparate Int
n Ctx
c) P () -> P Node -> P Node
forall a b. P a -> P b -> P b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Ctx -> P Node
nsFlowNode Int
n Ctx
c) P Node -> P Node -> P Node
forall a. P a -> P a -> P a
<|> P Node
eNode

-- | ns-flow-pair(n,c) without c-ns-flow-pair-json-key-entry(n,c), which
-- 'nsFlowSeqEntry' parses.
nsFlowPair :: Int -> Ctx -> P (Node, Node)
nsFlowPair :: Int -> Ctx -> P (Node, Node)
nsFlowPair Int
n Ctx
c = P (Node, Node)
explicit P (Node, Node) -> P (Node, Node) -> P (Node, Node)
forall a. P a -> P a -> P a
<|> P (Node, Node)
yamlKeyEntry P (Node, Node) -> P (Node, Node) -> P (Node, Node)
forall a. P a -> P a -> P a
<|> Int -> Ctx -> P (Node, Node)
cNsFlowMapEmptyKeyEntry Int
n Ctx
c
  where
    explicit :: P (Node, Node)
    explicit :: P (Node, Node)
explicit = do
      Word8 -> P ()
char Word8
QUESTION
      Int -> Ctx -> P ()
sSeparate Int
n Ctx
c
      Int -> Ctx -> P (Node, Node)
nsFlowMapExplicitEntry Int
n Ctx
c

    yamlKeyEntry :: P (Node, Node)
    yamlKeyEntry :: P (Node, Node)
yamlKeyEntry = do
      k <- Ctx -> P Node
nsSImplicitYamlKey Ctx
FlowKey
      v <- cNsFlowMapSeparateValue n c
      pure (k, v)

-- | ns-s-implicit-yaml-key(c)
nsSImplicitYamlKey :: Ctx -> P Node
nsSImplicitYamlKey :: Ctx -> P Node
nsSImplicitYamlKey Ctx
c = P Node -> P Node
implicitKey (P Node -> P Node) -> P Node -> P Node
forall a b. (a -> b) -> a -> b
$ Int -> Ctx -> P Node
nsFlowYamlNode Int
0 Ctx
c

-- | c-s-implicit-json-key(c)
cSImplicitJsonKey :: Ctx -> P Node
cSImplicitJsonKey :: Ctx -> P Node
cSImplicitJsonKey Ctx
c = P Node -> P Node
implicitKey (P Node -> P Node) -> P Node -> P Node
forall a b. (a -> b) -> a -> b
$ Int -> Ctx -> P Node
cFlowJsonNode Int
0 Ctx
c

-- | An implicit key with the separation after it. Both together are at most
-- 'maxImplicitKeyLength' characters long.
implicitKey :: P Node -> P Node
implicitKey :: P Node -> P Node
implicitKey P Node
key = do
  e <- P Env
env
  p <- pos
  k <- key
  optional_ sSeparateInLine
  q <- pos
  guardP $ fitsKey e p q
  pure k

----------------------------------------
-- Flow nodes

-- | ns-flow-yaml-node(n,c)
nsFlowYamlNode :: Int -> Ctx -> P Node
nsFlowYamlNode :: Int -> Ctx -> P Node
nsFlowYamlNode Int
n Ctx
c =
  P Word8
peek P Word8 -> (Word8 -> P Node) -> P Node
forall a b. P a -> (a -> P b) -> P b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Word8
STAR -> P Node
cNsAliasNode
    Word8
w
      | Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
EXCL Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
AMP -> do
          props <- Int -> Ctx -> P Props
cNsProperties Int
n Ctx
c
          (sSeparate n c >> nsPlain n c props) <|> empty props
      | Bool
otherwise -> Int -> Ctx -> Props -> P Node
nsPlain Int
n Ctx
c Props
noProps
  where
    -- Properties before JSON-like content belong to c-flow-json-node, which
    -- ordered choice would not try after an empty node.
    empty :: Props -> P Node
    empty :: Props -> P Node
empty Props
props = do
      P () -> P ()
forall a. P a -> P ()
notFollowedBy (P () -> P ()) -> P () -> P ()
forall a b. (a -> b) -> a -> b
$ do
        P () -> P ()
forall a. P a -> P ()
optional_ (P () -> P ()) -> P () -> P ()
forall a b. (a -> b) -> a -> b
$ Int -> Ctx -> P ()
sSeparate Int
n Ctx
c
        w <- P Word8
peek
        guardP $ w == LBRACKET || w == LBRACE || w == SQUOTE || w == DQUOTE
      Props -> P Node
eScalar Props
props

-- | c-flow-json-node(n,c)
cFlowJsonNode :: Int -> Ctx -> P Node
cFlowJsonNode :: Int -> Ctx -> P Node
cFlowJsonNode Int
n Ctx
c = do
  props <- Props -> P Props -> P Props
forall a. a -> P a -> P a
option Props
noProps (P Props -> P Props) -> P Props -> P Props
forall a b. (a -> b) -> a -> b
$ Int -> Ctx -> P Props
cNsProperties Int
n Ctx
c P Props -> P () -> P Props
forall a b. P a -> P b -> P a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Int -> Ctx -> P ()
sSeparate Int
n Ctx
c
  cFlowJsonContent n c props

-- | ns-flow-node(n,c)
nsFlowNode :: Int -> Ctx -> P Node
nsFlowNode :: Int -> Ctx -> P Node
nsFlowNode Int
n Ctx
c =
  P Word8
peek P Word8 -> (Word8 -> P Node) -> P Node
forall a b. P a -> (a -> P b) -> P b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Word8
STAR -> P Node
cNsAliasNode
    Word8
w
      | Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
EXCL Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
AMP -> do
          props <- Int -> Ctx -> P Props
cNsProperties Int
n Ctx
c
          (sSeparate n c >> nsFlowContent n c props) <|> eScalar props
      | Bool
otherwise -> Int -> Ctx -> Props -> P Node
nsFlowContent Int
n Ctx
c Props
noProps

-- | ns-flow-content(n,c)
nsFlowContent :: Int -> Ctx -> Props -> P Node
nsFlowContent :: Int -> Ctx -> Props -> P Node
nsFlowContent Int
n Ctx
c Props
props =
  P Word8
peek P Word8 -> (Word8 -> P Node) -> P Node
forall a b. P a -> (a -> P b) -> P b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Word8
LBRACKET -> Int -> Ctx -> Props -> P Node
cFlowSequence Int
n Ctx
c Props
props
    Word8
LBRACE -> Int -> Ctx -> Props -> P Node
cFlowMapping Int
n Ctx
c Props
props
    Word8
SQUOTE -> Int -> Ctx -> Props -> P Node
cSingleQuoted Int
n Ctx
c Props
props
    Word8
DQUOTE -> Int -> Ctx -> Props -> P Node
cDoubleQuoted Int
n Ctx
c Props
props
    Word8
_ -> Int -> Ctx -> Props -> P Node
nsPlain Int
n Ctx
c Props
props

-- | c-flow-json-content(n,c)
cFlowJsonContent :: Int -> Ctx -> Props -> P Node
cFlowJsonContent :: Int -> Ctx -> Props -> P Node
cFlowJsonContent Int
n Ctx
c Props
props =
  P Word8
peek P Word8 -> (Word8 -> P Node) -> P Node
forall a b. P a -> (a -> P b) -> P b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Word8
LBRACKET -> Int -> Ctx -> Props -> P Node
cFlowSequence Int
n Ctx
c Props
props
    Word8
LBRACE -> Int -> Ctx -> Props -> P Node
cFlowMapping Int
n Ctx
c Props
props
    Word8
SQUOTE -> Int -> Ctx -> Props -> P Node
cSingleQuoted Int
n Ctx
c Props
props
    Word8
DQUOTE -> Int -> Ctx -> Props -> P Node
cDoubleQuoted Int
n Ctx
c Props
props
    Word8
_ -> P Node
forall a. P a
failure

----------------------------------------
-- Block scalars

data Chomping = Strip | Clip | Keep
  deriving stock (Chomping -> Chomping -> Bool
(Chomping -> Chomping -> Bool)
-> (Chomping -> Chomping -> Bool) -> Eq Chomping
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Chomping -> Chomping -> Bool
== :: Chomping -> Chomping -> Bool
$c/= :: Chomping -> Chomping -> Bool
/= :: Chomping -> Chomping -> Bool
Eq)

-- | c-l+literal(n) and c-l+folded(n).
cLBlockScalar :: Int -> Props -> P Node
cLBlockScalar :: Int -> Props -> P Node
cLBlockScalar Int
n Props
props = do
  e <- P Env
env
  p <- pos
  indicator <- peek
  guardP $ indicator == PIPE || indicator == GREATER
  advance 1
  (chomping, explicitIndent) <- cBBlockHeader p
  q <- pos
  indent <- case explicitIndent of
    -- At the top level, n is -1. A literal reading of the specification then
    -- gives |1 no indentation, but libyaml and other parsers count from 0.
    Just Int
m -> Int -> P Int
forall a. a -> P a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> P Int) -> Int -> P Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
m
    Maybe Int
Nothing -> case Env -> Int -> Either Int Int
detectIndent Env
e Int
q of
      Right Int
m -> Int -> P Int
forall a. a -> P a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
m
      Left Int
i ->
        Int -> [Char] -> P Int
forall a. Int -> [Char] -> P a
throwAt
          Int
i
          [Char]
"a leading empty line of a block scalar has more spaces than the first non-empty line"
  let (lines_, trailing, r) = blockLines e indent q
      (text, starts) = case indicator of
        Word8
PIPE -> ([BlockLine] -> Text
literalText [BlockLine]
lines_, [])
        Word8
_ -> [BlockLine] -> (Text, [Int])
foldedText [BlockLine]
lines_
      value = Chomping -> Bool -> Int -> Text -> Text
chomp Chomping
chomping (Bool -> Bool
not ([BlockLine] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [BlockLine]
lines_)) Int
trailing Text
text
      style = if Word8
indicator Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
PIPE then ScalarStyle
Literal else ScalarStyle
Folded
      -- The empty lines after the content are not part of the scalar,
      -- unless it keeps them.
      contentEnd = case (Chomping
chomping, [BlockLine] -> [BlockLine]
forall a. [a] -> [a]
reverse [BlockLine]
lines_) of
        (Chomping
Keep, [BlockLine]
_) -> Int
r
        (Chomping
_, BlockLine Int
_ (T.Text Array
_ Int
o Int
l) : [BlockLine]
_) -> Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l
        (Chomping
_, []) -> Int
q
  setPos r
  lTrailComments indent
  pure $! mkNode e p (toOffset e contentEnd) props (ScalarLinesContent style value starts)
  where
    -- Detect the content indentation of a block scalar from its first
    -- non-empty line. Return the index of a leading empty line with too many
    -- spaces on error.
    detectIndent :: Env -> Int -> Either Int Int
    detectIndent :: Env -> Int -> Either Int Int
detectIndent Env
e = Int -> Maybe Int -> Int -> Either Int Int
go Int
0 Maybe Int
forall a. Maybe a
Nothing
      where
        go :: Int -> Maybe Int -> Int -> Either Int Int
        go :: Int -> Maybe Int -> Int -> Either Int Int
go Int
maxEmpty Maybe Int
maxAt Int
i =
          let s :: Int
s = Env -> Int -> Int
skipSpaces Env
e Int
i
              k :: Int
k = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i
              w :: Word8
w = Env -> Int -> Word8
byteAt Env
e Int
s
          in if
               | Word8 -> Bool
isBreak Word8
w Bool -> Bool -> Bool
|| (Int
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Env
e.end Bool -> Bool -> Bool
&& Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) ->
                   Int -> Maybe Int -> Int -> Either Int Int
go
                     (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
maxEmpty Int
k)
                     (if Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxEmpty then Int -> Maybe Int
forall a. a -> Maybe a
Just Int
s else Maybe Int
maxAt)
                     (Env -> Int -> Int
breakEnd Env
e Int
s)
               | Int
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Env
e.end Bool -> Bool -> Bool
|| Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n -> Int -> Either Int Int
forall a b. b -> Either a b
Right (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
maxEmpty Int
1))
               | Int
maxEmpty Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
k, Just Int
j <- Maybe Int
maxAt -> Int -> Either Int Int
forall a b. a -> Either a b
Left Int
j
               | Bool
otherwise -> Int -> Either Int Int
forall a b. b -> Either a b
Right Int
k

    literalText :: [BlockLine] -> T.Text
    literalText :: [BlockLine] -> Text
literalText = \case
      [] -> Text
T.empty
      BlockLine Int
k Text
t : [BlockLine]
rest -> [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.replicate Int
k Text
"\n" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text
t Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (BlockLine -> [Text]) -> [BlockLine] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap BlockLine -> [Text]
line [BlockLine]
rest
      where
        line :: BlockLine -> [T.Text]
        line :: BlockLine -> [Text]
line (BlockLine Int
k Text
t) = [Text
"\n", Int -> Text -> Text
T.replicate Int
k Text
"\n", Text
t]

    -- Apply the chomping to the content of a block scalar. The end of the
    -- input counts as a line break, as in the YAML test suite.
    chomp :: Chomping -> Bool -> Int -> T.Text -> T.Text
    chomp :: Chomping -> Bool -> Int -> Text -> Text
chomp Chomping
chomping Bool
hasContent Int
trailing Text
text = case Chomping
chomping of
      Chomping
Strip -> Text
text
      Chomping
Clip
        | Bool
hasContent -> Text
text Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
        | Bool
otherwise -> Text
text
      Chomping
Keep
        | Bool
hasContent -> Text
text Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate (Int
trailing Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Text
"\n"
        | Bool
otherwise -> Int -> Text -> Text
T.replicate Int
trailing Text
"\n"

-- | c-b-block-header(t). Return the chomping and the indentation indicator.
cBBlockHeader :: Int -> P (Chomping, Maybe Int)
cBBlockHeader :: Int -> P (Chomping, Maybe Int)
cBBlockHeader Int
p = do
  a <- P Word8
peek
  b <- peekAt 1
  let (chomping, indent, k)
        | Just t <- chompingOf a, Just m <- indentOf b = (t, Just m, 2)
        | Just m <- indentOf a, Just t <- chompingOf b = (t, Just m, 2)
        | Just t <- chompingOf a = (t, Nothing, 1)
        | Just m <- indentOf a = (Clip, Just m, 1)
        | otherwise = (Clip, Nothing, 0)
  advance k
  e <- env
  q <- pos
  let content = Env -> Int -> Int
skipWhites Env
e Int
q
  sBComment
    <|> if
      | isDecDigit (byteAt e q) ->
          throwAt q "the indentation indicator of a block scalar must be from 1 to 9"
      | content > q && isNsChar (byteAt e content) ->
          throwAt content "the content of a block scalar starts on the next line"
      | otherwise -> throwAt p "invalid block scalar header"
  pure (chomping, indent)
  where
    chompingOf :: Word8 -> Maybe Chomping
    chompingOf :: Word8 -> Maybe Chomping
chompingOf = \case
      Word8
MINUS -> Chomping -> Maybe Chomping
forall a. a -> Maybe a
Just Chomping
Strip
      Word8
PLUS -> Chomping -> Maybe Chomping
forall a. a -> Maybe a
Just Chomping
Keep
      Word8
_ -> Maybe Chomping
forall a. Maybe a
Nothing

    indentOf :: Word8 -> Maybe Int
    indentOf :: Word8 -> Maybe Int
indentOf Word8
w
      | Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
DIGIT_1 Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
DIGIT_9 = Int -> Maybe Int
forall a. a -> Maybe a
Just (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
w Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
DIGIT_0))
      | Bool
otherwise = Maybe Int
forall a. Maybe a
Nothing

-- | A content line of a block scalar: the number of empty lines before it and
-- its text after the indentation.
data BlockLine = BlockLine !Int !T.Text

-- | Split the content of a block scalar into lines. Return the lines, the
-- number of empty lines after the last one and the index after them.
blockLines :: Env -> Int -> Int -> ([BlockLine], Int, Int)
blockLines :: Env -> Int -> Int -> ([BlockLine], Int, Int)
blockLines Env
e Int
indent = Int -> [BlockLine] -> Int -> ([BlockLine], Int, Int)
go Int
0 []
  where
    go :: Int -> [BlockLine] -> Int -> ([BlockLine], Int, Int)
    go :: Int -> [BlockLine] -> Int -> ([BlockLine], Int, Int)
go !Int
empties [BlockLine]
acc Int
i
      | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Env
e.end = ([BlockLine] -> [BlockLine]
forall a. [a] -> [a]
reverse [BlockLine]
acc, Int
empties, Int
i)
      | Bool
otherwise =
          let s :: Int
s = Int -> Int
skipSpacesMax Int
i
              w :: Word8
w = Env -> Int -> Word8
byteAt Env
e Int
s
          in if
               | Word8 -> Bool
isBreak Word8
w -> Int -> [BlockLine] -> Int -> ([BlockLine], Int, Int)
go (Int
empties Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [BlockLine]
acc (Env -> Int -> Int
breakEnd Env
e Int
s)
               -- Spaces at the end of the input are an empty line, as in the
               -- test JEF9/02 of the YAML test suite.
               | Int
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Env
e.end -> ([BlockLine] -> [BlockLine]
forall a. [a] -> [a]
reverse [BlockLine]
acc, Int
empties Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int
s)
               -- Only a block scalar at the top level has content at the
               -- start of a line.
               | Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
indent
               , Bool -> Bool
not (Env -> Int -> Bool
startsPrefix Env
e Int
s) ->
                   let t :: Int
t = Env -> Int -> Int
lineEndAt Env
e Int
s
                       acc' :: [BlockLine]
acc' = Int -> Text -> BlockLine
BlockLine Int
empties (Env -> Int -> Int -> Text
slice Env
e Int
s Int
t) BlockLine -> [BlockLine] -> [BlockLine]
forall a. a -> [a] -> [a]
: [BlockLine]
acc
                   in if Int
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Env
e.end
                        then ([BlockLine] -> [BlockLine]
forall a. [a] -> [a]
reverse [BlockLine]
acc', Int
0, Int
t)
                        else Int -> [BlockLine] -> Int -> ([BlockLine], Int, Int)
go Int
0 [BlockLine]
acc' (Env -> Int -> Int
breakEnd Env
e Int
t)
               | Bool
otherwise -> ([BlockLine] -> [BlockLine]
forall a. [a] -> [a]
reverse [BlockLine]
acc, Int
empties, Int
i)

    -- At most indent spaces.
    skipSpacesMax :: Int -> Int
    skipSpacesMax :: Int -> Int
skipSpacesMax Int
i = Int -> Int
loop Int
i
      where
        loop :: Int -> Int
        loop :: Int -> Int
loop Int
j
          | Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
indent Bool -> Bool -> Bool
&& Env -> Int -> Word8
byteAt Env
e Int
j Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
SPACE = Int -> Int
loop (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
          | Bool
otherwise = Int
j

-- | The text of a folded block scalar and the positions where its lines
-- start.
foldedText :: [BlockLine] -> (T.Text, [Int])
foldedText :: [BlockLine] -> (Text, [Int])
foldedText = \case
  [] -> (Text
T.empty, [])
  BlockLine Int
k Text
t : [BlockLine]
rest ->
    let next :: [Text]
next = Bool -> [BlockLine] -> [Text]
go (Text -> Bool
isSpaced Text
t) [BlockLine]
rest
    in ([Text] -> Text
T.concat (Int -> Text -> Text
T.replicate Int
k Text
"\n" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text
t Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
next), Int -> [Text] -> [Int]
lineStarts (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
T.length Text
t) [Text]
next)
  where
    go :: Bool -> [BlockLine] -> [T.Text]
    go :: Bool -> [BlockLine] -> [Text]
go Bool
prevSpaced = \case
      [] -> []
      BlockLine Int
k Text
t : [BlockLine]
rest ->
        let spaced :: Bool
spaced = Text -> Bool
isSpaced Text
t
            sep :: Text
sep
              | Bool -> Bool
not Bool
prevSpaced Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
spaced = Int -> Text
foldText Int
k
              | Bool
otherwise = Int -> Text -> Text
T.replicate (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Text
"\n"
        in Text
sep Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text
t Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Bool -> [BlockLine] -> [Text]
go Bool
spaced [BlockLine]
rest

    isSpaced :: T.Text -> Bool
    isSpaced :: Text -> Bool
isSpaced Text
t = case Text -> Maybe (Char, Text)
T.uncons Text
t of
      Just (Char
ch, Text
_) -> Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t'
      Maybe (Char, Text)
Nothing -> Bool
False

-- | l-trail-comments(n)
lTrailComments :: Int -> P ()
lTrailComments :: Int -> P ()
lTrailComments Int
n = P () -> P ()
forall a. P a -> P ()
optional_ (P () -> P ()) -> P () -> P ()
forall a b. (a -> b) -> a -> b
$ do
  k <- P Int
countSpaces
  guardP (k < n)
  advance k
  cNbCommentText
  bComment
  many_ lComment

----------------------------------------
-- Block collections

-- | l+block-sequence(n)
lBlockSequence :: Int -> Props -> P Node
lBlockSequence :: Int -> Props -> P Node
lBlockSequence Int
n Props
props = do
  k <- P Int
countSpaces
  guardP (k > n)
  advance k
  nsLCompactSequence k props

-- | c-l-block-seq-entry(n)
cLBlockSeqEntry :: Int -> P Node
cLBlockSeqEntry :: Int -> P Node
cLBlockSeqEntry Int
n = do
  Word8 -> P ()
blockIndicator Word8
MINUS
  Int -> Ctx -> P Node
sLBlockIndented Int
n Ctx
BlockIn

-- | s-l+block-indented(n,c)
sLBlockIndented :: Int -> Ctx -> P Node
sLBlockIndented :: Int -> Ctx -> P Node
sLBlockIndented Int
n Ctx
c = P Node
compact P Node -> P Node -> P Node
forall a. P a -> P a -> P a
<|> Int -> Ctx -> P Node
sLBlockNode Int
n Ctx
c P Node -> P Node -> P Node
forall a. P a -> P a -> P a
<|> (P Node
eNode P Node -> P () -> P Node
forall a b. P a -> P b -> P a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P ()
sLComments)
  where
    compact :: P Node
    compact :: P Node
compact = do
      e <- P Env
env
      m <- countSpaces
      advance m
      p <- pos
      if mayStartEntry e p
        then
          nsLCompactSequence (n + 1 + m) noProps
            <|> nsLCompactMapping (n + 1 + m) noProps
        else nsLCompactSequence (n + 1 + m) noProps

    -- An entry of a mapping has an explicit key or a colon on its first line.
    -- A key cannot start with the indicator of a sequence entry. Without this
    -- check, each level of a nested sequence would scan the rest of the line.
    mayStartEntry :: Env -> Int -> Bool
    mayStartEntry :: Env -> Int -> Bool
mayStartEntry Env
e Int
p
      | Env -> Int -> Word8
byteAt Env
e Int
p Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
QUESTION = Bool
True
      | Env -> Int -> Word8
byteAt Env
e Int
p Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
MINUS Bool -> Bool -> Bool
&& Bool -> Bool
not (Word8 -> Bool
isNsChar (Env -> Int -> Word8
byteAt Env
e (Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))) = Bool
False
      | Bool
otherwise = Int -> Bool
go Int
p
      where
        go :: Int -> Bool
        go :: Int -> Bool
go Int
i = case Env -> Int -> Word8
byteAt Env
e Int
i of
          Word8
COLON -> Bool
True
          Word8
w
            | Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0 Bool -> Bool -> Bool
|| Word8 -> Bool
isBreak Word8
w -> Bool
False
            | Bool
otherwise -> Int -> Bool
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

-- | ns-l-compact-sequence(n), with the properties of the node.
nsLCompactSequence :: Int -> Props -> P Node
nsLCompactSequence :: Int -> Props -> P Node
nsLCompactSequence Int
n Props
props = do
  e <- P Env
env
  p <- pos
  x <- cLBlockSeqEntry n
  xs <- many $ sIndent n >> cLBlockSeqEntry n
  pure $! mkNode e p (lastOf x xs).endOffset props (SequenceContent Block (x : xs))

-- | l+block-mapping(n)
lBlockMapping :: Int -> Props -> P Node
lBlockMapping :: Int -> Props -> P Node
lBlockMapping Int
n Props
props = do
  k <- P Int
countSpaces
  guardP (k > n)
  advance k
  nsLCompactMapping k props

-- | ns-l-block-map-entry(n)
nsLBlockMapEntry :: Int -> P (Node, Node)
nsLBlockMapEntry :: Int -> P (Node, Node)
nsLBlockMapEntry Int
n = Int -> P (Node, Node)
cLBlockMapExplicitEntry Int
n P (Node, Node) -> P (Node, Node) -> P (Node, Node)
forall a. P a -> P a -> P a
<|> Int -> P (Node, Node)
nsLBlockMapImplicitEntry Int
n

-- | c-l-block-map-explicit-entry(n)
cLBlockMapExplicitEntry :: Int -> P (Node, Node)
cLBlockMapExplicitEntry :: Int -> P (Node, Node)
cLBlockMapExplicitEntry Int
n = do
  Word8 -> P ()
blockIndicator Word8
QUESTION
  k <- Int -> Ctx -> P Node
sLBlockIndented Int
n Ctx
BlockOut
  e <- env
  v <- lBlockMapExplicitValue <|> (pure $! missingValue e k)
  pure (k, v)
  where
    -- The key took the comments and the empty lines below it, so the position
    -- of the parser is after them. A value there would take them.
    missingValue :: Env -> Node -> Node
    missingValue :: Env -> Node -> Node
missingValue Env
e Node
k =
      Node
        { offset :: Offset
offset = Node
k.endOffset
        , endOffset :: Offset
endOffset = Node
k.endOffset
        , props :: Props
props = Props
noProps
        , comments :: Comments
comments = Comments
noComments
        , content :: Content
content = Env -> Content
emptyContent Env
e
        }

    lBlockMapExplicitValue :: P Node
    lBlockMapExplicitValue :: P Node
lBlockMapExplicitValue = do
      Int -> P ()
sIndent Int
n
      Word8 -> P ()
blockIndicator Word8
COLON
      Int -> Ctx -> P Node
sLBlockIndented Int
n Ctx
BlockOut

-- | ns-l-block-map-implicit-entry(n)
nsLBlockMapImplicitEntry :: Int -> P (Node, Node)
nsLBlockMapImplicitEntry :: Int -> P (Node, Node)
nsLBlockMapImplicitEntry Int
n = do
  k <- P Node
nsSBlockMapImplicitKey P Node -> P Node -> P Node
forall a. P a -> P a -> P a
<|> P Node
eNode
  v <- cLBlockMapImplicitValue n
  pure (k, v)
  where
    nsSBlockMapImplicitKey :: P Node
    nsSBlockMapImplicitKey :: P Node
nsSBlockMapImplicitKey = Ctx -> P Node
cSImplicitJsonKey Ctx
BlockKey P Node -> P Node -> P Node
forall a. P a -> P a -> P a
<|> Ctx -> P Node
nsSImplicitYamlKey Ctx
BlockKey

-- | c-l-block-map-implicit-value(n)
cLBlockMapImplicitValue :: Int -> P Node
cLBlockMapImplicitValue :: Int -> P Node
cLBlockMapImplicitValue Int
n = do
  Word8 -> P ()
blockIndicator Word8
COLON
  Int -> Ctx -> P Node
sLBlockNode Int
n Ctx
BlockOut P Node -> P Node -> P Node
forall a. P a -> P a -> P a
<|> (P Node
eNode P Node -> P () -> P Node
forall a b. P a -> P b -> P a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P ()
sLComments)

-- | ns-l-compact-mapping(n), with the properties of the node.
nsLCompactMapping :: Int -> Props -> P Node
nsLCompactMapping :: Int -> Props -> P Node
nsLCompactMapping Int
n Props
props = do
  e <- P Env
env
  p <- pos
  x <- nsLBlockMapEntry n
  xs <- many $ sIndent n >> nsLBlockMapEntry n
  pure $! mkNode e p (snd (lastOf x xs)).endOffset props (MappingContent Block (x : xs))

-- | The last element of a non-empty list.
lastOf :: a -> [a] -> a
lastOf :: forall a. a -> [a] -> a
lastOf a
x = \case
  [] -> a
x
  a
y : [a]
ys -> a -> [a] -> a
forall a. a -> [a] -> a
lastOf a
y [a]
ys

----------------------------------------
-- Block nodes

-- | s-l+block-node(n,c)
sLBlockNode :: Int -> Ctx -> P Node
sLBlockNode :: Int -> Ctx -> P Node
sLBlockNode Int
n Ctx
c = do
  e <- P Env
env
  p <- pos
  if flowOnly e p
    then sLFlowInBlock n
    else sLBlockInBlock n c <|> sLFlowInBlock n
  where
    -- Block content starts with a property, an indicator of a block scalar or
    -- the end of the line. Other content on the same line is a flow node.
    flowOnly :: Env -> Int -> Bool
    flowOnly :: Env -> Int -> Bool
flowOnly Env
e Int
p =
      Bool -> Bool
not (Env -> Int -> Bool
isStartOfLine Env
e Int
p)
        Bool -> Bool -> Bool
&& let w :: Word8
w = Env -> Int -> Word8
byteAt Env
e (Env -> Int -> Int
skipWhites Env
e Int
p)
           in Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
                Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0
                  Bool -> Bool -> Bool
|| Word8 -> Bool
isBreak Word8
w
                  Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
HASH
                  Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
PIPE
                  Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
GREATER
                  Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
EXCL
                  Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
AMP

-- | s-l+flow-in-block(n)
sLFlowInBlock :: Int -> P Node
sLFlowInBlock :: Int -> P Node
sLFlowInBlock Int
n = do
  Int -> Ctx -> P ()
sSeparate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Ctx
FlowOut
  node <- Int -> Ctx -> P Node
nsFlowNode (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Ctx
FlowOut
  sLComments
  pure node

-- | s-l+block-in-block(n,c)
sLBlockInBlock :: Int -> Ctx -> P Node
sLBlockInBlock :: Int -> Ctx -> P Node
sLBlockInBlock Int
n Ctx
c = Int -> Ctx -> P Node
sLBlockScalar Int
n Ctx
c P Node -> P Node -> P Node
forall a. P a -> P a -> P a
<|> Int -> Ctx -> P Node
sLBlockCollection Int
n Ctx
c

-- | s-l+block-scalar(n,c)
sLBlockScalar :: Int -> Ctx -> P Node
sLBlockScalar :: Int -> Ctx -> P Node
sLBlockScalar Int
n Ctx
c = do
  Int -> Ctx -> P ()
sSeparate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Ctx
c
  props <- Props -> P Props -> P Props
forall a. a -> P a -> P a
option Props
noProps (P Props -> P Props) -> P Props -> P Props
forall a b. (a -> b) -> a -> b
$ Int -> Ctx -> P Props
cNsProperties (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Ctx
c P Props -> P () -> P Props
forall a b. P a -> P b -> P a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Int -> Ctx -> P ()
sSeparate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Ctx
c
  cLBlockScalar n props

-- | s-l+block-collection(n,c)
sLBlockCollection :: Int -> Ctx -> P Node
sLBlockCollection :: Int -> Ctx -> P Node
sLBlockCollection Int
n Ctx
c = do
  props <- P Props
withProps P Props -> P Props -> P Props
forall a. P a -> P a -> P a
<|> (P ()
sLComments P () -> P Props -> P Props
forall a b. P a -> P b -> P b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Props -> P Props
forall a. a -> P a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Props
noProps)
  lBlockSequence (if c == BlockOut then n - 1 else n) props <|> lBlockMapping n props
  where
    -- If both properties do not end the line, the second one can belong to
    -- the first key of the mapping.
    withProps :: P Props
    withProps :: P Props
withProps = do
      Int -> Ctx -> P ()
sSeparate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Ctx
c
      (Int -> Ctx -> P Props
cNsProperties (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Ctx
c P Props -> P () -> P Props
forall a b. P a -> P b -> P a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P ()
sLComments) P Props -> P Props -> P Props
forall a. P a -> P a -> P a
<|> (P Props
oneProperty P Props -> P () -> P Props
forall a b. P a -> P b -> P a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P ()
sLComments)

    oneProperty :: P Props
    oneProperty :: P Props
oneProperty =
      (Maybe Text -> Tag -> Props
Props Maybe Text
forall a. Maybe a
Nothing (Tag -> Props) -> P Tag -> P Props
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P Tag
cNsTagProperty)
        P Props -> P Props -> P Props
forall a. P a -> P a -> P a
<|> ((\Text
a -> Maybe Text -> Tag -> Props
Props (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
a) Tag
NoTag) (Text -> Props) -> P Text -> P Props
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P Text
cNsAnchorProperty)

-- | The content of an empty node.
emptyContent :: Env -> Content
-- With a constant that contains 'T.empty', the parser returns a node with
-- this content as a thunk, e.g. the value of "a:" above another key. GHC
-- sees a constructor, takes the node for a value and drops the '$!' that
-- builds it, but the node must wait for the evaluation of 'T.empty'. A
-- NOINLINE pragma on the constant prevents this on GHC 9.10, but not on GHC
-- 9.14. The heap check of the render tests finds this thunk.
emptyContent :: Env -> Content
emptyContent Env
e = ScalarStyle -> Text -> Content
ScalarContent ScalarStyle
Plain (Env -> Int -> Int -> Text
slice Env
e Env
e.base Env
e.base)

-- | A node without comments from the given index to the given offset.
mkNode :: Env -> Int -> Offset -> Props -> Content -> Node
mkNode :: Env -> Int -> Offset -> Props -> Content -> Node
mkNode Env
e Int
p Offset
end Props
props Content
c =
  Node
    { offset :: Offset
offset = Env -> Int -> Offset
toOffset Env
e Int
p
    , endOffset :: Offset
endOffset = Offset
end
    , props :: Props
props = Props
props
    , comments :: Comments
comments = Comments
noComments
    , content :: Content
content = Content
c
    }