{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}
module Data.Yaml.Parser where
import Control.Applicative
import Control.Monad (MonadPlus (..), liftM, ap)
import Control.Exception.Safe
import Control.Monad.IO.Class
import Control.Monad.Trans.Writer.Strict (tell, WriterT, runWriterT)
import Data.ByteString (ByteString)
import qualified Data.Map as Map
#if !MIN_VERSION_base(4,8,0)
import Data.Monoid (Monoid (..))
#endif
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup (Semigroup(..))
#endif
import Data.Yaml.Internal
import Data.Text (Text, pack, unpack)
import Data.Text.Encoding (decodeUtf8)
import Data.Text.Read (signed, decimal)
import Streamly.Prelude (SerialT)
import Streamly.Internal.Data.Parser (Parser)
import qualified Streamly.Internal.Data.Stream.IsStream.Eliminate as Stream
import Streamly.Internal.Data.Parser.ParserK.Type (fromEffect, die)
import Streamly.Internal.Data.Parser.ParserK.Type (toParserK)
#if MIN_VERSION_streamly(0,8,1)
import Streamly.Internal.Data.Stream.IsStream.Lift (hoist)
#else
import Streamly.Internal.Data.Stream.StreamK (hoist)
#endif
import Text.Libyaml
newtype YamlParser a = YamlParser
{ forall a. YamlParser a -> AnchorMap -> Either Text a
unYamlParser :: AnchorMap -> Either Text a
}
instance Functor YamlParser where
fmap :: forall a b. (a -> b) -> YamlParser a -> YamlParser b
fmap = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
instance Applicative YamlParser where
pure :: forall a. a -> YamlParser a
pure = forall a. (AnchorMap -> Either Text a) -> YamlParser a
YamlParser forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right
<*> :: forall a b. YamlParser (a -> b) -> YamlParser a -> YamlParser b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Alternative YamlParser where
empty :: forall a. YamlParser a
empty = forall (m :: * -> *) a. MonadFail m => AnchorName -> m a
fail AnchorName
"empty"
<|> :: forall a. YamlParser a -> YamlParser a -> YamlParser a
(<|>) = forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
instance Semigroup (YamlParser a) where
<> :: YamlParser a -> YamlParser a -> YamlParser a
(<>) = forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
instance Monoid (YamlParser a) where
mempty :: YamlParser a
mempty = forall (m :: * -> *) a. MonadFail m => AnchorName -> m a
fail AnchorName
"mempty"
#if !MIN_VERSION_base(4,11,0)
mappend = (<>)
#endif
instance Monad YamlParser where
return :: forall a. a -> YamlParser a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
YamlParser AnchorMap -> Either Text a
f >>= :: forall a b. YamlParser a -> (a -> YamlParser b) -> YamlParser b
>>= a -> YamlParser b
g = forall a. (AnchorMap -> Either Text a) -> YamlParser a
YamlParser forall a b. (a -> b) -> a -> b
$ \AnchorMap
am ->
case AnchorMap -> Either Text a
f AnchorMap
am of
Left Text
t -> forall a b. a -> Either a b
Left Text
t
Right a
x -> forall a. YamlParser a -> AnchorMap -> Either Text a
unYamlParser (a -> YamlParser b
g a
x) AnchorMap
am
#if MIN_VERSION_base(4,13,0)
instance MonadFail YamlParser where
#endif
fail :: forall a. AnchorName -> YamlParser a
fail = forall a. (AnchorMap -> Either Text a) -> YamlParser a
YamlParser forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnchorName -> Text
pack
instance MonadPlus YamlParser where
mzero :: forall a. YamlParser a
mzero = forall (m :: * -> *) a. MonadFail m => AnchorName -> m a
fail AnchorName
"mzero"
mplus :: forall a. YamlParser a -> YamlParser a -> YamlParser a
mplus YamlParser a
a YamlParser a
b = forall a. (AnchorMap -> Either Text a) -> YamlParser a
YamlParser forall a b. (a -> b) -> a -> b
$ \AnchorMap
am ->
case forall a. YamlParser a -> AnchorMap -> Either Text a
unYamlParser YamlParser a
a AnchorMap
am of
Left Text
_ -> forall a. YamlParser a -> AnchorMap -> Either Text a
unYamlParser YamlParser a
b AnchorMap
am
Either Text a
x -> Either Text a
x
lookupAnchor :: AnchorName -> YamlParser (Maybe YamlValue)
lookupAnchor :: AnchorName -> YamlParser (Maybe YamlValue)
lookupAnchor AnchorName
name = forall a. (AnchorMap -> Either Text a) -> YamlParser a
YamlParser forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup AnchorName
name
withAnchor :: AnchorName -> Text -> (YamlValue -> YamlParser a) -> YamlParser a
withAnchor :: forall a.
AnchorName -> Text -> (YamlValue -> YamlParser a) -> YamlParser a
withAnchor AnchorName
name Text
expected YamlValue -> YamlParser a
f = do
Maybe YamlValue
mv <- AnchorName -> YamlParser (Maybe YamlValue)
lookupAnchor AnchorName
name
case Maybe YamlValue
mv of
Maybe YamlValue
Nothing -> forall (m :: * -> *) a. MonadFail m => AnchorName -> m a
fail forall a b. (a -> b) -> a -> b
$ Text -> AnchorName
unpack Text
expected forall a. [a] -> [a] -> [a]
++ AnchorName
": unknown alias " forall a. [a] -> [a] -> [a]
++ AnchorName
name
Just YamlValue
v -> YamlValue -> YamlParser a
f YamlValue
v
withMapping :: Text -> ([(Text, YamlValue)] -> YamlParser a) -> YamlValue -> YamlParser a
withMapping :: forall a.
Text
-> ([(Text, YamlValue)] -> YamlParser a)
-> YamlValue
-> YamlParser a
withMapping Text
_ [(Text, YamlValue)] -> YamlParser a
f (Mapping [(Text, YamlValue)]
m Anchor
_) = [(Text, YamlValue)] -> YamlParser a
f [(Text, YamlValue)]
m
withMapping Text
expected [(Text, YamlValue)] -> YamlParser a
f (Alias AnchorName
an) = forall a.
AnchorName -> Text -> (YamlValue -> YamlParser a) -> YamlParser a
withAnchor AnchorName
an Text
expected forall a b. (a -> b) -> a -> b
$ forall a.
Text
-> ([(Text, YamlValue)] -> YamlParser a)
-> YamlValue
-> YamlParser a
withMapping Text
expected [(Text, YamlValue)] -> YamlParser a
f
withMapping Text
expected [(Text, YamlValue)] -> YamlParser a
_ YamlValue
v = forall a. Text -> YamlValue -> YamlParser a
typeMismatch Text
expected YamlValue
v
withSequence :: Text -> ([YamlValue] -> YamlParser a) -> YamlValue -> YamlParser a
withSequence :: forall a.
Text -> ([YamlValue] -> YamlParser a) -> YamlValue -> YamlParser a
withSequence Text
_ [YamlValue] -> YamlParser a
f (Sequence [YamlValue]
s Anchor
_) = [YamlValue] -> YamlParser a
f [YamlValue]
s
withSequence Text
expected [YamlValue] -> YamlParser a
f (Alias AnchorName
an) = forall a.
AnchorName -> Text -> (YamlValue -> YamlParser a) -> YamlParser a
withAnchor AnchorName
an Text
expected forall a b. (a -> b) -> a -> b
$ forall a.
Text -> ([YamlValue] -> YamlParser a) -> YamlValue -> YamlParser a
withSequence Text
expected [YamlValue] -> YamlParser a
f
withSequence Text
expected [YamlValue] -> YamlParser a
_ YamlValue
v = forall a. Text -> YamlValue -> YamlParser a
typeMismatch Text
expected YamlValue
v
withText :: Text -> (Text -> YamlParser a) -> YamlValue -> YamlParser a
withText :: forall a.
Text -> (Text -> YamlParser a) -> YamlValue -> YamlParser a
withText Text
_ Text -> YamlParser a
f (Scalar ByteString
s Tag
_ Style
_ Anchor
_) = Text -> YamlParser a
f forall a b. (a -> b) -> a -> b
$ ByteString -> Text
decodeUtf8 ByteString
s
withText Text
expected Text -> YamlParser a
f (Alias AnchorName
an) = forall a.
AnchorName -> Text -> (YamlValue -> YamlParser a) -> YamlParser a
withAnchor AnchorName
an Text
expected forall a b. (a -> b) -> a -> b
$ forall a.
Text -> (Text -> YamlParser a) -> YamlValue -> YamlParser a
withText Text
expected Text -> YamlParser a
f
withText Text
expected Text -> YamlParser a
_ YamlValue
v = forall a. Text -> YamlValue -> YamlParser a
typeMismatch Text
expected YamlValue
v
typeMismatch :: Text -> YamlValue -> YamlParser a
typeMismatch :: forall a. Text -> YamlValue -> YamlParser a
typeMismatch Text
expected YamlValue
v =
forall (m :: * -> *) a. MonadFail m => AnchorName -> m a
fail forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ AnchorName
"Expected "
, Text -> AnchorName
unpack Text
expected
, AnchorName
", but got: "
, AnchorName
t
]
where
t :: AnchorName
t = case YamlValue
v of
Mapping [(Text, YamlValue)]
_ Anchor
_ -> AnchorName
"mapping"
Sequence [YamlValue]
_ Anchor
_ -> AnchorName
"sequence"
Scalar ByteString
_ Tag
_ Style
_ Anchor
_ -> AnchorName
"scalar"
Alias AnchorName
_ -> AnchorName
"alias"
class FromYaml a where
fromYaml :: YamlValue -> YamlParser a
instance FromYaml YamlValue where
fromYaml :: YamlValue -> YamlParser YamlValue
fromYaml = forall (m :: * -> *) a. Monad m => a -> m a
return
instance FromYaml a => FromYaml [a] where
fromYaml :: YamlValue -> YamlParser [a]
fromYaml = forall a.
Text -> ([YamlValue] -> YamlParser a) -> YamlValue -> YamlParser a
withSequence Text
"[a]" (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. FromYaml a => YamlValue -> YamlParser a
fromYaml)
instance FromYaml Text where
fromYaml :: YamlValue -> YamlParser Text
fromYaml = forall a.
Text -> (Text -> YamlParser a) -> YamlValue -> YamlParser a
withText Text
"Text" forall (m :: * -> *) a. Monad m => a -> m a
return
instance FromYaml Int where
fromYaml :: YamlValue -> YamlParser Int
fromYaml =
forall a.
Text -> (Text -> YamlParser a) -> YamlValue -> YamlParser a
withText Text
"Int" forall {a} {m :: * -> *}. (Integral a, MonadFail m) => Text -> m a
go
where
go :: Text -> m a
go Text
t =
case forall a. Num a => Reader a -> Reader a
signed forall a. Integral a => Reader a
decimal Text
t of
Right (a
i, Text
"") -> forall (m :: * -> *) a. Monad m => a -> m a
return a
i
Either AnchorName (a, Text)
_ -> forall (m :: * -> *) a. MonadFail m => AnchorName -> m a
fail forall a b. (a -> b) -> a -> b
$ AnchorName
"Invalid Int: " forall a. [a] -> [a] -> [a]
++ Text -> AnchorName
unpack Text
t
data YamlValue
= Mapping [(Text, YamlValue)] Anchor
| Sequence [YamlValue] Anchor
| Scalar ByteString Tag Style Anchor
| Alias AnchorName
deriving Int -> YamlValue -> ShowS
[YamlValue] -> ShowS
YamlValue -> AnchorName
forall a.
(Int -> a -> ShowS)
-> (a -> AnchorName) -> ([a] -> ShowS) -> Show a
showList :: [YamlValue] -> ShowS
$cshowList :: [YamlValue] -> ShowS
show :: YamlValue -> AnchorName
$cshow :: YamlValue -> AnchorName
showsPrec :: Int -> YamlValue -> ShowS
$cshowsPrec :: Int -> YamlValue -> ShowS
Show
type AnchorMap = Map.Map AnchorName YamlValue
data RawDoc = RawDoc YamlValue AnchorMap
deriving Int -> RawDoc -> ShowS
[RawDoc] -> ShowS
RawDoc -> AnchorName
forall a.
(Int -> a -> ShowS)
-> (a -> AnchorName) -> ([a] -> ShowS) -> Show a
showList :: [RawDoc] -> ShowS
$cshowList :: [RawDoc] -> ShowS
show :: RawDoc -> AnchorName
$cshow :: RawDoc -> AnchorName
showsPrec :: Int -> RawDoc -> ShowS
$cshowsPrec :: Int -> RawDoc -> ShowS
Show
parseRawDoc :: (FromYaml a, MonadThrow m) => RawDoc -> m a
parseRawDoc :: forall a (m :: * -> *). (FromYaml a, MonadThrow m) => RawDoc -> m a
parseRawDoc (RawDoc YamlValue
val AnchorMap
am) =
case forall a. YamlParser a -> AnchorMap -> Either Text a
unYamlParser (forall a. FromYaml a => YamlValue -> YamlParser a
fromYaml YamlValue
val) AnchorMap
am of
Left Text
t -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ Text -> YamlParseException
FromYamlException Text
t
Right a
x -> forall (m :: * -> *) a. Monad m => a -> m a
return a
x
(.:) :: FromYaml a => [(Text, YamlValue)] -> Text -> YamlParser a
[(Text, YamlValue)]
o .: :: forall a. FromYaml a => [(Text, YamlValue)] -> Text -> YamlParser a
.: Text
k =
case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
k [(Text, YamlValue)]
o of
Maybe YamlValue
Nothing -> forall (m :: * -> *) a. MonadFail m => AnchorName -> m a
fail forall a b. (a -> b) -> a -> b
$ AnchorName
"Key not found: " forall a. [a] -> [a] -> [a]
++ Text -> AnchorName
unpack Text
k
Just YamlValue
v -> forall a. FromYaml a => YamlValue -> YamlParser a
fromYaml YamlValue
v
data YamlParseException
= UnexpectedEndOfEvents
| UnexpectedEvent Event
| FromYamlException Text
deriving (Int -> YamlParseException -> ShowS
[YamlParseException] -> ShowS
YamlParseException -> AnchorName
forall a.
(Int -> a -> ShowS)
-> (a -> AnchorName) -> ([a] -> ShowS) -> Show a
showList :: [YamlParseException] -> ShowS
$cshowList :: [YamlParseException] -> ShowS
show :: YamlParseException -> AnchorName
$cshow :: YamlParseException -> AnchorName
showsPrec :: Int -> YamlParseException -> ShowS
$cshowsPrec :: Int -> YamlParseException -> ShowS
Show, Typeable)
instance Exception YamlParseException
{-# INLINE sinkValue #-}
sinkValue :: (MonadIO m, MonadCatch m, MonadThrow m) => Parser (WriterT AnchorMap m) Event YamlValue
sinkValue :: forall (m :: * -> *).
(MonadIO m, MonadCatch m, MonadThrow m) =>
Parser (WriterT AnchorMap m) Event YamlValue
sinkValue = Parser (WriterT AnchorMap m) Event YamlValue
start
where
start :: Parser (WriterT AnchorMap m) Event YamlValue
start = forall (m :: * -> *) a b.
MonadCatch m =>
Parser m a b -> Parser m a b
toParserK forall (m :: * -> *) a. MonadCatch m => Parser m a (Maybe a)
anyEvent forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a b. AnchorName -> Parser m a b
die AnchorName
"Unexpected end of events") Event -> Parser (WriterT AnchorMap m) Event YamlValue
go
tell' :: Maybe k -> a -> Parser (WriterT (Map k a) m) a a
tell' Maybe k
Nothing a
val = forall (m :: * -> *) a. Monad m => a -> m a
return a
val
tell' (Just k
name) a
val = do
forall (m :: * -> *) b a. Monad m => m b -> Parser m a b
fromEffect forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell forall a b. (a -> b) -> a -> b
$ forall k a. k -> a -> Map k a
Map.singleton k
name a
val
forall (m :: * -> *) a. Monad m => a -> m a
return a
val
go :: Event -> Parser (WriterT AnchorMap m) Event YamlValue
go Event
EventStreamStart = Parser (WriterT AnchorMap m) Event YamlValue
start
go Event
EventDocumentStart = Parser (WriterT AnchorMap m) Event YamlValue
start
go (EventAlias AnchorName
a) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ AnchorName -> YamlValue
Alias AnchorName
a
go (EventScalar ByteString
a Tag
b Style
c Anchor
d) = forall {k} {m :: * -> *} {a} {a}.
(Ord k, Monad m) =>
Maybe k -> a -> Parser (WriterT (Map k a) m) a a
tell' Anchor
d forall a b. (a -> b) -> a -> b
$ ByteString -> Tag -> Style -> Anchor -> YamlValue
Scalar ByteString
a Tag
b Style
c Anchor
d
go (EventSequenceStart Tag
_tag SequenceStyle
_style Anchor
mname) = do
[YamlValue]
vals <- ([YamlValue] -> [YamlValue])
-> Parser (WriterT AnchorMap m) Event [YamlValue]
goS forall a. a -> a
id
let val :: YamlValue
val = [YamlValue] -> Anchor -> YamlValue
Sequence [YamlValue]
vals Anchor
mname
forall {k} {m :: * -> *} {a} {a}.
(Ord k, Monad m) =>
Maybe k -> a -> Parser (WriterT (Map k a) m) a a
tell' Anchor
mname YamlValue
val
go (EventMappingStart Tag
_tag MappingStyle
_style Anchor
mname) = do
[(Text, YamlValue)]
pairs <- ([(Text, YamlValue)] -> [(Text, YamlValue)])
-> Parser (WriterT AnchorMap m) Event [(Text, YamlValue)]
goM forall a. a -> a
id
let val :: YamlValue
val = [(Text, YamlValue)] -> Anchor -> YamlValue
Mapping [(Text, YamlValue)]
pairs Anchor
mname
forall {k} {m :: * -> *} {a} {a}.
(Ord k, Monad m) =>
Maybe k -> a -> Parser (WriterT (Map k a) m) a a
tell' Anchor
mname YamlValue
val
go Event
e = forall (m :: * -> *) a b.
(MonadIO m, MonadThrow m) =>
Maybe Event -> Parser m a b
missed (forall a. a -> Maybe a
Just Event
e)
goS :: ([YamlValue] -> [YamlValue])
-> Parser (WriterT AnchorMap m) Event [YamlValue]
goS [YamlValue] -> [YamlValue]
front = do
Maybe Event
me <- forall (m :: * -> *) a b.
MonadCatch m =>
Parser m a b -> Parser m a b
toParserK forall (m :: * -> *) a. MonadCatch m => Parser m a (Maybe a)
anyEvent
case Maybe Event
me of
Maybe Event
Nothing -> forall (m :: * -> *) a b. AnchorName -> Parser m a b
die AnchorName
"Unexpected end of events"
Just Event
EventSequenceEnd -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [YamlValue] -> [YamlValue]
front []
Just Event
e -> do
YamlValue
val <- Event -> Parser (WriterT AnchorMap m) Event YamlValue
go Event
e
([YamlValue] -> [YamlValue])
-> Parser (WriterT AnchorMap m) Event [YamlValue]
goS ([YamlValue] -> [YamlValue]
front forall b c a. (b -> c) -> (a -> b) -> a -> c
. (YamlValue
valforall a. a -> [a] -> [a]
:))
goM :: ([(Text, YamlValue)] -> [(Text, YamlValue)])
-> Parser (WriterT AnchorMap m) Event [(Text, YamlValue)]
goM [(Text, YamlValue)] -> [(Text, YamlValue)]
front = do
Maybe Event
mk <- forall (m :: * -> *) a b.
MonadCatch m =>
Parser m a b -> Parser m a b
toParserK forall (m :: * -> *) a. MonadCatch m => Parser m a (Maybe a)
anyEvent
case Maybe Event
mk of
Maybe Event
Nothing -> forall (m :: * -> *) a b. AnchorName -> Parser m a b
die AnchorName
"Unexpected end of events"
Just Event
EventMappingEnd -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [(Text, YamlValue)] -> [(Text, YamlValue)]
front []
Just (EventScalar ByteString
a Tag
b Style
c Anchor
d) -> do
YamlValue
_ <- forall {k} {m :: * -> *} {a} {a}.
(Ord k, Monad m) =>
Maybe k -> a -> Parser (WriterT (Map k a) m) a a
tell' Anchor
d forall a b. (a -> b) -> a -> b
$ ByteString -> Tag -> Style -> Anchor -> YamlValue
Scalar ByteString
a Tag
b Style
c Anchor
d
let k :: Text
k = ByteString -> Text
decodeUtf8 ByteString
a
YamlValue
v <- Parser (WriterT AnchorMap m) Event YamlValue
start
([(Text, YamlValue)] -> [(Text, YamlValue)])
-> Parser (WriterT AnchorMap m) Event [(Text, YamlValue)]
goM ([(Text, YamlValue)] -> [(Text, YamlValue)]
front forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text
k, YamlValue
v)forall a. a -> [a] -> [a]
:))
Just Event
e -> forall (m :: * -> *) a b.
(MonadIO m, MonadThrow m) =>
Maybe Event -> Parser m a b
missed (forall a. a -> Maybe a
Just Event
e)
{-# INLINE sinkRawDoc #-}
sinkRawDoc :: SerialT IO Event -> IO RawDoc
sinkRawDoc :: SerialT IO Event -> IO RawDoc
sinkRawDoc SerialT IO Event
src = do
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry YamlValue -> AnchorMap -> RawDoc
RawDoc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (forall (m :: * -> *) a b.
MonadThrow m =>
Parser m a b -> SerialT m a -> m b
Stream.parse forall (m :: * -> *).
(MonadIO m, MonadCatch m, MonadThrow m) =>
Parser (WriterT AnchorMap m) Event YamlValue
sinkValue (forall (m :: * -> *) (n :: * -> *) a.
(Monad m, Monad n) =>
(forall x. m x -> n x) -> SerialT m a -> SerialT n a
hoist forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO SerialT IO Event
src))
readYamlFile :: FromYaml a => FilePath -> IO a
readYamlFile :: forall a. FromYaml a => AnchorName -> IO a
readYamlFile AnchorName
fp = SerialT IO Event -> IO RawDoc
sinkRawDoc (forall (m :: * -> *).
(MonadCatch m, MonadAsync m, MonadMask m) =>
AnchorName -> SerialT m Event
decodeFile AnchorName
fp) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a (m :: * -> *). (FromYaml a, MonadThrow m) => RawDoc -> m a
parseRawDoc