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 -- Scalar

        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 -- MappingEnd
    (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