JsonToYaml.hs

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 = awaitForever $ \e -> do
  mS <- peekC

  case (e, mS) of
    (EventMappingStart{}, Just s@EventScalar{})
      | Just tag <- fromIntrinsicFunction s -> do
        dropC 1 -- Scalar

        await >>= traverse_
          (\case
            i | tag == "!GetAtt" -> do
              (resource, attribute) <- awaitGetAtt i
              let key = resource <> "." <> attribute
              yield $ EventScalar key (UriTag tag) SingleQuoted Nothing

            i -> do
              yield $ setIntrinsicFunction tag i
              when (startsMapOrSequence i) $ takeMapOrSequenceC i .| translate
          )

        dropC 1 -- MappingEnd
    _ -> yield e

awaitGetAtt
  :: MonadIO m => Event -> ConduitT Event Event m (ByteString, ByteString)
awaitGetAtt e = do
  results <- sequence [await, await, await]

  case results of
    [Just (EventScalar r _ _ _), Just (EventScalar a _ _ _), Just EventSequenceEnd{}]
      -> pure (r, a)
    _ ->
      throwIO
        $ InvalidYamlEvent e
        $ "Unexpected GetAtt. Should be two Scalars and a SequenceEnd, saw: "
        <> show results