module Z.Data.YAML
(
decode
, encode
, readYAMLFile
, writeYAMLFile
, initParser, initFileParser
, parseSingleDoucment
, parseAllDocuments
, initEmitter, initFileEmitter
, buildSingleDocument
, buildValue
, YAMLError(..)
, YAMLParseError(..)
, ConvertError(..)
, DecodeError
, JSON(..)
, Value(..)
) where
import Control.Applicative
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Reader
import Data.Bits ((.|.), unsafeShiftL)
import Data.IORef
import qualified Data.HashMap.Strict as HM
import qualified Data.HashSet as HS
import qualified Data.Scientific as Sci
import GHC.Generics (Generic)
import System.IO.Unsafe
import Z.Data.ASCII
import qualified Z.Data.Parser as P
import qualified Z.Data.Vector as V
import qualified Z.Data.Text as T
import Z.Data.JSON (JSON(..), Value(..), ConvertError, convertValue)
import Z.Data.YAML.FFI
import qualified Z.Data.Vector.FlatMap as FM
import qualified Z.Data.Builder as B
import Z.Data.CBytes (CBytes)
import Z.Data.YAML.FFI
import Z.IO
type DecodeError = Either YAMLError ConvertError
readYAMLFile :: forall a. (HasCallStack, JSON a) => CBytes -> IO a
readYAMLFile :: forall a. (HasCallStack, JSON a) => CBytes -> IO a
readYAMLFile CBytes
p = forall e a. (HasCallStack, Print e) => Text -> Either e a -> IO a
unwrap Text
"EPARSE" forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a b.
(MonadMask m, MonadIO m, HasCallStack) =>
Resource a -> (a -> m b) -> m b
withResource (HasCallStack => CBytes -> Resource (IO (Maybe MarkedEvent))
initFileParser CBytes
p) (\ IO (Maybe MarkedEvent)
src -> do
Either YAMLError Value
r <- forall e a. Exception e => IO a -> IO (Either e a)
try (HasCallStack => IO (Maybe MarkedEvent) -> IO Value
parseSingleDoucment IO (Maybe MarkedEvent)
src)
case Either YAMLError Value
r of
Left (YAMLError
e :: YAMLError) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left (forall a b. a -> Either a b
Left YAMLError
e))
Right Value
r' -> case (forall a. JSON a => Value -> Either ConvertError a
convertValue Value
r' :: Either ConvertError a) of
Left ConvertError
e' -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left (forall a b. b -> Either a b
Right ConvertError
e'))
Right a
v -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right a
v))
decode :: forall a .(HasCallStack, JSON a) => V.Bytes -> Either DecodeError a
decode :: forall a.
(HasCallStack, JSON a) =>
Bytes -> Either (Either YAMLError ConvertError) a
decode Bytes
bs = forall a. IO a -> a
unsafePerformIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a b.
(MonadMask m, MonadIO m, HasCallStack) =>
Resource a -> (a -> m b) -> m b
withResource (Bytes -> Resource (IO (Maybe MarkedEvent))
initParser Bytes
bs) forall a b. (a -> b) -> a -> b
$ \ IO (Maybe MarkedEvent)
src -> do
Either YAMLError Value
r <- forall e a. Exception e => IO a -> IO (Either e a)
try (HasCallStack => IO (Maybe MarkedEvent) -> IO Value
parseSingleDoucment IO (Maybe MarkedEvent)
src)
case Either YAMLError Value
r of
Left YAMLError
e -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left (forall a b. a -> Either a b
Left YAMLError
e))
Right Value
r' -> case (forall a. JSON a => Value -> Either ConvertError a
convertValue Value
r' :: Either ConvertError a) of
Left ConvertError
e' -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left (forall a b. b -> Either a b
Right ConvertError
e'))
Right a
v -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right a
v)
writeYAMLFile :: (HasCallStack, JSON a) => YAMLFormatOpts -> CBytes -> a -> IO ()
writeYAMLFile :: forall a.
(HasCallStack, JSON a) =>
YAMLFormatOpts -> CBytes -> a -> IO ()
writeYAMLFile YAMLFormatOpts
opts CBytes
p a
x = forall (m :: * -> *) a b.
(MonadMask m, MonadIO m, HasCallStack) =>
Resource a -> (a -> m b) -> m b
withResource (HasCallStack =>
YAMLFormatOpts -> CBytes -> Resource (Event -> IO ())
initFileEmitter YAMLFormatOpts
opts CBytes
p) forall a b. (a -> b) -> a -> b
$ \ Event -> IO ()
sink ->
HasCallStack => (Event -> IO ()) -> Value -> IO ()
buildSingleDocument Event -> IO ()
sink (forall a. JSON a => a -> Value
toValue a
x)
encode :: (HasCallStack, JSON a) => YAMLFormatOpts -> a -> T.Text
encode :: forall a. (HasCallStack, JSON a) => YAMLFormatOpts -> a -> Text
encode YAMLFormatOpts
opts a
x = forall a. IO a -> a
unsafePerformIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a b.
(MonadMask m, MonadIO m, HasCallStack) =>
Resource a -> (a -> m b) -> m b
withResource (YAMLFormatOpts -> Resource (Ptr EmitterStruct, Event -> IO ())
initEmitter YAMLFormatOpts
opts) forall a b. (a -> b) -> a -> b
$ \ (Ptr EmitterStruct
p, Event -> IO ()
sink) -> do
HasCallStack => (Event -> IO ()) -> Value -> IO ()
buildSingleDocument Event -> IO ()
sink (forall a. JSON a => a -> Value
toValue a
x)
Ptr EmitterStruct -> IO Text
getEmitterResult Ptr EmitterStruct
p
parseSingleDoucment :: HasCallStack => IO (Maybe MarkedEvent) -> IO Value
parseSingleDoucment :: HasCallStack => IO (Maybe MarkedEvent) -> IO Value
parseSingleDoucment IO (Maybe MarkedEvent)
src = do
[Value]
docs <- HasCallStack => IO (Maybe MarkedEvent) -> IO [Value]
parseAllDocuments IO (Maybe MarkedEvent)
src
case [Value]
docs of
[] -> forall (m :: * -> *) a. Monad m => a -> m a
return Value
Null
[Value
doc] -> forall (m :: * -> *) a. Monad m => a -> m a
return Value
doc
[Value]
_ -> forall e a. Exception e => e -> IO a
throwIO (Text -> YAMLError
OtherYAMLError Text
"multiple YAML documents")
parseAllDocuments :: HasCallStack => IO (Maybe MarkedEvent) -> IO [Value]
parseAllDocuments :: HasCallStack => IO (Maybe MarkedEvent) -> IO [Value]
parseAllDocuments IO (Maybe MarkedEvent)
src = do
Maybe MarkedEvent
me <- IO (Maybe MarkedEvent)
src
case Maybe MarkedEvent
me of
Just (MarkedEvent Event
EventStreamStart Mark
_ Mark
_) -> do
IORef (HashMap Text Value)
as <- forall a. a -> IO (IORef a)
newIORef forall k v. HashMap k v
HM.empty
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT
(IO (Maybe MarkedEvent), IORef (HashMap Text Value)) IO [Value]
parseDocs (IO (Maybe MarkedEvent)
src, IORef (HashMap Text Value)
as)) forall a b. (a -> b) -> a -> b
$ \ (YAMLParseError
e :: YAMLParseError) ->
forall a. YAMLParseError -> IO a
throwYAMLError YAMLParseError
e
Just MarkedEvent
me' -> forall a. YAMLParseError -> IO a
throwYAMLError (MarkedEvent -> YAMLParseError
UnexpectedEvent MarkedEvent
me')
Maybe MarkedEvent
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return []
where
parseDocs :: ReaderT
(IO (Maybe MarkedEvent), IORef (HashMap Text Value)) IO [Value]
parseDocs = do
MarkedEvent
me <- ParserIO MarkedEvent
pullEvent
case MarkedEvent
me of
MarkedEvent Event
EventStreamEnd Mark
_ Mark
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return []
MarkedEvent Event
EventDocumentStart Mark
_ Mark
_ -> do
Value
res <- MarkedEvent
-> ReaderT
(IO (Maybe MarkedEvent), IORef (HashMap Text Value)) IO Value
parseValue forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ParserIO MarkedEvent
pullEvent
MarkedEvent
me' <- ParserIO MarkedEvent
pullEvent
case MarkedEvent
me' of
MarkedEvent Event
EventDocumentEnd Mark
_ Mark
_ ->
(Value
res forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
(IO (Maybe MarkedEvent), IORef (HashMap Text Value)) IO [Value]
parseDocs
MarkedEvent
me'' -> forall a. YAMLParseError -> ParserIO a
throwParserIO (MarkedEvent -> YAMLParseError
UnexpectedEvent MarkedEvent
me'')
type ParserIO = ReaderT (IO (Maybe MarkedEvent), IORef (HM.HashMap T.Text Value)) IO
pullEvent :: ParserIO MarkedEvent
pullEvent :: ParserIO MarkedEvent
pullEvent = do
(IO (Maybe MarkedEvent)
src, IORef (HashMap Text Value)
_) <- forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Maybe MarkedEvent
me <- IO (Maybe MarkedEvent)
src
case Maybe MarkedEvent
me of Just MarkedEvent
e -> forall (m :: * -> *) a. Monad m => a -> m a
return MarkedEvent
e
Maybe MarkedEvent
_ -> forall e a. Exception e => e -> IO a
throwIO YAMLParseError
UnexpectedEventEnd
throwParserIO :: YAMLParseError -> ParserIO a
throwParserIO :: forall a. YAMLParseError -> ParserIO a
throwParserIO = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Exception e => e -> IO a
throwIO
defineAnchor :: T.Text -> Value -> ParserIO ()
defineAnchor :: Text -> Value -> ParserIO ()
defineAnchor Text
key Value
value = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
T.null Text
key) forall a b. (a -> b) -> a -> b
$ do
(IO (Maybe MarkedEvent)
_, IORef (HashMap Text Value)
mref) <- forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef (HashMap Text Value)
mref (forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert Text
key Value
value)
lookupAlias :: MarkedEvent -> T.Text -> ParserIO Value
lookupAlias :: MarkedEvent
-> Text
-> ReaderT
(IO (Maybe MarkedEvent), IORef (HashMap Text Value)) IO Value
lookupAlias MarkedEvent
me Text
key = do
(IO (Maybe MarkedEvent)
_, IORef (HashMap Text Value)
mref) <- forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
HashMap Text Value
m <- forall a. IORef a -> IO a
readIORef IORef (HashMap Text Value)
mref
case forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Text
key HashMap Text Value
m of
Just Value
v -> forall (m :: * -> *) a. Monad m => a -> m a
return Value
v
Maybe Value
_ -> forall e a. Exception e => e -> IO a
throwIO (MarkedEvent -> YAMLParseError
UnknownAlias MarkedEvent
me)
textToValue :: ScalarStyle -> Tag -> T.Text -> Value
textToValue :: ScalarStyle -> Tag -> Text -> Value
textToValue ScalarStyle
SingleQuoted Tag
_ Text
t = Text -> Value
String Text
t
textToValue ScalarStyle
DoubleQuoted Tag
_ Text
t = Text -> Value
String Text
t
textToValue ScalarStyle
_ Tag
StrTag Text
t = Text -> Value
String Text
t
textToValue ScalarStyle
Folded Tag
_ Text
t = Text -> Value
String Text
t
textToValue ScalarStyle
_ Tag
_ Text
t
| Text
t forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"null", Text
"Null", Text
"NULL", Text
"~", Text
""] = Value
Null
| Text
t forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"y", Text
"Y", Text
"yes", Text
"on", Text
"true", Text
"YES", Text
"ON", Text
"TRUE", Text
"Yes", Text
"On", Text
"True"] = Bool -> Value
Bool Bool
True
| Text
t forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"n", Text
"N", Text
"no", Text
"off", Text
"false", Text
"NO", Text
"OFF", Text
"FALSE", Text
"No", Text
"Off", Text
"False"] = Bool -> Value
Bool Bool
False
| Right Scientific
x <- Text -> Either [Text] Scientific
textToScientific Text
t = Scientific -> Value
Number Scientific
x
| Bool
otherwise = Text -> Value
String Text
t
textToScientific :: T.Text -> Either P.ParseError Sci.Scientific
textToScientific :: Text -> Either [Text] Scientific
textToScientific = forall a. Parser a -> Bytes -> Either [Text] a
P.parse' (Parser Scientific
num forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
P.endOfInput) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bytes
T.getUTF8Bytes
where
num :: Parser Scientific
num = (forall a. Num a => Integer -> a
fromInteger forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bytes -> Parser ()
P.bytes Bytes
"0x" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. (Integral a, Bits a) => Parser a
P.hex_ @Integer))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall a. Num a => Integer -> a
fromInteger forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bytes -> Parser ()
P.bytes Bytes
"0o" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Integer
octal))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Scientific
P.scientific
octal :: Parser Integer
octal = forall (v :: * -> *) a b. Vec v a => (b -> a -> b) -> b -> v a -> b
V.foldl' forall {a}. (Bits a, Num a) => a -> Word8 -> a
step Integer
0 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word8 -> Bool) -> Parser Bytes
P.takeWhile1 (\ Word8
w -> Word8
w forall a. Ord a => a -> a -> Bool
>= Word8
DIGIT_0 Bool -> Bool -> Bool
&& Word8
w forall a. Ord a => a -> a -> Bool
< Word8
DIGIT_0forall a. Num a => a -> a -> a
+Word8
8)
step :: a -> Word8 -> a
step a
a Word8
c = (a
a forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
3) forall a. Bits a => a -> a -> a
.|. forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
c forall a. Num a => a -> a -> a
- Word8
DIGIT_0)
parseValue :: MarkedEvent -> ParserIO Value
parseValue :: MarkedEvent
-> ReaderT
(IO (Maybe MarkedEvent), IORef (HashMap Text Value)) IO Value
parseValue me :: MarkedEvent
me@(MarkedEvent Event
e Mark
startMark Mark
endMark) =
case Event
e of
EventScalar Text
anchor Text
v Tag
tag ScalarStyle
style -> do
let !v' :: Value
v' = ScalarStyle -> Tag -> Text -> Value
textToValue ScalarStyle
style Tag
tag Text
v
Text -> Value -> ParserIO ()
defineAnchor Text
anchor Value
v'
forall (m :: * -> *) a. Monad m => a -> m a
return Value
v'
EventSequenceStart Text
anchor Tag
_ ScalarStyle
_ -> do
!Value
v <- ReaderT
(IO (Maybe MarkedEvent), IORef (HashMap Text Value)) IO Value
parseSequence
Text -> Value -> ParserIO ()
defineAnchor Text
anchor Value
v
forall (m :: * -> *) a. Monad m => a -> m a
return Value
v
EventMappingStart Text
anchor Tag
_ ScalarStyle
_ -> do
!Value
v <- ReaderT
(IO (Maybe MarkedEvent), IORef (HashMap Text Value)) IO Value
parseMapping
Text -> Value -> ParserIO ()
defineAnchor Text
anchor Value
v
forall (m :: * -> *) a. Monad m => a -> m a
return Value
v
EventAlias Text
anchor -> MarkedEvent
-> Text
-> ReaderT
(IO (Maybe MarkedEvent), IORef (HashMap Text Value)) IO Value
lookupAlias MarkedEvent
me Text
anchor
Event
_ -> forall a. YAMLParseError -> ParserIO a
throwParserIO (MarkedEvent -> YAMLParseError
UnexpectedEvent MarkedEvent
me)
parseSequence :: ParserIO Value
parseSequence :: ReaderT
(IO (Maybe MarkedEvent), IORef (HashMap Text Value)) IO Value
parseSequence = Vector Value -> Value
Array forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) a. Vec v a => [a] -> v a
V.packR forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Value]
-> ReaderT
(IO (Maybe MarkedEvent), IORef (HashMap Text Value)) IO [Value]
go []
where
go :: [Value]
-> ReaderT
(IO (Maybe MarkedEvent), IORef (HashMap Text Value)) IO [Value]
go [Value]
acc = do
MarkedEvent
e <- ParserIO MarkedEvent
pullEvent
case MarkedEvent
e of
MarkedEvent Event
EventSequenceEnd Mark
_ Mark
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return [Value]
acc
MarkedEvent
_ -> do
Value
o <- MarkedEvent
-> ReaderT
(IO (Maybe MarkedEvent), IORef (HashMap Text Value)) IO Value
parseValue MarkedEvent
e
[Value]
-> ReaderT
(IO (Maybe MarkedEvent), IORef (HashMap Text Value)) IO [Value]
go (Value
oforall a. a -> [a] -> [a]
:[Value]
acc)
parseMapping :: ParserIO Value
parseMapping :: ReaderT
(IO (Maybe MarkedEvent), IORef (HashMap Text Value)) IO Value
parseMapping = Vector (Text, Value) -> Value
Object forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) a. Vec v a => [a] -> v a
V.packR forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Value)]
-> ReaderT
(IO (Maybe MarkedEvent), IORef (HashMap Text Value))
IO
[(Text, Value)]
go []
where
go :: [(Text, Value)]
-> ReaderT
(IO (Maybe MarkedEvent), IORef (HashMap Text Value))
IO
[(Text, Value)]
go [(Text, Value)]
acc = do
MarkedEvent
me <- ParserIO MarkedEvent
pullEvent
case MarkedEvent
me of
MarkedEvent Event
EventMappingEnd Mark
_ Mark
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return [(Text, Value)]
acc
MarkedEvent Event
e Mark
startMark Mark
endMark -> do
Text
key <- case Event
e of
EventScalar Text
anchor Text
v Tag
tag ScalarStyle
style ->
case ScalarStyle -> Tag -> Text -> Value
textToValue ScalarStyle
style Tag
tag Text
v of
k :: Value
k@(String Text
k') -> do
Text -> Value -> ParserIO ()
defineAnchor Text
anchor Value
k
forall (m :: * -> *) a. Monad m => a -> m a
return Text
k'
Value
_ -> forall a. YAMLParseError -> ParserIO a
throwParserIO (MarkedEvent -> YAMLParseError
NonStringKey MarkedEvent
me)
EventAlias Text
anchor -> do
Value
m <- MarkedEvent
-> Text
-> ReaderT
(IO (Maybe MarkedEvent), IORef (HashMap Text Value)) IO Value
lookupAlias MarkedEvent
me Text
anchor
case Value
m of
String Text
k -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
k
Value
_ -> forall a. YAMLParseError -> ParserIO a
throwParserIO (MarkedEvent -> YAMLParseError
NonStringKeyAlias MarkedEvent
me)
Event
e -> forall a. YAMLParseError -> ParserIO a
throwParserIO (MarkedEvent -> YAMLParseError
UnexpectedEvent MarkedEvent
me)
Value
value <- MarkedEvent
-> ReaderT
(IO (Maybe MarkedEvent), IORef (HashMap Text Value)) IO Value
parseValue forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ParserIO MarkedEvent
pullEvent
if Text
key forall a. Eq a => a -> a -> Bool
== Text
"<<"
then case Value
value of
Object Vector (Text, Value)
kvs -> [(Text, Value)]
-> ReaderT
(IO (Maybe MarkedEvent), IORef (HashMap Text Value))
IO
[(Text, Value)]
go (forall (v :: * -> *) a. Vec v a => v a -> [a]
V.unpackR Vector (Text, Value)
kvs forall a. [a] -> [a] -> [a]
++ [(Text, Value)]
acc)
Array Vector Value
vs -> [(Text, Value)]
-> ReaderT
(IO (Maybe MarkedEvent), IORef (HashMap Text Value))
IO
[(Text, Value)]
go (forall (v :: * -> *) a b. Vec v a => (a -> b -> b) -> b -> v a -> b
V.foldr' Value -> [(Text, Value)] -> [(Text, Value)]
mergeMapping [(Text, Value)]
acc Vector Value
vs)
Value
v -> forall a. YAMLParseError -> ParserIO a
throwParserIO (MarkedEvent -> YAMLParseError
UnexpectedEvent MarkedEvent
me)
else [(Text, Value)]
-> ReaderT
(IO (Maybe MarkedEvent), IORef (HashMap Text Value))
IO
[(Text, Value)]
go ((Text
key, Value
value)forall a. a -> [a] -> [a]
:[(Text, Value)]
acc)
mergeMapping :: Value -> [(Text, Value)] -> [(Text, Value)]
mergeMapping (Object Vector (Text, Value)
o) [(Text, Value)]
acc = [(Text, Value)]
acc forall a. [a] -> [a] -> [a]
++ forall (v :: * -> *) a. Vec v a => v a -> [a]
V.unpackR Vector (Text, Value)
o
mergeMapping Value
v [(Text, Value)]
acc = [(Text, Value)]
acc
buildSingleDocument :: HasCallStack => (Event -> IO ()) -> Value -> IO ()
buildSingleDocument :: HasCallStack => (Event -> IO ()) -> Value -> IO ()
buildSingleDocument Event -> IO ()
sink Value
v = do
Event -> IO ()
sink Event
EventStreamStart
Event -> IO ()
sink Event
EventDocumentStart
HasCallStack => (Event -> IO ()) -> Value -> IO ()
buildValue Event -> IO ()
sink Value
v
Event -> IO ()
sink Event
EventDocumentEnd
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Event -> IO ()
sink Event
EventStreamEnd
buildValue :: HasCallStack => (Event -> IO ()) -> Value -> IO ()
buildValue :: HasCallStack => (Event -> IO ()) -> Value -> IO ()
buildValue Event -> IO ()
sink (Array Vector Value
vs) = do
Event -> IO ()
sink (Text -> Tag -> ScalarStyle -> Event
EventSequenceStart Text
"" Tag
NoTag ScalarStyle
AnySequence)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (HasCallStack => (Event -> IO ()) -> Value -> IO ()
buildValue Event -> IO ()
sink) (forall (v :: * -> *) a. Vec v a => v a -> [a]
V.unpack Vector Value
vs)
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Event -> IO ()
sink Event
EventSequenceEnd
buildValue Event -> IO ()
sink (Object Vector (Text, Value)
o) = do
Event -> IO ()
sink (Text -> Tag -> ScalarStyle -> Event
EventMappingStart Text
"" Tag
NoTag ScalarStyle
AnyMapping)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Text, Value) -> IO ()
encodeKV (forall (v :: * -> *) a. Vec v a => v a -> [a]
V.unpack Vector (Text, Value)
o)
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Event -> IO ()
sink Event
EventMappingEnd
where
encodeKV :: (Text, Value) -> IO ()
encodeKV (Text
k, Value
v) = HasCallStack => (Event -> IO ()) -> Value -> IO ()
buildValue Event -> IO ()
sink (Text -> Value
String Text
k) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HasCallStack => (Event -> IO ()) -> Value -> IO ()
buildValue Event -> IO ()
sink Value
v
buildValue Event -> IO ()
sink (String Text
s) = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Event -> IO ()
sink (Text -> Text -> Tag -> ScalarStyle -> Event
EventScalar Text
"" Text
s Tag
NoTag (Text -> ScalarStyle
stringStyle Text
s))
where
stringStyle :: Text -> ScalarStyle
stringStyle Text
s
| (Int
_, Just Char
_) <- (forall a. Eq a => a -> a -> Bool
== Char
'\n') (Char -> Bool) -> Text -> (Int, Maybe Char)
`T.find` Text
s = ScalarStyle
Literal
| Text -> Bool
isSpecialString Text
s = ScalarStyle
SingleQuoted
| Bool
otherwise = ScalarStyle
PlainNoTag
isSpecialString :: Text -> Bool
isSpecialString Text
s = Text
s forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`HS.member` HashSet Text
specialStrings Bool -> Bool -> Bool
|| Text -> Bool
isNumeric Text
s
specialStrings :: HashSet Text
specialStrings = forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.words
Text
"y Y yes Yes YES n N no No NO true True TRUE false False FALSE on On ON off Off OFF null Null NULL ~ *"
isNumeric :: Text -> Bool
isNumeric = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const Bool
False) (forall a b. a -> b -> a
const Bool
True) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Text] Scientific
textToScientific
buildValue Event -> IO ()
sink Value
Null = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Event -> IO ()
sink (Text -> Text -> Tag -> ScalarStyle -> Event
EventScalar Text
"" Text
"null" Tag
NullTag ScalarStyle
PlainNoTag)
buildValue Event -> IO ()
sink (Bool Bool
True) = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Event -> IO ()
sink (Text -> Text -> Tag -> ScalarStyle -> Event
EventScalar Text
"" Text
"true" Tag
BoolTag ScalarStyle
PlainNoTag)
buildValue Event -> IO ()
sink (Bool Bool
False) = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Event -> IO ()
sink (Text -> Text -> Tag -> ScalarStyle -> Event
EventScalar Text
"" Text
"false" Tag
BoolTag ScalarStyle
PlainNoTag)
buildValue Event -> IO ()
sink (Number Scientific
s) = do
let builder :: Builder ()
builder
| Scientific -> Int
Sci.base10Exponent Scientific
s forall a. Eq a => a -> a -> Bool
== Int
0 = Integer -> Builder ()
B.integer forall a b. (a -> b) -> a -> b
$ Scientific -> Integer
Sci.coefficient Scientific
s
| Bool
otherwise = Scientific -> Builder ()
B.scientific Scientific
s
t :: Text
t = forall a. Builder a -> Text
B.unsafeBuildText Builder ()
builder
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Event -> IO ()
sink (Text -> Text -> Tag -> ScalarStyle -> Event
EventScalar Text
"" Text
t Tag
IntTag ScalarStyle
PlainNoTag)