module Stratosphere.Value
  ( Value(..)
  , ToRef(..)
  , ValueList(..)
  , sub
  )
where

import Data.Aeson ((.=))
import Data.Maybe (fromMaybe)
import Data.String (IsString(..))
import Data.Text (Text)
import Data.Typeable
import GHC.Exts (IsList(..))
import Prelude

import qualified Data.Aeson        as JSON
import qualified Data.Aeson.KeyMap as JSON

-- | This type is a wrapper around any values in a template. A value can be a
-- 'Literal', a 'Ref', or an intrinsic function. See:
-- http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/intrinsic-function-reference.html
data Value a where
  Literal :: a -> Value a
  Ref :: Text -> Value a
  If :: Text -> Value a -> Value a -> Value a
  And :: Value Bool -> Value Bool -> Value Bool
  Equals :: (Show a, JSON.ToJSON a, Eq a, Typeable a) => Value a -> Value a -> Value Bool
  Or :: Value Bool -> Value Bool -> Value Bool
  Not :: Value Bool -> Value Bool
  GetAtt :: Text -> Text -> Value a
  Base64 :: Value Text -> Value Text
  Join :: Text -> ValueList Text -> Value Text
  Select :: Integer -> ValueList a -> Value a
  FindInMap :: Value Text -> Value Text -> Value Text -> Value a -- ^ Map name, top level key, and second level key
  ImportValue :: Value Text -> Value a -- ^ The account-and-region-unique exported name of the value to import
  Sub :: Text -> Maybe (JSON.KeyMap (Value Text)) -> Value Text -- ^ Substitution string and optional map of values

deriving instance Show a => Show (Value a)

instance Eq a => Eq (Value a) where
  Literal a
a == :: Value a -> Value a -> Bool
== Literal a
a' = a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a'
  Ref Text
a == Ref Text
a' = Text
a Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
a'
  If Text
a Value a
b Value a
c == If Text
a' Value a
b' Value a
c' = Text
a Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
a' Bool -> Bool -> Bool
&& Value a
b Value a -> Value a -> Bool
forall a. Eq a => a -> a -> Bool
== Value a
b' Bool -> Bool -> Bool
&& Value a
c Value a -> Value a -> Bool
forall a. Eq a => a -> a -> Bool
== Value a
c'
  And Value Bool
a Value Bool
b == And Value Bool
a' Value Bool
b' = Value Bool
a Value Bool -> Value Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Value Bool
a' Bool -> Bool -> Bool
&& Value Bool
b Value Bool -> Value Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Value Bool
b'
  Equals Value a
a Value a
b == Equals Value a
a' Value a
b' = Value a -> Value a -> Value a -> Value a -> Bool
forall a b.
(Typeable a, Typeable b, Eq a) =>
a -> a -> b -> b -> Bool
eqEquals Value a
a Value a
b Value a
a' Value a
b'
  Or Value Bool
a Value Bool
b == Or Value Bool
a' Value Bool
b' = Value Bool
a Value Bool -> Value Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Value Bool
a' Bool -> Bool -> Bool
&& Value Bool
b Value Bool -> Value Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Value Bool
b'
  Not Value Bool
a == Not Value Bool
a' = Value Bool
a Value Bool -> Value Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Value Bool
a'
  GetAtt Text
a Text
b == GetAtt Text
a' Text
b' = Text
a Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
a' Bool -> Bool -> Bool
&& Text
b Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
b'
  Base64 Value Text
a == Base64 Value Text
a' = Value Text
a Value Text -> Value Text -> Bool
forall a. Eq a => a -> a -> Bool
== Value Text
a'
  FindInMap Value Text
a Value Text
b Value Text
c == FindInMap Value Text
a' Value Text
b' Value Text
c' = Value Text
a Value Text -> Value Text -> Bool
forall a. Eq a => a -> a -> Bool
== Value Text
a' Bool -> Bool -> Bool
&& Value Text
b Value Text -> Value Text -> Bool
forall a. Eq a => a -> a -> Bool
== Value Text
b' Bool -> Bool -> Bool
&& Value Text
c Value Text -> Value Text -> Bool
forall a. Eq a => a -> a -> Bool
== Value Text
c'
  ImportValue Value Text
a == ImportValue Value Text
a' = Value Text
a Value Text -> Value Text -> Bool
forall a. Eq a => a -> a -> Bool
== Value Text
a'
  Sub Text
a Maybe (KeyMap (Value Text))
b == Sub Text
a' Maybe (KeyMap (Value Text))
b' = Text
a Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
a' Bool -> Bool -> Bool
&& Maybe (KeyMap (Value Text))
b Maybe (KeyMap (Value Text)) -> Maybe (KeyMap (Value Text)) -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe (KeyMap (Value Text))
b'
  Value a
_ == Value a
_ = Bool
False

eqEquals :: (Typeable a, Typeable b, Eq a) => a -> a -> b -> b -> Bool
eqEquals :: forall a b.
(Typeable a, Typeable b, Eq a) =>
a -> a -> b -> b -> Bool
eqEquals a
a a
b b
a' b
b' = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ do
  a
a'' <- b -> Maybe a
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast b
a'
  a
b'' <- b -> Maybe a
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast b
b'
  Bool -> Maybe Bool
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a'' Bool -> Bool -> Bool
&& a
b a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b''

instance IsString a => IsString (Value a) where
  fromString :: String -> Value a
fromString String
s = a -> Value a
forall a. a -> Value a
Literal (String -> a
forall a. IsString a => String -> a
fromString String
s)

instance JSON.ToJSON a => JSON.ToJSON (Value a) where
  toJSON :: Value a -> Value
toJSON = \case
    (And Value Bool
x Value Bool
y)           -> Key -> [Value] -> Value
mkFunc Key
"Fn::And" [Value Bool -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON Value Bool
x, Value Bool -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON Value Bool
y]
    (Base64 Value Text
v)          -> [Pair] -> Value
JSON.object [(Key
"Fn::Base64", Value Text -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON Value Text
v)]
    (Equals Value a
x Value a
y)        -> Key -> [Value] -> Value
mkFunc Key
"Fn::Equals" [Value a -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON Value a
x, Value a -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON Value a
y]
    (GetAtt Text
x Text
y)        -> Key -> [Value] -> Value
mkFunc Key
"Fn::GetAtt" [Text -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON Text
x, Text -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON Text
y]
    (If Text
i Value a
x Value a
y)          -> Key -> [Value] -> Value
mkFunc Key
"Fn::If" [Text -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON Text
i, Value a -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON Value a
x, Value a -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON Value a
y]
    (ImportValue Value Text
t)     -> Value Text -> Value
importValueToJSON Value Text
t
    (Join Text
d ValueList Text
vs)         -> Key -> [Value] -> Value
mkFunc Key
"Fn::Join" [Text -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON Text
d, ValueList Text -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON ValueList Text
vs]
    (Literal a
v)         -> a -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON a
v
    (Not Value Bool
x)             -> Key -> [Value] -> Value
mkFunc Key
"Fn::Not" [Value Bool -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON Value Bool
x]
    (Or Value Bool
x Value Bool
y)            -> Key -> [Value] -> Value
mkFunc Key
"Fn::Or" [Value Bool -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON Value Bool
x, Value Bool -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON Value Bool
y]
    (Ref Text
r)             -> Text -> Value
refToJSON Text
r
    (Select Integer
i ValueList a
vs)       -> Key -> [Value] -> Value
mkFunc Key
"Fn::Select" [Integer -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON Integer
i, ValueList a -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON ValueList a
vs]
    (Sub Text
s (Just KeyMap (Value Text)
vals)) -> Key -> [Value] -> Value
mkFunc Key
"Fn::Sub" [Text -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON Text
s, Object -> Value
JSON.Object (Value Text -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON (Value Text -> Value) -> KeyMap (Value Text) -> Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeyMap (Value Text)
vals)]
    (Sub Text
s Maybe (KeyMap (Value Text))
Nothing)     -> [Pair] -> Value
JSON.object [(Key
"Fn::Sub" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
s)]
    (FindInMap Value Text
mapName Value Text
topKey Value Text
secondKey) -> [Pair] -> Value
JSON.object
      [ (Key
"Fn::FindInMap" Key -> [Value] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ([Value Text -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON Value Text
mapName, Value Text -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON Value Text
topKey, Value Text -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON Value Text
secondKey] :: [JSON.Value]))
      ]

-- | Simple version of 'Sub' without a map of values.
sub :: Text -> Value Text
sub :: Text -> Value Text
sub Text
s = Text -> Maybe (KeyMap (Value Text)) -> Value Text
Sub Text
s Maybe (KeyMap (Value Text))
forall a. Maybe a
Nothing

refToJSON :: Text -> JSON.Value
refToJSON :: Text -> Value
refToJSON Text
ref = [Pair] -> Value
JSON.object [(Key
"Ref" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
ref)]

importValueToJSON :: Value Text -> JSON.Value
importValueToJSON :: Value Text -> Value
importValueToJSON Value Text
ref = [Pair] -> Value
JSON.object [(Key
"Fn::ImportValue", Value Text -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON Value Text
ref)]

mkFunc :: JSON.Key -> [JSON.Value] -> JSON.Value
mkFunc :: Key -> [Value] -> Value
mkFunc Key
key [Value]
args = [Pair] -> Value
JSON.object [(Key
key, Array -> Value
JSON.Array (Array -> Value) -> Array -> Value
forall a b. (a -> b) -> a -> b
$ [Item Array] -> Array
forall l. IsList l => [Item l] -> l
fromList [Value]
[Item Array]
args)]

-- | 'ValueList' is like 'Value', except it is used in place of lists of values in
-- templates. For example, if you have a parameter called @SubnetIds@ of type
-- @List<AWS::EC2::Subnet::Id>@ then, you can use @RefList "SubnetIds"@ to
-- reference it.
data ValueList a
  = Cidr (Value Text) (Value Text) (Value Text)
  | GetAZs (Value Text)
  | ImportValueList (Value Text)
  | RefList Text
  | Split Text (Value a)
  | ValueList [Value a]
  deriving (Int -> ValueList a -> ShowS
[ValueList a] -> ShowS
ValueList a -> String
(Int -> ValueList a -> ShowS)
-> (ValueList a -> String)
-> ([ValueList a] -> ShowS)
-> Show (ValueList a)
forall a. Show a => Int -> ValueList a -> ShowS
forall a. Show a => [ValueList a] -> ShowS
forall a. Show a => ValueList a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> ValueList a -> ShowS
showsPrec :: Int -> ValueList a -> ShowS
$cshow :: forall a. Show a => ValueList a -> String
show :: ValueList a -> String
$cshowList :: forall a. Show a => [ValueList a] -> ShowS
showList :: [ValueList a] -> ShowS
Show, ValueList a -> ValueList a -> Bool
(ValueList a -> ValueList a -> Bool)
-> (ValueList a -> ValueList a -> Bool) -> Eq (ValueList a)
forall a. Eq a => ValueList a -> ValueList a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => ValueList a -> ValueList a -> Bool
== :: ValueList a -> ValueList a -> Bool
$c/= :: forall a. Eq a => ValueList a -> ValueList a -> Bool
/= :: ValueList a -> ValueList a -> Bool
Eq)

instance IsList (ValueList a) where
  type Item (ValueList a) = Value a
  fromList :: [Item (ValueList a)] -> ValueList a
fromList = [Item (ValueList a)] -> ValueList a
[Value a] -> ValueList a
forall a. [Value a] -> ValueList a
ValueList

  toList :: ValueList a -> [Item (ValueList a)]
toList = \case
    -- This is obviously not meaningful, but the IsList instance is so useful
    -- that I decided to allow it.
    (Cidr Value Text
_ Value Text
_ Value Text
_)        -> []
    (GetAZs Value Text
_)          -> []
    (ImportValueList Value Text
_) -> []
    (RefList Text
_)         -> []
    (Split Text
_ Value a
_)         -> []
    (ValueList [Value a]
xs)      -> [Item (ValueList a)]
[Value a]
xs

instance JSON.ToJSON a => JSON.ToJSON (ValueList a) where
  toJSON :: ValueList a -> Value
toJSON = \case
    (Cidr Value Text
ipBlock Value Text
count Value Text
cidrBits) -> [Pair] -> Value
JSON.object [(Key
"Fn::Cidr", Value Text -> Value Text -> Value Text -> Value
cidrArray Value Text
ipBlock Value Text
count Value Text
cidrBits)]
    (GetAZs Value Text
r)                    -> [Pair] -> Value
JSON.object [(Key
"Fn::GetAZs", Value Text -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON Value Text
r)]
    (ImportValueList Value Text
ref)         -> Value Text -> Value
importValueToJSON Value Text
ref
    (RefList Text
ref)                 -> Text -> Value
refToJSON Text
ref
    (Split Text
d Value a
s)                   -> Key -> [Value] -> Value
mkFunc Key
"Fn::Split" [Text -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON Text
d, Value a -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON Value a
s]
    (ValueList [Value a]
vals)              -> [Value a] -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON [Value a]
vals
    where
      cidrArray :: Value Text -> Value Text -> Value Text -> JSON.Value
      cidrArray :: Value Text -> Value Text -> Value Text -> Value
cidrArray Value Text
ipBlock Value Text
count Value Text
cidrBits
        = Array -> Value
JSON.Array
        [ Value Text -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON Value Text
ipBlock
        , Value Text -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON Value Text
count
        , Value Text -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON Value Text
cidrBits
        ]

-- | Class used to create a 'Ref' from another type.
class ToRef a b where
  toRef :: a -> Value b