{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE Safe            #-}

-- |
-- Copyright: © Herbert Valerio Riedel 2015-2018
-- SPDX-License-Identifier: GPL-2.0-or-later
--
-- Event-stream oriented YAML parsing and serializing API
module Data.YAML.Event
    (
      -- * Tutorial
      -- $start

      -- ** Parsing YAML Documents
      -- $parsing
      parseEvents

      -- ** Serializing Events to YAML Character Stream
      -- $serialize
    , writeEvents
    , writeEventsText

      -- ** How to comment your yaml document for best results
      -- $commenting

      -- ** Event-stream Internals
    , EvStream
    , Event(..)
    , EvPos(..)
    , Directives(..)
    , ScalarStyle(..)
    , NodeStyle(..)
    , Chomp(..)
    , IndentOfs(..)
    , Tag, untagged, isUntagged, tagToText, mkTag
    , Anchor
    , Pos(..)
    ) where

import           Data.YAML.Event.Internal
import           Data.YAML.Event.Writer   (writeEvents, writeEventsText)

import qualified Data.ByteString.Lazy     as BS.L
import qualified Data.Char                as C
import qualified Data.Map                 as Map
import qualified Data.Text                as T
import qualified Data.YAML.Token          as Y
import           Numeric                  (readHex)

import           Util

-- | Construct YAML tag
mkTag :: String -> Tag
mkTag :: String -> Tag
mkTag String
"" = String -> Tag
forall a. HasCallStack => String -> a
error String
"mkTag"
mkTag String
"!" = Maybe TagHandle -> Tag
Tag (TagHandle -> Maybe TagHandle
forall a. a -> Maybe a
Just (TagHandle -> Maybe TagHandle) -> TagHandle -> Maybe TagHandle
forall a b. (a -> b) -> a -> b
$! String -> TagHandle
T.pack String
"!")
mkTag String
s   = Maybe TagHandle -> Tag
Tag (TagHandle -> Maybe TagHandle
forall a. a -> Maybe a
Just (TagHandle -> Maybe TagHandle) -> TagHandle -> Maybe TagHandle
forall a b. (a -> b) -> a -> b
$! String -> TagHandle
tagUnescape String
s)
  where
    tagUnescape :: String -> TagHandle
tagUnescape = String -> TagHandle
T.pack (String -> TagHandle) -> (String -> String) -> String -> TagHandle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
go
      where
        go :: String -> String
go [] = []
        go (Char
'%':Char
h:Char
l:String
cs)
          | Just Char
c <- String -> Maybe Char
decodeL1 [Char
h,Char
l] = Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
go String
cs
        go (Char
c:String
cs) = Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
go String
cs


mkTag' :: String -> Tag
mkTag' :: String -> Tag
mkTag' String
"" = String -> Tag
forall a. HasCallStack => String -> a
error String
"mkTag'"
mkTag' String
s  = Maybe TagHandle -> Tag
Tag (TagHandle -> Maybe TagHandle
forall a. a -> Maybe a
Just (TagHandle -> Maybe TagHandle) -> TagHandle -> Maybe TagHandle
forall a b. (a -> b) -> a -> b
$! String -> TagHandle
T.pack String
s)

mkTag'' :: String -> Tag
mkTag'' :: String -> Tag
mkTag'' String
"" = String -> Tag
forall a. HasCallStack => String -> a
error String
"mkTag''"
mkTag'' String
s  = Maybe TagHandle -> Tag
Tag (TagHandle -> Maybe TagHandle
forall a. a -> Maybe a
Just (TagHandle -> Maybe TagHandle) -> TagHandle -> Maybe TagHandle
forall a b. (a -> b) -> a -> b
$! String -> TagHandle
T.pack (String
"tag:yaml.org,2002:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s))

-- Returns the position corresponding to the 'Token'
tok2pos :: Y.Token -> Pos
tok2pos :: Token -> Pos
tok2pos Y.Token { tByteOffset :: Token -> Int
Y.tByteOffset = Int
posByteOffset, tCharOffset :: Token -> Int
Y.tCharOffset = Int
posCharOffset, tLine :: Token -> Int
Y.tLine = Int
posLine, tLineChar :: Token -> Int
Y.tLineChar = Int
posColumn } = Pos {Int
posColumn :: Int
posLine :: Int
posCharOffset :: Int
posByteOffset :: Int
posColumn :: Int
posLine :: Int
posCharOffset :: Int
posByteOffset :: Int
..}

-- Construct a 'EvPos' from the given 'Event' and 'Pos'
getEvPos :: Event -> Y.Token -> EvPos
getEvPos :: Event -> Token -> EvPos
getEvPos Event
ev Token
tok = EvPos { eEvent :: Event
eEvent = Event
ev , ePos :: Pos
ePos = Token -> Pos
tok2pos Token
tok }

-- Initial position('Pos' corresponding to the 'StreamStart')
initPos :: Pos
initPos :: Pos
initPos = Pos { posByteOffset :: Int
posByteOffset = Int
0 , posCharOffset :: Int
posCharOffset = Int
0  , posLine :: Int
posLine = Int
1 , posColumn :: Int
posColumn = Int
0 }

-- internal
type TagHandle = Text
type Props = (Maybe Text,Tag)

getHandle :: [Y.Token] -> Maybe (TagHandle,[Y.Token])
getHandle :: [Token] -> Maybe (TagHandle, [Token])
getHandle [Token]
toks0 = do
  Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.BeginHandle } : [Token]
toks1 <- [Token] -> Maybe [Token]
forall a. a -> Maybe a
Just [Token]
toks0
  ([Token]
hs,Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.EndHandle } : [Token]
toks2) <- ([Token], [Token]) -> Maybe ([Token], [Token])
forall a. a -> Maybe a
Just (([Token], [Token]) -> Maybe ([Token], [Token]))
-> ([Token], [Token]) -> Maybe ([Token], [Token])
forall a b. (a -> b) -> a -> b
$ (Token -> Bool) -> [Token] -> ([Token], [Token])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\Y.Token { tCode :: Token -> Code
Y.tCode = Code
c } -> Code
c Code -> [Code] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Code
Y.Indicator,Code
Y.Meta]) [Token]
toks1
  (TagHandle, [Token]) -> Maybe (TagHandle, [Token])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> TagHandle
T.pack (String -> TagHandle) -> String -> TagHandle
forall a b. (a -> b) -> a -> b
$ (Token -> String) -> [Token] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Token -> String
Y.tText [Token]
hs, [Token]
toks2)

getUriTag :: [Y.Token] -> Maybe (Text,[Y.Token])
getUriTag :: [Token] -> Maybe (TagHandle, [Token])
getUriTag [Token]
toks0 = do
  Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.BeginTag } : [Token]
toks1 <- [Token] -> Maybe [Token]
forall a. a -> Maybe a
Just [Token]
toks0
  ([Token]
hs,Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.EndTag } : [Token]
toks2) <- ([Token], [Token]) -> Maybe ([Token], [Token])
forall a. a -> Maybe a
Just (([Token], [Token]) -> Maybe ([Token], [Token]))
-> ([Token], [Token]) -> Maybe ([Token], [Token])
forall a b. (a -> b) -> a -> b
$ (Token -> Bool) -> [Token] -> ([Token], [Token])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\Y.Token { tCode :: Token -> Code
Y.tCode = Code
c } -> Code
c Code -> [Code] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Code
Y.Indicator,Code
Y.Meta]) [Token]
toks1
  (TagHandle, [Token]) -> Maybe (TagHandle, [Token])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> TagHandle
T.pack (String -> TagHandle) -> String -> TagHandle
forall a b. (a -> b) -> a -> b
$ (Token -> String) -> [Token] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Token -> String
Y.tText [Token]
hs, [Token]
toks2)

{- WARNING: the code that follows will make you cry; a safety pig is provided below for your benefit.

                         _
 _._ _..._ .-',     _.._(`))
'-. `     '  /-._.-'    ',/
   )         \            '.
  / _    _    |             \
 |  a    a    /              |
 \   .-.                     ;
  '-('' ).-'       ,'       ;
     '-;           |      .'
        \           \    /
        | 7  .__  _.-\   \
        | |  |  ``/  /`  /
       /,_|  |   /,_/   /
          /,_/      '`-'

-}

fixUpEOS :: EvStream -> EvStream
fixUpEOS :: EvStream -> EvStream
fixUpEOS = Pos -> EvStream -> EvStream
go Pos
initPos
  where
    go :: Pos -> EvStream -> EvStream
    go :: Pos -> EvStream -> EvStream
go Pos
_ []                          = []
    go Pos
p [Right (EvPos Event
StreamEnd Pos
_)] = [EvPos -> Either (Pos, String) EvPos
forall a b. b -> Either a b
Right (Event -> Pos -> EvPos
EvPos Event
StreamEnd Pos
p)]
    go Pos
_ (e :: Either (Pos, String) EvPos
e@(Right (EvPos Event
_ Pos
p)):EvStream
es)  = Either (Pos, String) EvPos
e Either (Pos, String) EvPos -> EvStream -> EvStream
forall a. a -> [a] -> [a]
: Pos -> EvStream -> EvStream
go Pos
p EvStream
es
    go Pos
_ (e :: Either (Pos, String) EvPos
e@(Left (Pos
p,String
_)):EvStream
es)         = Either (Pos, String) EvPos
e Either (Pos, String) EvPos -> EvStream -> EvStream
forall a. a -> [a] -> [a]
: Pos -> EvStream -> EvStream
go Pos
p EvStream
es

-- | Parse YAML 'Event's from a lazy 'BS.L.ByteString'.
--
-- The parsed Events allow us to round-trip at the event-level while preserving many features and presentation details like
-- 'Comment's,'ScalarStyle','NodeStyle', 'Anchor's, 'Directives' marker along with YAML document version,
-- 'Chomp'ing Indicator,Indentation Indicator ('IndentOfs') ,ordering, etc.
-- It does not preserve non-content white spaces.
--
-- The input 'BS.L.ByteString' is expected to have a YAML 1.2 stream
-- using the UTF-8, UTF-16 (LE or BE), or UTF-32 (LE or BE) encodings
-- (which will be auto-detected).
--
parseEvents :: BS.L.ByteString -> EvStream
parseEvents :: ByteString -> EvStream
parseEvents = \ByteString
bs0 -> EvStream -> EvStream
fixUpEOS (EvStream -> EvStream) -> EvStream -> EvStream
forall a b. (a -> b) -> a -> b
$ EvPos -> Either (Pos, String) EvPos
forall a b. b -> Either a b
Right (Event -> Pos -> EvPos
EvPos Event
StreamStart Pos
initPos) Either (Pos, String) EvPos -> EvStream -> EvStream
forall a. a -> [a] -> [a]
: (Tok2EvStream
go0 Tok2EvStream -> Tok2EvStream
forall a b. (a -> b) -> a -> b
$ (Token -> Bool) -> [Token] -> [Token]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Token -> Bool) -> Token -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token -> Bool
isWhite) ([Token] -> [Token]) -> [Token] -> [Token]
forall a b. (a -> b) -> a -> b
$ ByteString -> Bool -> [Token]
Y.tokenize ByteString
bs0 Bool
False)
  where
    isTCode :: Code -> Token -> Bool
isTCode Code
tc = (Code -> Code -> Bool
forall a. Eq a => a -> a -> Bool
== Code
tc) (Code -> Bool) -> (Token -> Code) -> Token -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token -> Code
Y.tCode
    skipPast :: Code -> [Token] -> [Token]
skipPast Code
tc (Token
t : [Token]
ts)
      | Code -> Token -> Bool
isTCode Code
tc Token
t = [Token]
ts
      | Bool
otherwise = Code -> [Token] -> [Token]
skipPast Code
tc [Token]
ts
    skipPast Code
_ [] = String -> [Token]
forall a. HasCallStack => String -> a
error String
"the impossible happened"

    -- non-content whitespace
    isWhite :: Y.Token -> Bool
    isWhite :: Token -> Bool
isWhite (Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.Bom   })  = Bool
True -- BOMs can occur at each doc-start!
    isWhite (Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.White })  = Bool
True
    isWhite (Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.Indent }) = Bool
True
    isWhite (Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.Break })  = Bool
True
    isWhite Token
_                                = Bool
False


    go0 :: Tok2EvStream
    go0 :: Tok2EvStream
go0 []                                                = [EvPos -> Either (Pos, String) EvPos
forall a b. b -> Either a b
Right (Event -> Pos -> EvPos
EvPos Event
StreamEnd Pos
initPos {- fixed up by fixUpEOS -} )]
    go0 toks0 :: [Token]
toks0@(Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.BeginComment} : [Token]
_)   = Tok2EvStreamCont
goComment [Token]
toks0 Tok2EvStream
go0
    go0 toks0 :: [Token]
toks0@(Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.BeginDocument } : [Token]
_) = DInfo -> Tok2EvStream
go1 DInfo
dinfo0 [Token]
toks0
    go0 (Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.DocumentEnd } : [Token]
rest)      = Tok2EvStream
go0 [Token]
rest -- stray/redundant document-end markers cause this
    go0 [Token]
xs                                                = Tok2EvStream
err [Token]
xs


    go1 :: DInfo -> Tok2EvStream
    go1 :: DInfo -> Tok2EvStream
go1 DInfo
m (Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.BeginDocument } : [Token]
rest) = DInfo -> Tok2EvStream
goDirs DInfo
m [Token]
rest
    go1 DInfo
_ (tok :: Token
tok@Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.EndDocument } : Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.DocumentEnd } : [Token]
rest) = ( EvPos -> Either (Pos, String) EvPos
forall a b. b -> Either a b
Right (Event -> Token -> EvPos
getEvPos (Bool -> Event
DocumentEnd Bool
True) Token
tok ))Either (Pos, String) EvPos -> EvStream -> EvStream
forall a. a -> [a] -> [a]
: Tok2EvStream
go0 [Token]
rest
    go1 DInfo
_ (tok :: Token
tok@Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.EndDocument } : [Token]
rest) = ( EvPos -> Either (Pos, String) EvPos
forall a b. b -> Either a b
Right (Event -> Token -> EvPos
getEvPos (Bool -> Event
DocumentEnd Bool
False) Token
tok )) Either (Pos, String) EvPos -> EvStream -> EvStream
forall a. a -> [a] -> [a]
: Tok2EvStream
go0 [Token]
rest
    go1 DInfo
m toks0 :: [Token]
toks0@(Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.BeginComment} : [Token]
_) = Tok2EvStreamCont
goComment [Token]
toks0 (DInfo -> Tok2EvStream
go1 DInfo
m)
    go1 DInfo
m (Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.BeginNode } : [Token]
rest) = DInfo -> Tok2EvStreamCont
goNode0 DInfo
m [Token]
rest (DInfo -> Tok2EvStream
go1 DInfo
m)
    go1 DInfo
_ [Token]
xs = Tok2EvStream
err [Token]
xs

    -- consume {Begin,End}Directives and emit DocumentStart event
    goDirs :: DInfo -> Tok2EvStream
    goDirs :: DInfo -> Tok2EvStream
goDirs DInfo
m (Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.BeginDirective } : [Token]
rest) = DInfo -> Tok2EvStream
goDir1 DInfo
m [Token]
rest
    goDirs DInfo
m toks0 :: [Token]
toks0@(Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.BeginComment} : [Token]
_) = Tok2EvStreamCont
goComment [Token]
toks0 (DInfo -> Tok2EvStream
goDirs DInfo
m)
    goDirs DInfo
m (tok :: Token
tok@Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.DirectivesEnd } : [Token]
rest)
      | Just (Word
1,Word
mi) <- DInfo -> Maybe (Word, Word)
diVer DInfo
m = EvPos -> Either (Pos, String) EvPos
forall a b. b -> Either a b
Right (Event -> Token -> EvPos
getEvPos (Directives -> Event
DocumentStart (Word -> Directives
DirEndMarkerVersion Word
mi)) Token
tok) Either (Pos, String) EvPos -> EvStream -> EvStream
forall a. a -> [a] -> [a]
: DInfo -> Tok2EvStream
go1 DInfo
m [Token]
rest
      | Bool
otherwise              = EvPos -> Either (Pos, String) EvPos
forall a b. b -> Either a b
Right (Event -> Token -> EvPos
getEvPos (Directives -> Event
DocumentStart Directives
DirEndMarkerNoVersion) Token
tok) Either (Pos, String) EvPos -> EvStream -> EvStream
forall a. a -> [a] -> [a]
: DInfo -> Tok2EvStream
go1 DInfo
m [Token]
rest
    goDirs DInfo
_ xs :: [Token]
xs@(Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.BeginDocument } : [Token]
_) = Tok2EvStream
err [Token]
xs
    goDirs DInfo
m [Token]
xs = EvPos -> Either (Pos, String) EvPos
forall a b. b -> Either a b
Right ( Event -> Token -> EvPos
getEvPos (Directives -> Event
DocumentStart Directives
NoDirEndMarker) ([Token] -> Token
forall a. [a] -> a
head [Token]
xs) )Either (Pos, String) EvPos -> EvStream -> EvStream
forall a. a -> [a] -> [a]
: DInfo -> Tok2EvStream
go1 DInfo
m [Token]
xs

    -- single directive
    goDir1 :: DInfo -> [Y.Token] -> EvStream
    goDir1 :: DInfo -> Tok2EvStream
goDir1 DInfo
m toks0 :: [Token]
toks0@(Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.Indicator, tText :: Token -> String
Y.tText = String
"%" } :
                    Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.Meta, tText :: Token -> String
Y.tText = String
"YAML" } :
                    Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.Meta, tText :: Token -> String
Y.tText = String
v } :
                    Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.EndDirective } :
                    [Token]
rest)
      | DInfo -> Maybe (Word, Word)
diVer DInfo
m Maybe (Word, Word) -> Maybe (Word, Word) -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe (Word, Word)
forall a. Maybe a
Nothing = String -> Tok2EvStream
errMsg String
"Multiple %YAML directives" [Token]
toks0
      | Just (Word
1,Word
mi) <- String -> Maybe (Word, Word)
decodeVer String
v = DInfo -> Tok2EvStream
goDirs (DInfo
m { diVer :: Maybe (Word, Word)
diVer = (Word, Word) -> Maybe (Word, Word)
forall a. a -> Maybe a
Just (Word
1,Word
mi) }) [Token]
rest -- TODO: warn for non-1.2
      | Bool
otherwise = String -> Tok2EvStream
errMsg (String
"Unsupported YAML version " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
forall a. Show a => a -> String
show String
v) [Token]
toks0

    goDir1 DInfo
m toks0 :: [Token]
toks0@(Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.Indicator, tText :: Token -> String
Y.tText = String
"%" } :
                    Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.Meta, tText :: Token -> String
Y.tText = String
"TAG" } :
                    [Token]
rest)
      | Just (TagHandle
h, [Token]
rest') <- [Token] -> Maybe (TagHandle, [Token])
getHandle [Token]
rest
      , Just (TagHandle
t, [Token]
rest'') <- [Token] -> Maybe (TagHandle, [Token])
getUriTag [Token]
rest' = case TagHandle
-> TagHandle
-> Map TagHandle TagHandle
-> Maybe (Map TagHandle TagHandle)
forall k a. Ord k => k -> a -> Map k a -> Maybe (Map k a)
mapInsertNoDupe TagHandle
h TagHandle
t (DInfo -> Map TagHandle TagHandle
diTags DInfo
m) of
                                                Just Map TagHandle TagHandle
tm  -> DInfo -> Tok2EvStream
goDirs (DInfo
m { diTags :: Map TagHandle TagHandle
diTags = Map TagHandle TagHandle
tm }) (Code -> [Token] -> [Token]
skipPast Code
Y.EndDirective [Token]
rest'')
                                                Maybe (Map TagHandle TagHandle)
Nothing  -> String -> Tok2EvStream
errMsg (String
"Multiple %TAG definitions for handle " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> TagHandle -> String
forall a. Show a => a -> String
show TagHandle
h) [Token]
toks0

    goDir1 DInfo
m (Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.Indicator, tText :: Token -> String
Y.tText = String
"%" } :
             Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.Meta, tText :: Token -> String
Y.tText = String
l } :
             [Token]
rest) | String
l String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String
"TAG",String
"YAML"] = DInfo -> Tok2EvStream
goDirs DInfo
m (Code -> [Token] -> [Token]
skipPast Code
Y.EndDirective [Token]
rest)
    goDir1 DInfo
_ [Token]
xs                                            = Tok2EvStream
err [Token]
xs

    -- | Decode versions of the form @<major>.<minor>@
    decodeVer :: String -> Maybe (Word,Word)
    decodeVer :: String -> Maybe (Word, Word)
decodeVer String
s = do
      (String
lhs,Char
'.':String
rhs) <- (String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just ((Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'.') String
s)
      (,) (Word -> Word -> (Word, Word))
-> Maybe Word -> Maybe (Word -> (Word, Word))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Word
forall a. Read a => String -> Maybe a
readMaybe String
lhs Maybe (Word -> (Word, Word)) -> Maybe Word -> Maybe (Word, Word)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Maybe Word
forall a. Read a => String -> Maybe a
readMaybe String
rhs

data DInfo = DInfo { DInfo -> Map TagHandle TagHandle
diTags :: Map.Map TagHandle Text
                   , DInfo -> Maybe (Word, Word)
diVer  :: Maybe (Word,Word)
                   }

dinfo0 :: DInfo
dinfo0 :: DInfo
dinfo0 = Map TagHandle TagHandle -> Maybe (Word, Word) -> DInfo
DInfo Map TagHandle TagHandle
forall a. Monoid a => a
mempty Maybe (Word, Word)
forall a. Maybe a
Nothing

errMsg :: String -> Tok2EvStream
errMsg :: String -> Tok2EvStream
errMsg String
msg (Token
tok : [Token]
_) = [(Pos, String) -> Either (Pos, String) EvPos
forall a b. a -> Either a b
Left (Token -> Pos
tok2pos Token
tok, String
msg)]
errMsg String
msg [] = [(Pos, String) -> Either (Pos, String) EvPos
forall a b. a -> Either a b
Left ((Int -> Int -> Int -> Int -> Pos
Pos (-Int
1) (-Int
1) (-Int
1) (-Int
1)), (String
"Unexpected end of token stream: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
msg))]

err :: Tok2EvStream
err :: Tok2EvStream
err (tok :: Token
tok@Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.Error, tText :: Token -> String
Y.tText = String
msg } : [Token]
_) = [(Pos, String) -> Either (Pos, String) EvPos
forall a b. a -> Either a b
Left (Token -> Pos
tok2pos Token
tok, String
msg)]
err (tok :: Token
tok@Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.Unparsed, tText :: Token -> String
Y.tText = String
txt } : [Token]
_) = [(Pos, String) -> Either (Pos, String) EvPos
forall a b. a -> Either a b
Left (Token -> Pos
tok2pos Token
tok, (String
"Lexical error near " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
txt))]
err (tok :: Token
tok@Y.Token { tCode :: Token -> Code
Y.tCode = Code
code } : [Token]
_) = [(Pos, String) -> Either (Pos, String) EvPos
forall a b. a -> Either a b
Left (Token -> Pos
tok2pos Token
tok, (String
"Parse failure near " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Code -> String
forall a. Show a => a -> String
show Code
code String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" token"))]
err [] = [(Pos, String) -> Either (Pos, String) EvPos
forall a b. a -> Either a b
Left ((Int -> Int -> Int -> Int -> Pos
Pos (-Int
1) (-Int
1) (-Int
1) (-Int
1)), String
"Unexpected end of token stream")]

goNode0 :: DInfo -> Tok2EvStreamCont
goNode0 :: DInfo -> Tok2EvStreamCont
goNode0 DInfo {Maybe (Word, Word)
Map TagHandle TagHandle
diVer :: Maybe (Word, Word)
diTags :: Map TagHandle TagHandle
diTags :: DInfo -> Map TagHandle TagHandle
diVer :: DInfo -> Maybe (Word, Word)
..} = Tok2EvStreamCont
goNode
  where
    seqInd :: String -> NodeStyle
seqInd String
"[" = NodeStyle
Flow
    seqInd String
"-" = NodeStyle
Block
    seqInd String
_   = String -> NodeStyle
forall a. HasCallStack => String -> a
error String
"seqInd: internal error" -- impossible

    mapInd :: String -> NodeStyle
mapInd String
"{" = NodeStyle
Flow
    mapInd String
_   = String -> NodeStyle
forall a. HasCallStack => String -> a
error String
"mapInd: internal error" -- impossible

    goNode :: Tok2EvStreamCont
    goNode :: Tok2EvStreamCont
goNode toks0 :: [Token]
toks0@(Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.BeginComment} : [Token]
_) Tok2EvStream
cont = Tok2EvStreamCont
goComment [Token]
toks0 (Tok2EvStreamCont -> Tok2EvStream -> Tok2EvStream
forall a b c. (a -> b -> c) -> b -> a -> c
flip Tok2EvStreamCont
goNode Tok2EvStream
cont)
    goNode (tok :: Token
tok@Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.BeginScalar } : [Token]
rest) Tok2EvStream
cont = Pos -> Props -> Tok2EvStreamCont
goScalar (Token -> Pos
tok2pos Token
tok) (Maybe TagHandle
forall a. Monoid a => a
mempty,Tag
untagged) [Token]
rest (Tok2EvStreamCont -> Tok2EvStream -> Tok2EvStream
forall a b c. (a -> b -> c) -> b -> a -> c
flip Tok2EvStreamCont
goNodeEnd Tok2EvStream
cont)
    goNode (tok :: Token
tok@Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.BeginSequence } : Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.Indicator, tText :: Token -> String
Y.tText = String
ind } : [Token]
rest) Tok2EvStream
cont = EvPos -> Either (Pos, String) EvPos
forall a b. b -> Either a b
Right (Event -> Token -> EvPos
getEvPos (Maybe TagHandle -> Tag -> NodeStyle -> Event
SequenceStart Maybe TagHandle
forall a. Maybe a
Nothing Tag
untagged (String -> NodeStyle
seqInd String
ind)) Token
tok)Either (Pos, String) EvPos -> EvStream -> EvStream
forall a. a -> [a] -> [a]
: Tok2EvStreamCont
goSeq [Token]
rest (Tok2EvStreamCont -> Tok2EvStream -> Tok2EvStream
forall a b c. (a -> b -> c) -> b -> a -> c
flip Tok2EvStreamCont
goNodeEnd Tok2EvStream
cont)
    goNode (tok :: Token
tok@Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.BeginMapping }  : Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.Indicator, tText :: Token -> String
Y.tText = String
ind } : [Token]
rest) Tok2EvStream
cont = EvPos -> Either (Pos, String) EvPos
forall a b. b -> Either a b
Right (Event -> Token -> EvPos
getEvPos (Maybe TagHandle -> Tag -> NodeStyle -> Event
MappingStart Maybe TagHandle
forall a. Maybe a
Nothing Tag
untagged (String -> NodeStyle
mapInd String
ind)) Token
tok) Either (Pos, String) EvPos -> EvStream -> EvStream
forall a. a -> [a] -> [a]
: Tok2EvStreamCont
goMap [Token]
rest (Tok2EvStreamCont -> Tok2EvStream -> Tok2EvStream
forall a b c. (a -> b -> c) -> b -> a -> c
flip Tok2EvStreamCont
goNodeEnd Tok2EvStream
cont)
    goNode (tok :: Token
tok@Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.BeginMapping }  : [Token]
rest) Tok2EvStream
cont = EvPos -> Either (Pos, String) EvPos
forall a b. b -> Either a b
Right (Event -> Token -> EvPos
getEvPos (Maybe TagHandle -> Tag -> NodeStyle -> Event
MappingStart Maybe TagHandle
forall a. Maybe a
Nothing Tag
untagged NodeStyle
Block) Token
tok) Either (Pos, String) EvPos -> EvStream -> EvStream
forall a. a -> [a] -> [a]
: Tok2EvStreamCont
goMap [Token]
rest (Tok2EvStreamCont -> Tok2EvStream -> Tok2EvStream
forall a b c. (a -> b -> c) -> b -> a -> c
flip Tok2EvStreamCont
goNodeEnd Tok2EvStream
cont)
    goNode (Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.BeginProperties } : [Token]
rest) Tok2EvStream
cont = Props -> [Token] -> (Props -> Tok2EvStream) -> EvStream
goProp (Maybe TagHandle
forall a. Monoid a => a
mempty,Tag
untagged) [Token]
rest (\Props
p [Token]
rest' -> Props -> Tok2EvStreamCont
goNode' Props
p [Token]
rest' Tok2EvStream
cont)
    goNode (tok :: Token
tok@Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.BeginAlias } :
            Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.Indicator } :
            Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.Meta, tText :: Token -> String
Y.tText = String
anchor } :
            Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.EndAlias } :
            Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.EndNode } :
            [Token]
rest) Tok2EvStream
cont = EvPos -> Either (Pos, String) EvPos
forall a b. b -> Either a b
Right (Event -> Token -> EvPos
getEvPos (TagHandle -> Event
Alias (String -> TagHandle
T.pack String
anchor)) Token
tok) Either (Pos, String) EvPos -> EvStream -> EvStream
forall a. a -> [a] -> [a]
: Tok2EvStream
cont [Token]
rest
    goNode [Token]
xs Tok2EvStream
_cont = Tok2EvStream
err [Token]
xs

    goNode' :: Props -> Tok2EvStreamCont
    goNode' :: Props -> Tok2EvStreamCont
goNode' Props
props toks0 :: [Token]
toks0@(Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.BeginComment} : [Token]
_) Tok2EvStream
cont  = Tok2EvStreamCont
goComment [Token]
toks0 (Tok2EvStreamCont -> Tok2EvStream -> Tok2EvStream
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Props -> Tok2EvStreamCont
goNode' Props
props) Tok2EvStream
cont)
    goNode' Props
props (tok :: Token
tok@Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.BeginScalar }   : [Token]
rest) Tok2EvStream
cont   = Pos -> Props -> Tok2EvStreamCont
goScalar (Token -> Pos
tok2pos Token
tok) Props
props [Token]
rest (Tok2EvStreamCont -> Tok2EvStream -> Tok2EvStream
forall a b c. (a -> b -> c) -> b -> a -> c
flip Tok2EvStreamCont
goNodeEnd Tok2EvStream
cont)
    goNode' (Maybe TagHandle
manchor,Tag
mtag) (tok :: Token
tok@Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.BeginSequence } : Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.Indicator, tText :: Token -> String
Y.tText = String
ind } : [Token]
rest) Tok2EvStream
cont = EvPos -> Either (Pos, String) EvPos
forall a b. b -> Either a b
Right (Event -> Token -> EvPos
getEvPos (Maybe TagHandle -> Tag -> NodeStyle -> Event
SequenceStart Maybe TagHandle
manchor Tag
mtag (String -> NodeStyle
seqInd String
ind)) Token
tok) Either (Pos, String) EvPos -> EvStream -> EvStream
forall a. a -> [a] -> [a]
: Tok2EvStreamCont
goSeq [Token]
rest (Tok2EvStreamCont -> Tok2EvStream -> Tok2EvStream
forall a b c. (a -> b -> c) -> b -> a -> c
flip Tok2EvStreamCont
goNodeEnd Tok2EvStream
cont)
    goNode' (Maybe TagHandle
manchor,Tag
mtag) (tok :: Token
tok@Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.BeginMapping }  : Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.Indicator, tText :: Token -> String
Y.tText = String
ind } : [Token]
rest) Tok2EvStream
cont = EvPos -> Either (Pos, String) EvPos
forall a b. b -> Either a b
Right (Event -> Token -> EvPos
getEvPos (Maybe TagHandle -> Tag -> NodeStyle -> Event
MappingStart Maybe TagHandle
manchor Tag
mtag (String -> NodeStyle
mapInd String
ind)) Token
tok) Either (Pos, String) EvPos -> EvStream -> EvStream
forall a. a -> [a] -> [a]
: Tok2EvStreamCont
goMap [Token]
rest (Tok2EvStreamCont -> Tok2EvStream -> Tok2EvStream
forall a b c. (a -> b -> c) -> b -> a -> c
flip Tok2EvStreamCont
goNodeEnd Tok2EvStream
cont)
    goNode' (Maybe TagHandle
manchor,Tag
mtag) (tok :: Token
tok@Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.BeginMapping } : [Token]
rest) Tok2EvStream
cont = EvPos -> Either (Pos, String) EvPos
forall a b. b -> Either a b
Right (Event -> Token -> EvPos
getEvPos (Maybe TagHandle -> Tag -> NodeStyle -> Event
MappingStart Maybe TagHandle
manchor Tag
mtag NodeStyle
Block) Token
tok) Either (Pos, String) EvPos -> EvStream -> EvStream
forall a. a -> [a] -> [a]
: Tok2EvStreamCont
goMap [Token]
rest (Tok2EvStreamCont -> Tok2EvStream -> Tok2EvStream
forall a b c. (a -> b -> c) -> b -> a -> c
flip Tok2EvStreamCont
goNodeEnd Tok2EvStream
cont)
    goNode' Props
_ [Token]
xs                                            Tok2EvStream
_cont = Tok2EvStream
err [Token]
xs

    goNodeEnd :: Tok2EvStreamCont
    goNodeEnd :: Tok2EvStreamCont
goNodeEnd toks0 :: [Token]
toks0@(Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.BeginComment} : [Token]
_) Tok2EvStream
cont = Tok2EvStreamCont
goComment [Token]
toks0 (Tok2EvStreamCont -> Tok2EvStream -> Tok2EvStream
forall a b c. (a -> b -> c) -> b -> a -> c
flip Tok2EvStreamCont
goNodeEnd Tok2EvStream
cont)
    goNodeEnd (Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.EndNode } : [Token]
rest) Tok2EvStream
cont = Tok2EvStream
cont [Token]
rest
    goNodeEnd [Token]
xs                                      Tok2EvStream
_cont = Tok2EvStream
err [Token]
xs

    goProp :: Props -> [Y.Token] -> (Props -> [Y.Token] -> EvStream) -> EvStream
    goProp :: Props -> [Token] -> (Props -> Tok2EvStream) -> EvStream
goProp Props
props (Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.EndProperties } : [Token]
rest) Props -> Tok2EvStream
cont = Props -> Tok2EvStream
cont Props
props [Token]
rest
    goProp Props
props (Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.BeginAnchor } : [Token]
rest) Props -> Tok2EvStream
cont = Props -> [Token] -> (Props -> Tok2EvStream) -> EvStream
goAnchor Props
props [Token]
rest (\Props
x [Token]
y -> Props -> [Token] -> (Props -> Tok2EvStream) -> EvStream
goProp Props
x [Token]
y Props -> Tok2EvStream
cont)
    goProp Props
props (Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.BeginTag } : [Token]
rest) Props -> Tok2EvStream
cont = Props -> [Token] -> (Props -> Tok2EvStream) -> EvStream
goTag Props
props [Token]
rest (\Props
x [Token]
y -> Props -> [Token] -> (Props -> Tok2EvStream) -> EvStream
goProp Props
x [Token]
y Props -> Tok2EvStream
cont)
    goProp Props
_props [Token]
xs                                     Props -> Tok2EvStream
_cont = Tok2EvStream
err [Token]
xs

    goAnchor :: Props -> [Y.Token] -> (Props -> [Y.Token] -> EvStream) -> EvStream
    goAnchor :: Props -> [Token] -> (Props -> Tok2EvStream) -> EvStream
goAnchor Props
props (Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.Indicator } : [Token]
rest) Props -> Tok2EvStream
cont = Props -> [Token] -> (Props -> Tok2EvStream) -> EvStream
goAnchor Props
props [Token]
rest Props -> Tok2EvStream
cont
    goAnchor (Maybe TagHandle
_,Tag
tag) (Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.Meta, tText :: Token -> String
Y.tText = String
anchor } : [Token]
rest) Props -> Tok2EvStream
cont = Props -> [Token] -> (Props -> Tok2EvStream) -> EvStream
goAnchor (TagHandle -> Maybe TagHandle
forall a. a -> Maybe a
Just (TagHandle -> Maybe TagHandle) -> TagHandle -> Maybe TagHandle
forall a b. (a -> b) -> a -> b
$! String -> TagHandle
T.pack String
anchor,Tag
tag) [Token]
rest Props -> Tok2EvStream
cont
    goAnchor Props
props (Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.EndAnchor } : [Token]
rest) Props -> Tok2EvStream
cont = Props -> Tok2EvStream
cont Props
props [Token]
rest
    goAnchor Props
_ [Token]
xs Props -> Tok2EvStream
_ = Tok2EvStream
err [Token]
xs

    goTag :: Props -> [Y.Token] -> (Props -> [Y.Token] -> EvStream) -> EvStream

    goTag :: Props -> [Token] -> (Props -> Tok2EvStream) -> EvStream
goTag (Maybe TagHandle
anchor,Tag
_) (Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.Indicator, tText :: Token -> String
Y.tText = String
"!" } :
                      Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.EndTag } : [Token]
rest)
          Props -> Tok2EvStream
cont = Props -> Tok2EvStream
cont (Maybe TagHandle
anchor,String -> Tag
mkTag' String
"!") [Token]
rest

    goTag (Maybe TagHandle
anchor,Tag
_) (Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.BeginHandle } :
                      Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.Indicator, tText :: Token -> String
Y.tText = String
"!" } :
                      Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.Indicator, tText :: Token -> String
Y.tText = String
"!" } :
                      Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.EndHandle } :
                      Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.Meta, tText :: Token -> String
Y.tText = String
tag } :
                      Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.EndTag } : [Token]
rest)
          Props -> Tok2EvStream
cont
            | Just TagHandle
t' <- TagHandle -> Map TagHandle TagHandle -> Maybe TagHandle
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (String -> TagHandle
T.pack (String
"!!")) Map TagHandle TagHandle
diTags
              = Props -> Tok2EvStream
cont (Maybe TagHandle
anchor,String -> Tag
mkTag (TagHandle -> String
T.unpack TagHandle
t' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
tag)) [Token]
rest
            | Bool
otherwise = Props -> Tok2EvStream
cont (Maybe TagHandle
anchor,String -> Tag
mkTag'' String
tag) [Token]
rest

    goTag (Maybe TagHandle
anchor,Tag
_) (Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.Indicator, tText :: Token -> String
Y.tText = String
"!" } :
                      Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.Indicator, tText :: Token -> String
Y.tText = String
"<" } :
                      Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.Meta, tText :: Token -> String
Y.tText = String
tag } :
                      Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.Indicator, tText :: Token -> String
Y.tText = String
">" } :
                      Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.EndTag } : [Token]
rest)
          Props -> Tok2EvStream
cont = Props -> Tok2EvStream
cont (Maybe TagHandle
anchor,String -> Tag
mkTag String
tag) [Token]
rest

    goTag (Maybe TagHandle
anchor,Tag
_) xs :: [Token]
xs@(Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.BeginHandle } :
                      Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.Indicator, tText :: Token -> String
Y.tText = String
"!" } :
                      Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.Meta, tText :: Token -> String
Y.tText = String
h } :
                      Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.Indicator, tText :: Token -> String
Y.tText = String
"!" } :
                      Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.EndHandle } :
                      Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.Meta, tText :: Token -> String
Y.tText = String
tag } :
                      Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.EndTag } : [Token]
rest)
          Props -> Tok2EvStream
cont
            | Just TagHandle
t' <- TagHandle -> Map TagHandle TagHandle -> Maybe TagHandle
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (String -> TagHandle
T.pack (String
"!" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
h String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"!")) Map TagHandle TagHandle
diTags
              = Props -> Tok2EvStream
cont (Maybe TagHandle
anchor,String -> Tag
mkTag (TagHandle -> String
T.unpack TagHandle
t' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
tag)) [Token]
rest
            | Bool
otherwise = Tok2EvStream
err [Token]
xs

    goTag (Maybe TagHandle
anchor,Tag
_) (Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.BeginHandle } :
                      Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.Indicator, tText :: Token -> String
Y.tText = String
"!" } :
                      Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.EndHandle } :
                      Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.Meta, tText :: Token -> String
Y.tText = String
tag } :
                      Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.EndTag } : [Token]
rest)
          Props -> Tok2EvStream
cont
            | Just TagHandle
t' <- TagHandle -> Map TagHandle TagHandle -> Maybe TagHandle
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (String -> TagHandle
T.pack (String
"!")) Map TagHandle TagHandle
diTags
              = Props -> Tok2EvStream
cont (Maybe TagHandle
anchor,String -> Tag
mkTag (TagHandle -> String
T.unpack TagHandle
t' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
tag)) [Token]
rest
            | Bool
otherwise = Props -> Tok2EvStream
cont (Maybe TagHandle
anchor,String -> Tag
mkTag' (Char
'!' Char -> String -> String
forall a. a -> [a] -> [a]
: String
tag)) [Token]
rest -- unresolved
    goTag Props
_ [Token]
xs Props -> Tok2EvStream
_ = Tok2EvStream
err [Token]
xs

    goScalar :: Pos -> Props -> Tok2EvStreamCont
    goScalar :: Pos -> Props -> Tok2EvStreamCont
goScalar Pos
pos0 (Maybe TagHandle
manchor,Tag
tag) [Token]
toks0 Tok2EvStream
cont = Bool -> ScalarStyle -> Tok2EvStream
go0 Bool
False ScalarStyle
Plain [Token]
toks0
      where
        go0 :: Bool -> ScalarStyle -> Tok2EvStream
go0 Bool
ii ScalarStyle
sty (Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.Indicator, tText :: Token -> String
Y.tText = String
ind } : [Token]
rest)
          | String
"'"  <- String
ind = Bool -> String -> ScalarStyle -> Tok2EvStream
go' Bool
ii String
"" ScalarStyle
SingleQuoted [Token]
rest
          | String
"\"" <- String
ind = Bool -> String -> ScalarStyle -> Tok2EvStream
go' Bool
ii String
"" ScalarStyle
DoubleQuoted [Token]
rest
          | String
"|"  <- String
ind = Bool -> ScalarStyle -> Tok2EvStream
go0 Bool
True (Chomp -> IndentOfs -> ScalarStyle
Literal Chomp
Clip IndentOfs
IndentAuto) [Token]
rest
          | String
">"  <- String
ind = Bool -> ScalarStyle -> Tok2EvStream
go0 Bool
True (Chomp -> IndentOfs -> ScalarStyle
Folded Chomp
Clip IndentOfs
IndentAuto) [Token]
rest

          | String
"+"  <- String
ind = Bool -> ScalarStyle -> Tok2EvStream
go0 Bool
ii (ScalarStyle -> Chomp -> ScalarStyle
chn ScalarStyle
sty Chomp
Keep) [Token]
rest
          | String
"-"  <- String
ind = Bool -> ScalarStyle -> Tok2EvStream
go0 Bool
ii (ScalarStyle -> Chomp -> ScalarStyle
chn ScalarStyle
sty Chomp
Strip) [Token]
rest
          | [Char
c]  <- String
ind, Char
'1' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c, Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9' = Bool -> ScalarStyle -> Tok2EvStream
go0 Bool
False (ScalarStyle -> Int -> ScalarStyle
chn' ScalarStyle
sty (Char -> Int
C.digitToInt Char
c)) [Token]
rest

        go0 Bool
ii ScalarStyle
sty tok :: [Token]
tok@(Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.BeginComment} : [Token]
_)           = Tok2EvStreamCont
goComment [Token]
tok (Bool -> ScalarStyle -> Tok2EvStream
go0 Bool
ii ScalarStyle
sty)
        go0 Bool
ii ScalarStyle
sty (Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.Text, tText :: Token -> String
Y.tText = String
t } : [Token]
rest)      = Bool -> String -> ScalarStyle -> Tok2EvStream
go' Bool
ii String
t ScalarStyle
sty [Token]
rest
        go0 Bool
ii ScalarStyle
sty (Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.LineFold } : [Token]
rest)               = Bool -> String -> ScalarStyle -> Tok2EvStream
go' Bool
ii String
" " ScalarStyle
sty [Token]
rest
        go0 Bool
ii ScalarStyle
sty (Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.LineFeed } : [Token]
rest)               = Bool -> String -> ScalarStyle -> Tok2EvStream
go' Bool
ii String
"\n" ScalarStyle
sty [Token]
rest
        go0 Bool
_  ScalarStyle
sty (Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.EndScalar } : [Token]
rest)          = EvPos -> Either (Pos, String) EvPos
forall a b. b -> Either a b
Right (Event -> Pos -> EvPos
EvPos (Maybe TagHandle -> Tag -> ScalarStyle -> TagHandle -> Event
Scalar Maybe TagHandle
manchor Tag
tag ScalarStyle
sty TagHandle
forall a. Monoid a => a
mempty) Pos
pos0) Either (Pos, String) EvPos -> EvStream -> EvStream
forall a. a -> [a] -> [a]
: Tok2EvStream
cont [Token]
rest

        go0 Bool
_ ScalarStyle
_ [Token]
xs = Tok2EvStream
err [Token]
xs

        chn :: ScalarStyle -> Chomp -> ScalarStyle
        chn :: ScalarStyle -> Chomp -> ScalarStyle
chn (Literal Chomp
_ IndentOfs
digit) Chomp
chmp = Chomp -> IndentOfs -> ScalarStyle
Literal Chomp
chmp IndentOfs
digit
        chn (Folded Chomp
_ IndentOfs
digit) Chomp
chmp  = Chomp -> IndentOfs -> ScalarStyle
Folded Chomp
chmp IndentOfs
digit
        chn ScalarStyle
_ Chomp
_                    = String -> ScalarStyle
forall a. HasCallStack => String -> a
error String
"impossible"

        chn' :: ScalarStyle -> Int -> ScalarStyle
        chn' :: ScalarStyle -> Int -> ScalarStyle
chn' (Literal Chomp
b IndentOfs
_) Int
digit = Chomp -> IndentOfs -> ScalarStyle
Literal Chomp
b (Int -> IndentOfs
forall a. Enum a => Int -> a
toEnum Int
digit)
        chn' (Folded Chomp
b IndentOfs
_) Int
digit  = Chomp -> IndentOfs -> ScalarStyle
Folded Chomp
b (Int -> IndentOfs
forall a. Enum a => Int -> a
toEnum Int
digit)
        chn' ScalarStyle
_ Int
_                 = String -> ScalarStyle
forall a. HasCallStack => String -> a
error String
"impossible"

        ----------------------------------------------------------------------------

        go' :: Bool -> String -> ScalarStyle -> Tok2EvStream
go' Bool
ii String
acc ScalarStyle
sty (Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.Text, tText :: Token -> String
Y.tText = String
t } : [Token]
rest) = Bool -> String -> ScalarStyle -> Tok2EvStream
go' Bool
ii (String
acc String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
t) ScalarStyle
sty [Token]
rest
        go' Bool
ii String
acc ScalarStyle
sty (Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.LineFold } : [Token]
rest) = Bool -> String -> ScalarStyle -> Tok2EvStream
go' Bool
ii (String
acc String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" ") ScalarStyle
sty [Token]
rest
        go' Bool
ii String
acc ScalarStyle
sty (Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.LineFeed } : [Token]
rest) = Bool -> String -> ScalarStyle -> Tok2EvStream
go' Bool
ii (String
acc String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n") ScalarStyle
sty [Token]
rest

        go' Bool
ii String
acc sty :: ScalarStyle
sty@ScalarStyle
SingleQuoted
                    (Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.BeginEscape } :
                     Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.Indicator, tText :: Token -> String
Y.tText = String
"'" } :
                     Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.Meta, tText :: Token -> String
Y.tText = String
"'" } :
                     Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.EndEscape } :
                     [Token]
rest) = Bool -> String -> ScalarStyle -> Tok2EvStream
go' Bool
ii (String
acc String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'") ScalarStyle
sty [Token]
rest

        go' Bool
ii String
acc sty :: ScalarStyle
sty@ScalarStyle
SingleQuoted
                    (Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.Indicator, tText :: Token -> String
Y.tText = String
"'" } :
                     [Token]
rest) = Bool -> String -> ScalarStyle -> Tok2EvStream
go' Bool
ii String
acc ScalarStyle
sty [Token]
rest

        go' Bool
ii String
acc sty :: ScalarStyle
sty@ScalarStyle
DoubleQuoted
                    (Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.BeginEscape } :
                     Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.Indicator, tText :: Token -> String
Y.tText = String
"\\" } :
--                     Y.Token { Y.tCode = Y.Break } :
                     Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.EndEscape } :
                     [Token]
rest) = Bool -> String -> ScalarStyle -> Tok2EvStream
go' Bool
ii String
acc ScalarStyle
sty [Token]
rest -- line continuation escape

        go' Bool
ii String
acc sty :: ScalarStyle
sty@ScalarStyle
DoubleQuoted
                    (Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.BeginEscape } :
                     Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.Indicator, tText :: Token -> String
Y.tText = String
"\\" } :
                     Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.Meta, tText :: Token -> String
Y.tText = String
t } :
                     Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.EndEscape } :
                     [Token]
rest)
          | Just String
t' <- String -> Maybe String
unescape String
t = Bool -> String -> ScalarStyle -> Tok2EvStream
go' Bool
ii (String
acc String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
t') ScalarStyle
sty [Token]
rest

        go' Bool
ii String
acc sty :: ScalarStyle
sty@ScalarStyle
DoubleQuoted
                    (Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.BeginEscape } :
                     Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.Indicator, tText :: Token -> String
Y.tText = String
"\\" } :
                     Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.Indicator, tText :: Token -> String
Y.tText = String
pfx } :
                     Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.Meta, tText :: Token -> String
Y.tText = String
ucode } :
                     Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.EndEscape } :
                     [Token]
rest)
          | String
pfx String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"U", Just Char
c <- String -> Maybe Char
decodeCP2 String
ucode = Bool -> String -> ScalarStyle -> Tok2EvStream
go' Bool
ii (String
acc String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
c]) ScalarStyle
sty [Token]
rest
          | String
pfx String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"u", Just Char
c <- String -> Maybe Char
decodeCP  String
ucode = Bool -> String -> ScalarStyle -> Tok2EvStream
go' Bool
ii (String
acc String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
c]) ScalarStyle
sty [Token]
rest
          | String
pfx String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"x", Just Char
c <- String -> Maybe Char
decodeL1  String
ucode = Bool -> String -> ScalarStyle -> Tok2EvStream
go' Bool
ii (String
acc String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
c]) ScalarStyle
sty [Token]
rest

        go' Bool
ii String
acc sty :: ScalarStyle
sty@ScalarStyle
DoubleQuoted
                    (Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.Indicator, tText :: Token -> String
Y.tText = String
"\"" } :
                     [Token]
rest) = Bool -> String -> ScalarStyle -> Tok2EvStream
go' Bool
ii String
acc ScalarStyle
sty [Token]
rest

        go' Bool
ii String
acc ScalarStyle
sty (t :: Token
t@Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.EndScalar } :
                     [Token]
rest)
          | Bool
ii, String -> Bool
hasLeadingSpace String
acc = [(Pos, String) -> Either (Pos, String) EvPos
forall a b. a -> Either a b
Left (Token -> Pos
tok2pos Token
t, String
"leading empty lines contain more spaces than the first non-empty line in scalar: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
acc)]
          | Bool
otherwise = EvPos -> Either (Pos, String) EvPos
forall a b. b -> Either a b
Right (Event -> Pos -> EvPos
EvPos (Maybe TagHandle -> Tag -> ScalarStyle -> TagHandle -> Event
Scalar Maybe TagHandle
manchor Tag
tag ScalarStyle
sty (String -> TagHandle
T.pack String
acc)) Pos
pos0) Either (Pos, String) EvPos -> EvStream -> EvStream
forall a. a -> [a] -> [a]
: Tok2EvStream
cont [Token]
rest

        go' Bool
_ String
_ ScalarStyle
_ [Token]
xs = Tok2EvStream
err [Token]
xs

        hasLeadingSpace :: String -> Bool
hasLeadingSpace (Char
' ':String
_)   = Bool
True
        hasLeadingSpace (Char
'\n':String
cs) = String -> Bool
hasLeadingSpace String
cs
        hasLeadingSpace String
_         = Bool
False

    goSeq :: Tok2EvStreamCont
    goSeq :: Tok2EvStreamCont
goSeq (tok :: Token
tok@Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.EndSequence } : [Token]
rest) Tok2EvStream
cont = EvPos -> Either (Pos, String) EvPos
forall a b. b -> Either a b
Right (Event -> Token -> EvPos
getEvPos Event
SequenceEnd  Token
tok)Either (Pos, String) EvPos -> EvStream -> EvStream
forall a. a -> [a] -> [a]
: Tok2EvStream
cont [Token]
rest
    goSeq toks0 :: [Token]
toks0@(Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.BeginComment} : [Token]
_) Tok2EvStream
cont = Tok2EvStreamCont
goComment [Token]
toks0 (Tok2EvStreamCont -> Tok2EvStream -> Tok2EvStream
forall a b c. (a -> b -> c) -> b -> a -> c
flip Tok2EvStreamCont
goSeq Tok2EvStream
cont)
    goSeq (Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.BeginNode } : [Token]
rest) Tok2EvStream
cont = Tok2EvStreamCont
goNode [Token]
rest (Tok2EvStreamCont -> Tok2EvStream -> Tok2EvStream
forall a b c. (a -> b -> c) -> b -> a -> c
flip Tok2EvStreamCont
goSeq Tok2EvStream
cont)
    goSeq (tok :: Token
tok@Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.BeginMapping } : Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.Indicator, tText :: Token -> String
Y.tText = String
ind } :  [Token]
rest) Tok2EvStream
cont = EvPos -> Either (Pos, String) EvPos
forall a b. b -> Either a b
Right (Event -> Token -> EvPos
getEvPos (Maybe TagHandle -> Tag -> NodeStyle -> Event
MappingStart Maybe TagHandle
forall a. Maybe a
Nothing Tag
untagged (String -> NodeStyle
mapInd String
ind)) Token
tok) Either (Pos, String) EvPos -> EvStream -> EvStream
forall a. a -> [a] -> [a]
: Tok2EvStreamCont
goMap [Token]
rest (Tok2EvStreamCont -> Tok2EvStream -> Tok2EvStream
forall a b c. (a -> b -> c) -> b -> a -> c
flip Tok2EvStreamCont
goSeq Tok2EvStream
cont)
    goSeq (tok :: Token
tok@Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.BeginMapping } : [Token]
rest) Tok2EvStream
cont = EvPos -> Either (Pos, String) EvPos
forall a b. b -> Either a b
Right (Event -> Token -> EvPos
getEvPos (Maybe TagHandle -> Tag -> NodeStyle -> Event
MappingStart Maybe TagHandle
forall a. Maybe a
Nothing Tag
untagged NodeStyle
Block) Token
tok) Either (Pos, String) EvPos -> EvStream -> EvStream
forall a. a -> [a] -> [a]
: Tok2EvStreamCont
goMap [Token]
rest (Tok2EvStreamCont -> Tok2EvStream -> Tok2EvStream
forall a b c. (a -> b -> c) -> b -> a -> c
flip Tok2EvStreamCont
goSeq Tok2EvStream
cont)
    goSeq (Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.Indicator } : [Token]
rest) Tok2EvStream
cont = Tok2EvStreamCont
goSeq [Token]
rest Tok2EvStream
cont
--    goSeq xs _cont = error (show xs)
    goSeq [Token]
xs Tok2EvStream
_cont = Tok2EvStream
err [Token]
xs

    goMap :: Tok2EvStreamCont
    goMap :: Tok2EvStreamCont
goMap (tok :: Token
tok@Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.EndMapping } : [Token]
rest) Tok2EvStream
cont = EvPos -> Either (Pos, String) EvPos
forall a b. b -> Either a b
Right (Event -> Token -> EvPos
getEvPos Event
MappingEnd Token
tok) Either (Pos, String) EvPos -> EvStream -> EvStream
forall a. a -> [a] -> [a]
: Tok2EvStream
cont [Token]
rest
    goMap toks0 :: [Token]
toks0@(Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.BeginComment} : [Token]
_) Tok2EvStream
cont = Tok2EvStreamCont
goComment [Token]
toks0 (Tok2EvStreamCont -> Tok2EvStream -> Tok2EvStream
forall a b c. (a -> b -> c) -> b -> a -> c
flip Tok2EvStreamCont
goMap Tok2EvStream
cont)
    goMap (Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.BeginPair } : [Token]
rest) Tok2EvStream
cont = Tok2EvStreamCont
goPair1 [Token]
rest (Tok2EvStreamCont -> Tok2EvStream -> Tok2EvStream
forall a b c. (a -> b -> c) -> b -> a -> c
flip Tok2EvStreamCont
goMap Tok2EvStream
cont)
    goMap (Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.Indicator } : [Token]
rest) Tok2EvStream
cont = Tok2EvStreamCont
goMap [Token]
rest Tok2EvStream
cont
    goMap [Token]
xs Tok2EvStream
_cont = Tok2EvStream
err [Token]
xs

    goPair1 :: Tok2EvStreamCont
goPair1 (Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.BeginNode } : [Token]
rest) Tok2EvStream
cont = Tok2EvStreamCont
goNode [Token]
rest (Tok2EvStreamCont -> Tok2EvStream -> Tok2EvStream
forall a b c. (a -> b -> c) -> b -> a -> c
flip Tok2EvStreamCont
goPair2 Tok2EvStream
cont)
    goPair1 toks0 :: [Token]
toks0@(Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.BeginComment} : [Token]
_) Tok2EvStream
cont = Tok2EvStreamCont
goComment [Token]
toks0 (Tok2EvStreamCont -> Tok2EvStream -> Tok2EvStream
forall a b c. (a -> b -> c) -> b -> a -> c
flip Tok2EvStreamCont
goPair1 Tok2EvStream
cont)
    goPair1 (Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.Indicator } : [Token]
rest) Tok2EvStream
cont = Tok2EvStreamCont
goPair1 [Token]
rest Tok2EvStream
cont
    goPair1 [Token]
xs Tok2EvStream
_cont = Tok2EvStream
err [Token]
xs

    goPair2 :: Tok2EvStreamCont
goPair2 toks0 :: [Token]
toks0@(Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.BeginComment} : [Token]
_) Tok2EvStream
cont = Tok2EvStreamCont
goComment [Token]
toks0 (Tok2EvStreamCont -> Tok2EvStream -> Tok2EvStream
forall a b c. (a -> b -> c) -> b -> a -> c
flip Tok2EvStreamCont
goPair2 Tok2EvStream
cont)
    goPair2 (Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.BeginNode } : [Token]
rest) Tok2EvStream
cont = Tok2EvStreamCont
goNode [Token]
rest (Tok2EvStreamCont -> Tok2EvStream -> Tok2EvStream
forall a b c. (a -> b -> c) -> b -> a -> c
flip Tok2EvStreamCont
goPairEnd Tok2EvStream
cont)
    goPair2 (Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.Indicator } : [Token]
rest) Tok2EvStream
cont = Tok2EvStreamCont
goPair2 [Token]
rest Tok2EvStream
cont
    goPair2 [Token]
xs Tok2EvStream
_cont                                        = Tok2EvStream
err [Token]
xs

    goPairEnd :: Tok2EvStreamCont
goPairEnd toks0 :: [Token]
toks0@(Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.BeginComment} : [Token]
_) Tok2EvStream
cont = Tok2EvStreamCont
goComment [Token]
toks0 (Tok2EvStreamCont -> Tok2EvStream -> Tok2EvStream
forall a b c. (a -> b -> c) -> b -> a -> c
flip Tok2EvStreamCont
goPairEnd Tok2EvStream
cont)
    goPairEnd (Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.EndPair } : [Token]
rest) Tok2EvStream
cont = Tok2EvStream
cont [Token]
rest
    goPairEnd [Token]
xs Tok2EvStream
_cont                                      = Tok2EvStream
err [Token]
xs


goComment :: Tok2EvStreamCont
goComment :: Tok2EvStreamCont
goComment (tok :: Token
tok@Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.BeginComment} :
          Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.Indicator, tText :: Token -> String
Y.tText = String
"#" } :
          Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.Meta, tText :: Token -> String
Y.tText = String
comment } :
          Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.EndComment } : [Token]
rest) Tok2EvStream
cont   = (EvPos -> Either (Pos, String) EvPos
forall a b. b -> Either a b
Right (Event -> Token -> EvPos
getEvPos (TagHandle -> Event
Comment (String -> TagHandle
T.pack String
comment)) Token
tok)) Either (Pos, String) EvPos -> EvStream -> EvStream
forall a. a -> [a] -> [a]
: Tok2EvStream
cont [Token]
rest
goComment (tok :: Token
tok@Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.BeginComment} :
          Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.Indicator, tText :: Token -> String
Y.tText = String
"#" } :
          Y.Token { tCode :: Token -> Code
Y.tCode = Code
Y.EndComment } : [Token]
rest) Tok2EvStream
cont   = (EvPos -> Either (Pos, String) EvPos
forall a b. b -> Either a b
Right (Event -> Token -> EvPos
getEvPos (TagHandle -> Event
Comment TagHandle
T.empty) Token
tok)) Either (Pos, String) EvPos -> EvStream -> EvStream
forall a. a -> [a] -> [a]
: Tok2EvStream
cont [Token]
rest
goComment [Token]
xs Tok2EvStream
_cont = Tok2EvStream
err [Token]
xs

-- stripComments :: [Y.Token] -> [Y.Token]
-- stripComments (Y.Token { Y.tCode = Y.BeginComment } : rest) = skip rest
--   where
--     skip (Y.Token { Y.tCode = Y.EndComment } : rest') = stripComments rest'
--     skip (_                                  : rest') = skip rest'
--     skip [] = error "the impossible happened"
-- stripComments (t : rest) = t : stripComments rest
-- stripComments [] = []

type Tok2EvStream = [Y.Token] -> EvStream

type Tok2EvStreamCont = [Y.Token] -> Cont EvStream [Y.Token]

type Cont r a = (a -> r) -> r


-- decode 8-hex-digit unicode code-point
decodeCP2 :: String -> Maybe Char
decodeCP2 :: String -> Maybe Char
decodeCP2 String
s = case String
s of
               [Char
_,Char
_,Char
_,Char
_,Char
_,Char
_,Char
_,Char
_] | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
C.isHexDigit String
s
                                 , [(Integer
j, String
"")] <- ReadS Integer
forall a. (Eq a, Num a) => ReadS a
readHex String
s -> Char -> Maybe Char
forall a. a -> Maybe a
Just (Int -> Char
chr (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
j))
               String
_ -> Maybe Char
forall a. Maybe a
Nothing

-- decode 4-hex-digit unicode code-point
decodeCP :: String -> Maybe Char
decodeCP :: String -> Maybe Char
decodeCP String
s = case String
s of
               [Char
_,Char
_,Char
_,Char
_] | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
C.isHexDigit String
s
                         , [(Integer
j, String
"")] <- ReadS Integer
forall a. (Eq a, Num a) => ReadS a
readHex String
s -> Char -> Maybe Char
forall a. a -> Maybe a
Just (Int -> Char
chr (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
j))
               String
_ -> Maybe Char
forall a. Maybe a
Nothing

-- decode 2-hex-digit latin1 code-point
decodeL1 :: String -> Maybe Char
decodeL1 :: String -> Maybe Char
decodeL1 String
s = case String
s of
               [Char
_,Char
_] | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
C.isHexDigit String
s
                     , [(Integer
j, String
"")] <- ReadS Integer
forall a. (Eq a, Num a) => ReadS a
readHex String
s -> Char -> Maybe Char
forall a. a -> Maybe a
Just (Int -> Char
chr (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
j))
               String
_ -> Maybe Char
forall a. Maybe a
Nothing

-- decode C-style escapes
unescape :: String -> Maybe String
unescape :: String -> Maybe String
unescape [Char
c] = Char -> Map Char String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Char
c Map Char String
m
  where
    m :: Map Char String
m = [(Char, String)] -> Map Char String
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (Char
k,[Char
v]) | (Char
k,Char
v) <- [(Char, Char)]
escapes ]

    escapes :: [(Char,Char)]
    escapes :: [(Char, Char)]
escapes =
      [ (Char
'0',   Char
'\0')
      , (Char
'a',   Char
'\x7')
      , (Char
'b',   Char
'\x8')
      , (Char
'\x9', Char
'\x9')
      , (Char
't',   Char
'\x9')
      , (Char
'n',   Char
'\xa')
      , (Char
'v',   Char
'\xb')
      , (Char
'f',   Char
'\xc')
      , (Char
'r',   Char
'\xd')
      , (Char
'e',   Char
'\x1b')
      , (Char
' ',   Char
' ')
      , (Char
'"',   Char
'"')
      , (Char
'/',   Char
'/')
      , (Char
'\\',  Char
'\\')
      , (Char
'N',   Char
'\x85')
      , (Char
'_',   Char
'\xa0')
      , (Char
'L',   Char
'\x2028')
      , (Char
'P',   Char
'\x2029')
      ]
unescape String
_ = Maybe String
forall a. Maybe a
Nothing

--
-- $start
--
-- "Data.YAML" module provides us with API which allow us to interact with YAML data at the cost of some presentation details.
-- In contrast, this module provide us with API which gives us access to a other significant details like 'ScalarStyle's, 'NodeStyle's, 'Comment's, etc.
--
-- $parsing
--
-- Suppose you want to parse this YAML Document while preserving its format and comments
--
-- @
-- # Home runs
-- hr:  65
-- # Runs Batted In
-- rbi: 147
-- @
--
-- then you might want to use the function 'parseEvents'.
--
-- The following is a reference implementation of a function using 'parseEvents'.
-- It takes a YAML document as input and prints the parsed YAML 'Event's.
--
-- @
-- import Data.YAML.Event
-- import qualified Data.ByteString.Lazy as BS.L
--
-- printEvents :: BS.L.ByteString -> IO ()
-- printEvents input =
--   forM_ ('parseEvents' input) $ \ev -> case ev of
--     Left _ -> error "Failed to parse"
--     Right event -> print ('eEvent' event)
-- @
--
-- When we pass the above mentioned YAML document to the function /printEvents/ it outputs the following:
--
-- > StreamStart
-- > DocumentStart NoDirEndMarker
-- > MappingStart Nothing Nothing Block
-- > Comment " Home runs"
-- > Scalar Nothing Nothing Plain "hr"
-- > Scalar Nothing Nothing Plain "65"
-- > Comment " Runs Batted In"
-- > Scalar Nothing Nothing Plain "rbi"
-- > Scalar Nothing Nothing Plain "147"
-- > MappingEnd
-- > DocumentEnd False
-- > StreamEnd
--
-- Notice that now we have all the necessary details in the form of 'Event's.
--
-- We can now write simple functions to work with this data without losing any more details.
--
-- $serialize
--
-- Now, suppose we want to generate back the YAML document after playing with the Event-stream,
-- then you might want to use 'writeEvents'.
--
-- The following function takes a YAML document as a input and dumps it back to STDOUT after a round-trip.
--
-- @
-- import Data.YAML.Event
-- import qualified Data.YAML.Token as YT
-- import qualified Data.ByteString.Lazy as BS.L
--
-- yaml2yaml :: BS.L.ByteString -> IO ()
-- yaml2yaml input = case sequence $ parseEvents input of
--     Left _ -> error "Parsing Failure!"
--     Right events -> do
--       BS.L.hPutStr stdout (writeEvents YT.UTF8 (map eEvent events))
--       hFlush stdout
-- @
--
-- Let this be the sample document passed to the above function
--
-- @
-- # This is a 'Directives' Marker
-- ---
-- # All 'Comment's are preserved
-- date    : 2019-07-12
-- bill-to : # 'Anchor' represents a map node
--    &id001
--     address:
--         lines: # This a Block 'Scalar' with 'Keep' chomping Indicator and 'IndentAuto' Indentant indicator
--                 |+ # Extra Indentation (non-content white space) will not be preserved
--                       Vijay
--                       IIT Hyderabad
--
--
--         # Trailing newlines are a preserved here as they are a part of the 'Scalar' node
--         country    : India
-- ship-to  : # This is an 'Alias'
--            *id001
-- # Key is a 'Scalar' and Value is a Sequence
-- Other Details:
--           total: $ 3000
--           # 'Tag's are also preserved
--           Online Payment: !!bool True
--           product:
--               - Item1
--               # This comment is inside a Sequence
--               - Item2
-- ...
-- # 'DocumentEnd' True
-- # 'StreamEnd'
-- @
--
-- This function outputs the following
--
-- @
-- # This is a 'Directives' Marker
-- ---
-- # All 'Comment's are preserved
-- date: 2019-07-12
-- bill-to: # 'Anchor' represents a map node
--   &id001
--   address:
--     lines: # This a Block 'Scalar' with 'Keep' chomping Indicator and 'IndentAuto' Indentant indicator
--       # Extra Indentation (non-content white space) will not be preserved
--       |+
--       Vijay
--       IIT Hyderabad
--
--
--     # Trailing newlines are a preserved here as they are a part of the 'Scalar' node
--     country: India
-- ship-to: # This is an 'Alias'
--   *id001
-- # Key is a 'Scalar' and Value is a Sequence
-- Other Details:
--   total: $ 3000
--   # 'Tag's are also preserved
--   Online Payment: !!bool True
--   product:
--   - Item1
--   # This comment is inside a Sequence
--   - Item2
-- ...
-- # 'DocumentEnd' True
-- # 'StreamEnd'
-- @
--
-- $commenting
--
-- Round-tripping at event-level will preserve all the comments and their relative position in the YAML-document but still,
-- we lose some information like the exact indentation and the position at which the comments were present previously.
-- This information sometimes can be quite important for human-perception of comments.
-- Below are some guildlines, so that you can avoid ambiguities.
--
-- 1) Always try to start your comment in a newline. This step will avoid most of the ambiguities.
--
-- 2) Comments automaticly get indented according to the level in which they are present. For example,
--
-- Input YAML-document
--
-- @
-- # Level 0
-- - a
-- # Level 0
-- - - a
-- # Level 1
--   - a
--   - - a
-- # Level 2
--     - a
-- @
--
-- After a round-trip looks like
--
-- @
-- # Level 0
-- - a
-- # Level 0
-- - - a
--   # Level 1
--   - a
--   - - a
--     # Level 2
--     - a
-- @
--
-- 3) Comments immediately after a 'Scalar' node, start from a newline. So avoid commenting just after a scalar ends, as it may lead to some ambiguity. For example,
--
-- Input YAML-document
--
-- @
-- - scalar # After scalar
-- - random  : scalar # After scalar
--   key: 1
-- # not after scalar
-- - random  : scalar
--   key: 1
-- - random  : # not after scalar
--             scalar
--   # not after scalar
--   key: 1
-- @
--
-- After a round-trip looks like
--
-- @
-- - scalar
-- # After scalar
-- - random: scalar
--   # After scalar
--   key: 1
--   # not after scalar
-- - random: scalar
--   key: 1
-- - random: # not after scalar
--     scalar
--   # not after scalar
--   key: 1
-- @
--
-- 4) Similarly in flow-style, avoid commenting immediately after a /comma/ (@,@) seperator. Comments immediately after a /comma/ (@,@) seperator will start from a new line
--
-- Input YAML-document
--
-- @
-- {
--     # comment 0
--     Name: Vijay # comment 1
--     ,
--     # comment 2
--     age: 19, # comment 3
--     # comment 4
--     country: India # comment 5
-- }
-- @
--
-- After a round-trip looks like
--
-- @
-- {
--   # comment 0
--   Name: Vijay,
--   # comment 1
--   # comment 2
--   age: 19,
--   # comment 3
--   # comment 4
--   country: India,
--   # comment 5
-- }
-- @
--
-- 5) Avoid commenting in between syntatical elements. For example,
--
-- Input YAML-document
--
-- @
-- ? # Complex key starts
--   [
--      a,
--      b
--   ]
--  # Complex key ends
-- : # Complex Value starts
--   ? # Complex key starts
--     [
--        a,
--        b
--     ]
--     # Complex key ends
--   : # Simple value
--     a
--   # Complex value ends
-- @
--
-- After a round-trip looks like
--
-- @
-- ? # Complex key starts
--   [
--      a,
--      b
--  ]
-- : # Complex key ends
--   # Complex Value starts
--
--   ? # Complex key starts
--     [
--        a,
--        b
--    ]
--   : # Complex key ends
--     # Simple value
--     a
--   # Complex value ends
-- @
--
-- The above two YAML-documents, after parsing produce the same 'Event'-stream.
--
-- So, these are some limitation of this Format-preserving YAML processor.