module CfnFlip.JsonToYaml
( InvalidYamlEvent(..)
, translate
) where
import CfnFlip.Prelude
import CfnFlip.Conduit
import CfnFlip.IntrinsicFunction
import CfnFlip.Libyaml
translate :: MonadIO m => ConduitT Event Event m ()
translate :: forall (m :: * -> *). MonadIO m => ConduitT Event Event m ()
translate = 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
$ \Event
e -> do
Maybe Event
mS <- forall (m :: * -> *) a o. Monad m => ConduitT a o m (Maybe a)
peekC
case (Event
e, Maybe Event
mS) of
(EventMappingStart{}, Just s :: Event
s@EventScalar{})
| Just String
tag <- Event -> Maybe String
fromIntrinsicFunction Event
s -> do
forall (m :: * -> *) a o. Monad m => Int -> ConduitT a o m ()
dropC Int
1
forall (m :: * -> *) a o. Monad m => ConduitT a o m (Maybe a)
await forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_
(\case
Event
i | String
tag forall a. Eq a => a -> a -> Bool
== String
"!GetAtt" -> do
(ByteString
resource, ByteString
attribute) <- forall (m :: * -> *).
MonadIO m =>
Event -> ConduitT Event Event m (ByteString, ByteString)
awaitGetAtt Event
i
let key :: ByteString
key = ByteString
resource forall a. Semigroup a => a -> a -> a
<> ByteString
"." forall a. Semigroup a => a -> a -> a
<> ByteString
attribute
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield forall a b. (a -> b) -> a -> b
$ ByteString -> Tag -> Style -> Maybe String -> Event
EventScalar ByteString
key (String -> Tag
UriTag String
tag) Style
SingleQuoted forall a. Maybe a
Nothing
Event
i -> do
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield forall a b. (a -> b) -> a -> b
$ String -> Event -> Event
setIntrinsicFunction String
tag Event
i
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Event -> Bool
startsMapOrSequence Event
i) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Monad m => Event -> ConduitT Event Event m ()
takeMapOrSequenceC Event
i forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *). MonadIO m => ConduitT Event Event m ()
translate
)
forall (m :: * -> *) a o. Monad m => Int -> ConduitT a o m ()
dropC Int
1
(Event, Maybe Event)
_ -> forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield Event
e
awaitGetAtt
:: MonadIO m => Event -> ConduitT Event Event m (ByteString, ByteString)
awaitGetAtt :: forall (m :: * -> *).
MonadIO m =>
Event -> ConduitT Event Event m (ByteString, ByteString)
awaitGetAtt Event
e = do
[Maybe Event]
results <- forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [forall (m :: * -> *) a o. Monad m => ConduitT a o m (Maybe a)
await, forall (m :: * -> *) a o. Monad m => ConduitT a o m (Maybe a)
await, forall (m :: * -> *) a o. Monad m => ConduitT a o m (Maybe a)
await]
case [Maybe Event]
results of
[Just (EventScalar ByteString
r Tag
_ Style
_ Maybe String
_), Just (EventScalar ByteString
a Tag
_ Style
_ Maybe String
_), Just EventSequenceEnd{}]
-> forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString
r, ByteString
a)
[Maybe Event]
_ ->
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO
forall a b. (a -> b) -> a -> b
$ Event -> String -> InvalidYamlEvent
InvalidYamlEvent Event
e
forall a b. (a -> b) -> a -> b
$ String
"Unexpected GetAtt. Should be two Scalars and a SequenceEnd, saw: "
forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show [Maybe Event]
results