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 :: ConduitT Event Event m ()
translate = (Event -> ConduitT Event Event m ()) -> ConduitT Event Event m ()
forall (m :: * -> *) i o r.
Monad m =>
(i -> ConduitT i o m r) -> ConduitT i o m ()
awaitForever ((Event -> ConduitT Event Event m ()) -> ConduitT Event Event m ())
-> (Event -> ConduitT Event Event m ())
-> ConduitT Event Event m ()
forall a b. (a -> b) -> a -> b
$ \Event
e -> do
  Maybe Event
mS <- ConduitT Event Event m (Maybe Event)
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
        Int -> ConduitT Event Event m ()
forall (m :: * -> *) a o. Monad m => Int -> ConduitT a o m ()
dropC Int
1 -- Scalar

        ConduitT Event Event m (Maybe Event)
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await ConduitT Event Event m (Maybe Event)
-> (Maybe Event -> ConduitT Event Event m ())
-> ConduitT Event Event m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Event -> ConduitT Event Event m ())
-> Maybe Event -> ConduitT Event Event m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_
          (\case
            Event
i | String
tag String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"!GetAtt" -> do
              (ByteString
resource, ByteString
attribute) <- Event -> ConduitT Event Event m (ByteString, ByteString)
forall (m :: * -> *).
MonadIO m =>
Event -> ConduitT Event Event m (ByteString, ByteString)
awaitGetAtt Event
i
              let key :: ByteString
key = ByteString
resource ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"." ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
attribute
              Event -> ConduitT Event Event m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (Event -> ConduitT Event Event m ())
-> Event -> ConduitT Event Event m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Tag -> Style -> Maybe String -> Event
EventScalar ByteString
key (String -> Tag
UriTag String
tag) Style
SingleQuoted Maybe String
forall a. Maybe a
Nothing

            Event
i -> do
              Event -> ConduitT Event Event m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (Event -> ConduitT Event Event m ())
-> Event -> ConduitT Event Event m ()
forall a b. (a -> b) -> a -> b
$ String -> Event -> Event
setIntrinsicFunction String
tag Event
i
              Bool -> ConduitT Event Event m () -> ConduitT Event Event m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Event -> Bool
startsMapOrSequence Event
i) (ConduitT Event Event m () -> ConduitT Event Event m ())
-> ConduitT Event Event m () -> ConduitT Event Event m ()
forall a b. (a -> b) -> a -> b
$ Event -> ConduitT Event Event m ()
forall (m :: * -> *). Monad m => Event -> ConduitT Event Event m ()
takeMapOrSequenceC Event
i ConduitT Event Event m ()
-> ConduitT Event Event m () -> ConduitT Event Event m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitT Event Event m ()
forall (m :: * -> *). MonadIO m => ConduitT Event Event m ()
translate
          )

        Int -> ConduitT Event Event m ()
forall (m :: * -> *) a o. Monad m => Int -> ConduitT a o m ()
dropC Int
1 -- MappingEnd
    (Event, Maybe Event)
_ -> Event -> ConduitT Event Event m ()
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 :: Event -> ConduitT Event Event m (ByteString, ByteString)
awaitGetAtt Event
e = do
  [Maybe Event]
results <- [ConduitT Event Event m (Maybe Event)]
-> ConduitT Event Event m [Maybe Event]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [ConduitT Event Event m (Maybe Event)
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await, ConduitT Event Event m (Maybe Event)
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await, ConduitT Event Event m (Maybe Event)
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await]

  case [Maybe Event]
results of
    [Just (EventScalar ByteString
r Tag
_ Style
_ Maybe String
_), Just (EventScalar ByteString
a Tag
_ Style
_ Maybe String
_), Just EventSequenceEnd{}]
      -> (ByteString, ByteString)
-> ConduitT Event Event m (ByteString, ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString
r, ByteString
a)
    [Maybe Event]
_ ->
      InvalidYamlEvent -> ConduitT Event Event m (ByteString, ByteString)
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO
        (InvalidYamlEvent
 -> ConduitT Event Event m (ByteString, ByteString))
-> InvalidYamlEvent
-> ConduitT Event Event m (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ Event -> String -> InvalidYamlEvent
InvalidYamlEvent Event
e
        (String -> InvalidYamlEvent) -> String -> InvalidYamlEvent
forall a b. (a -> b) -> a -> b
$ String
"Unexpected GetAtt. Should be two Scalars and a SequenceEnd, saw: "
        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [Maybe Event] -> String
forall a. Show a => a -> String
show [Maybe Event]
results