module CfnFlip.IntrinsicFunction
  ( getIntrinsicFunction
  , setIntrinsicFunction
  , fromIntrinsicFunction
  ) where

import CfnFlip.Prelude

import CfnFlip.Libyaml (Event(..), Tag(..))

-- | If an 'Event' is using a known @"!X"@, returns the @"Fn::Y"@ for it
getIntrinsicFunction :: Event -> Maybe ByteString
getIntrinsicFunction :: Event -> Maybe ByteString
getIntrinsicFunction = \case
  EventScalar ByteString
_ (UriTag String
t) Style
_ Anchor
_ -> String -> [(String, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
t [(String, ByteString)]
intrinsics
  EventMappingStart (UriTag String
t) MappingStyle
_ Anchor
_ -> String -> [(String, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
t [(String, ByteString)]
intrinsics
  EventSequenceStart (UriTag String
t) SequenceStyle
_ Anchor
_ -> String -> [(String, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
t [(String, ByteString)]
intrinsics
  Event
_ -> Maybe ByteString
forall a. Maybe a
Nothing

-- | Set an 'Event' up with a @'UriTag' "!X"@
setIntrinsicFunction :: String -> Event -> Event
setIntrinsicFunction :: String -> Event -> Event
setIntrinsicFunction String
tag Event
e = Event -> Maybe Event -> Event
forall a. a -> Maybe a -> a
fromMaybe Event
e (Maybe Event -> Event) -> Maybe Event -> Event
forall a b. (a -> b) -> a -> b
$ do
  let t :: Tag
t = String -> Tag
UriTag String
tag

  case Event
e of
    EventScalar ByteString
x Tag
_ Style
y Anchor
z -> Event -> Maybe Event
forall a. a -> Maybe a
Just (Event -> Maybe Event) -> Event -> Maybe Event
forall a b. (a -> b) -> a -> b
$ ByteString -> Tag -> Style -> Anchor -> Event
EventScalar ByteString
x Tag
t Style
y Anchor
z
    EventMappingStart Tag
_ MappingStyle
x Anchor
y -> Event -> Maybe Event
forall a. a -> Maybe a
Just (Event -> Maybe Event) -> Event -> Maybe Event
forall a b. (a -> b) -> a -> b
$ Tag -> MappingStyle -> Anchor -> Event
EventMappingStart Tag
t MappingStyle
x Anchor
y
    EventSequenceStart Tag
_ SequenceStyle
x Anchor
y -> Event -> Maybe Event
forall a. a -> Maybe a
Just (Event -> Maybe Event) -> Event -> Maybe Event
forall a b. (a -> b) -> a -> b
$ Tag -> SequenceStyle -> Anchor -> Event
EventSequenceStart Tag
t SequenceStyle
x Anchor
y
    Event
_ -> Maybe Event
forall a. Maybe a
Nothing

fromIntrinsicFunction :: Event -> Maybe String
fromIntrinsicFunction :: Event -> Anchor
fromIntrinsicFunction = \case
  EventScalar ByteString
x Tag
_ Style
_ Anchor
_ -> ByteString -> [(ByteString, String)] -> Anchor
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ByteString
x [(ByteString, String)]
swappedIntrinsics
  Event
_ -> Anchor
forall a. Maybe a
Nothing

intrinsics :: [(String, ByteString)]
intrinsics :: [(String, ByteString)]
intrinsics = (Text -> (String, ByteString)) -> [Text] -> [(String, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map
  Text -> (String, ByteString)
toFn
  [ Text
"And"
  , Text
"Base64"
  , Text
"Cidr"
  , Text
"Condition"
  , Text
"Equals"
  , Text
"FindInMap"
  , Text
"GetAtt"
  , Text
"GetAZs"
  , Text
"If"
  , Text
"ImportValue"
  , Text
"Join"
  , Text
"Not"
  , Text
"Or"
  , Text
"Ref"
  , Text
"Select"
  , Text
"Split"
  , Text
"Sub"
  , Text
"Transform"
  ]
 where
  toFn :: Text -> (String, ByteString)
toFn Text
x
    | Text
x Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"Ref", Text
"Condition"] = (String
"!" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
unpack Text
x, Text -> ByteString
encodeUtf8 Text
x)
    | Bool
otherwise = (String
"!" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
unpack Text
x, ByteString
"Fn::" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Text -> ByteString
encodeUtf8 Text
x)

swappedIntrinsics :: [(ByteString, String)]
swappedIntrinsics :: [(ByteString, String)]
swappedIntrinsics = ((String, ByteString) -> (ByteString, String))
-> [(String, ByteString)] -> [(ByteString, String)]
forall a b. (a -> b) -> [a] -> [b]
map (String, ByteString) -> (ByteString, String)
forall a b. (a, b) -> (b, a)
swap [(String, ByteString)]
intrinsics
 where
  swap :: (a, b) -> (b, a)
  swap :: (a, b) -> (b, a)
swap (a
a, b
b) = (b
b, a
a)