{-# OPTIONS_GHC -Wno-missing-signatures #-}
{-# OPTIONS_GHC -Wno-missing-local-signatures #-}
module CfnFlip.Yaml
( encode
, decode
) where
import CfnFlip.Prelude
import CfnFlip.Aeson (ToJSON)
import CfnFlip.Conduit
import CfnFlip.IntrinsicFunction
import CfnFlip.Libyaml
import qualified Data.Yaml as Yaml
import qualified Data.Yaml.Internal as Yaml
import qualified Text.Libyaml as Libyaml
newtype FromJSONError = FromJSONError String
deriving stock Int -> FromJSONError -> ShowS
[FromJSONError] -> ShowS
FromJSONError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FromJSONError] -> ShowS
$cshowList :: [FromJSONError] -> ShowS
show :: FromJSONError -> String
$cshow :: FromJSONError -> String
showsPrec :: Int -> FromJSONError -> ShowS
$cshowsPrec :: Int -> FromJSONError -> ShowS
Show
deriving anyclass Show FromJSONError
Typeable FromJSONError
SomeException -> Maybe FromJSONError
FromJSONError -> String
FromJSONError -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: FromJSONError -> String
$cdisplayException :: FromJSONError -> String
fromException :: SomeException -> Maybe FromJSONError
$cfromException :: SomeException -> Maybe FromJSONError
toException :: FromJSONError -> SomeException
$ctoException :: FromJSONError -> SomeException
Exception
encode
:: (MonadUnliftIO m, ToJSON a)
=> ConduitT Event Event (ResourceT m) ()
-> a
-> m ByteString
encode :: forall (m :: * -> *) a.
(MonadUnliftIO m, ToJSON a) =>
ConduitT Event Event (ResourceT m) () -> a -> m ByteString
encode ConduitT Event Event (ResourceT m) ()
c a
a =
forall (m :: * -> *) r.
MonadUnliftIO m =>
ConduitT () Void (ResourceT m) r -> m r
runConduitRes
forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a i. Monad m => [a] -> ConduitT i a m ()
sourceList (forall a. ToJSON a => StringStyle -> a -> [Event]
Yaml.objToStream StringStyle
stringStyle a
a)
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitT Event Event (ResourceT m) ()
c
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *). Monad m => ConduitT Event Event m ()
fixQuoting
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) o.
MonadResource m =>
FormatOptions -> ConduitM Event o m ByteString
Libyaml.encodeWith FormatOptions
formatOptions
where
stringStyle :: StringStyle
stringStyle = StringStyle
Yaml.defaultStringStyle
formatOptions :: FormatOptions
formatOptions =
(Event -> TagRender) -> FormatOptions -> FormatOptions
Libyaml.setTagRendering Event -> TagRender
Libyaml.renderUriTags FormatOptions
Libyaml.defaultFormatOptions
fixQuoting :: Monad m => ConduitT Event Event m ()
fixQuoting :: forall (m :: * -> *). Monad m => ConduitT Event Event m ()
fixQuoting = forall (m :: * -> *) i o r.
Monad m =>
(i -> ConduitT i o m r) -> ConduitT i o m ()
awaitForever forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
e :: Event
e@(EventScalar ByteString
x Tag
t Style
_ Anchor
z) | Just ByteString
_ <- Event -> Maybe ByteString
getIntrinsicFunction Event
e ->
ByteString -> Tag -> Style -> Anchor -> Event
EventScalar ByteString
x Tag
t Style
SingleQuoted Anchor
z
Event
e -> Event
e
decode :: ConduitT Event Event Parse () -> ByteString -> m a
decode ConduitT Event Event Parse ()
c ByteString
bs = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Either ParseException ([Warning], Either String a)
result <- forall a.
FromJSON a =>
ConduitM () Event Parse ()
-> IO (Either ParseException ([Warning], Either String a))
Yaml.decodeHelper forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) i.
MonadResource m =>
ByteString -> ConduitM i Event m ()
Libyaml.decode ByteString
bs forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitT Event Event Parse ()
c
case Either ParseException ([Warning], Either String a)
result of
Left ParseException
a -> forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO ParseException
a
Right ([Warning]
_, Either String a
b) -> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FromJSONError
FromJSONError) forall (f :: * -> *) a. Applicative f => a -> f a
pure Either String a
b