module CfnFlip.YamlToJson
  ( InvalidYamlEvent(..)
  , translate
  ) where

import CfnFlip.Prelude

import CfnFlip.Conduit
import CfnFlip.IntrinsicFunction
import CfnFlip.Libyaml
import qualified Data.ByteString as BS
import qualified Prelude as Unsafe (toEnum)

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
$ \case
  e :: Event
e@(EventScalar ByteString
x (UriTag String
"!GetAtt") Style
_ Anchor
_) -> do
    (ByteString
resource, ByteString
attribute) <- ConduitT Event Event m (ByteString, ByteString)
-> ((ByteString, ByteString)
    -> ConduitT Event Event m (ByteString, ByteString))
-> Maybe (ByteString, ByteString)
-> ConduitT Event Event m (ByteString, ByteString)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Event
-> ByteString -> ConduitT Event Event m (ByteString, ByteString)
forall (m :: * -> *) a. MonadIO m => Event -> ByteString -> m a
throwInvalidGetAtt Event
e ByteString
x) (ByteString, ByteString)
-> ConduitT Event Event m (ByteString, ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (ByteString, ByteString)
 -> ConduitT Event Event m (ByteString, ByteString))
-> Maybe (ByteString, ByteString)
-> ConduitT Event Event m (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe (ByteString, ByteString)
parseGetAtt ByteString
x

    ByteString
-> ConduitT Event Event m () -> ConduitT Event Event m ()
forall (m :: * -> *) i.
Monad m =>
ByteString -> ConduitT i Event m () -> ConduitT i Event m ()
makeMapping ByteString
"Fn::GetAtt" (ConduitT Event Event m () -> ConduitT Event Event m ())
-> ConduitT Event Event m () -> ConduitT Event Event m ()
forall a b. (a -> b) -> a -> b
$ ConduitT Event Event m () -> ConduitT Event Event m ()
forall (m :: * -> *) i.
Monad m =>
ConduitT i Event m () -> ConduitT i Event m ()
makeSequence (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 (Element [Event]) m ()
forall (m :: * -> *) mono i.
(Monad m, MonoFoldable mono) =>
mono -> ConduitT i (Element mono) m ()
yieldMany
      [ ByteString -> Tag -> Style -> Anchor -> Event
EventScalar ByteString
resource Tag
NoTag Style
Plain Anchor
forall a. Maybe a
Nothing
      , ByteString -> Tag -> Style -> Anchor -> Event
EventScalar ByteString
attribute Tag
NoTag Style
Plain Anchor
forall a. Maybe a
Nothing
      ]

  Event
e | Just ByteString
tag <- Event -> Maybe ByteString
getIntrinsicFunction Event
e -> do
    ByteString
-> ConduitT Event Event m () -> ConduitT Event Event m ()
forall (m :: * -> *) i.
Monad m =>
ByteString -> ConduitT i Event m () -> ConduitT i Event m ()
makeMapping ByteString
tag (ConduitT Event Event m () -> ConduitT Event Event m ())
-> ConduitT Event Event m () -> ConduitT Event Event m ()
forall a b. (a -> b) -> a -> b
$ do
      Event -> ConduitT Event Event m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield Event
e
      Bool -> ConduitT Event Event m () -> ConduitT Event Event m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Event -> Bool
startsMapOrSequence Event
e) (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
e 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

  Event
e -> Event -> ConduitT Event Event m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield Event
e

parseGetAtt :: ByteString -> Maybe (ByteString, ByteString)
parseGetAtt :: ByteString -> Maybe (ByteString, ByteString)
parseGetAtt ByteString
x = case Word8 -> ByteString -> [ByteString]
BS.split (Char -> Word8
charToWord8 Char
'.') ByteString
x of
  [ByteString
resource, ByteString
attribute] -> (ByteString, ByteString) -> Maybe (ByteString, ByteString)
forall a. a -> Maybe a
Just (ByteString
resource, ByteString
attribute)
  [ByteString]
_ -> Maybe (ByteString, ByteString)
forall a. Maybe a
Nothing

throwInvalidGetAtt :: MonadIO m => Event -> ByteString -> m a
throwInvalidGetAtt :: Event -> ByteString -> m a
throwInvalidGetAtt Event
e ByteString
x =
  InvalidYamlEvent -> m a
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO
    (InvalidYamlEvent -> m a) -> InvalidYamlEvent -> m a
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
"!GetAtt shoule be \"Resource.Attribute\", saw "
    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
forall a. Show a => a -> String
show ByteString
x

charToWord8 :: Char -> Word8
charToWord8 :: Char -> Word8
charToWord8 = Int -> Word8
forall a. Enum a => Int -> a
Unsafe.toEnum (Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
forall a. Enum a => a -> Int
fromEnum