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 = (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 :: * -> *) a o. Monad m => ConduitT a o m (Maybe a)
await
            ConduitT Event Event m (Maybe Event)
-> (Maybe Event -> ConduitT Event Event m ())
-> ConduitT Event Event m ()
forall a b.
ConduitT Event Event m a
-> (a -> ConduitT Event Event m b) -> ConduitT Event Event m b
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 =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT 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 :: forall (m :: * -> *).
MonadIO m =>
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)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [ConduitT Event Event m (Maybe Event)
forall (m :: * -> *) a o. Monad m => ConduitT a o m (Maybe a)
await, ConduitT Event Event m (Maybe Event)
forall (m :: * -> *) a o. Monad m => ConduitT a o m (Maybe a)
await, ConduitT Event Event m (Maybe Event)
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 {}
      ] ->
      (ByteString, ByteString)
-> ConduitT Event Event m (ByteString, ByteString)
forall a. a -> ConduitT Event Event m a
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