content: 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 == Literal a' = a == a'
    Ref a == Ref a' = a == a'
    If a b c == If a' b' c' = a == a' && b == b' && c == c'
    And a b == And a' b' = a == a' && b == b'
    Equals a b == Equals a' b' = eqEquals a b a' b'
    Or a b == Or a' b' = a == a' && b == b'
    Not a == Not a' = a == a'
    GetAtt a b == GetAtt a' b' = a == a' && b == b'
    Base64 a == Base64 a' = a == a'
    FindInMap a b c == FindInMap a' b' c' = a == a' && b == b' && c == c'
    ImportValue a == ImportValue a' = a == a'
    Sub a b == Sub a' b' = a == a' && b == b'
    _ == _ = False
  
  eqEquals :: (Typeable a, Typeable b, Eq a) => a -> a -> b -> b -> Bool
  eqEquals a b a' b' = fromMaybe False $ do
    a'' <- cast a'
    b'' <- cast b'
    pure $ a == a'' && b == b''
  
  instance IsString a => IsString (Value a) where
    fromString s = Literal (fromString s)
  
  instance JSON.ToJSON a => JSON.ToJSON (Value a) where
    toJSON = \case
      (And x y)           -> mkFunc "Fn::And" [JSON.toJSON x, JSON.toJSON y]
      (Base64 v)          -> JSON.object [("Fn::Base64", JSON.toJSON v)]
      (Equals x y)        -> mkFunc "Fn::Equals" [JSON.toJSON x, JSON.toJSON y]
      (GetAtt x y)        -> mkFunc "Fn::GetAtt" [JSON.toJSON x, JSON.toJSON y]
      (If i x y)          -> mkFunc "Fn::If" [JSON.toJSON i, JSON.toJSON x, JSON.toJSON y]
      (ImportValue t)     -> importValueToJSON t
      (Join d vs)         -> mkFunc "Fn::Join" [JSON.toJSON d, JSON.toJSON vs]
      (Literal v)         -> JSON.toJSON v
      (Not x)             -> mkFunc "Fn::Not" [JSON.toJSON x]
      (Or x y)            -> mkFunc "Fn::Or" [JSON.toJSON x, JSON.toJSON y]
      (Ref r)             -> refToJSON r
      (Select i vs)       -> mkFunc "Fn::Select" [JSON.toJSON i, JSON.toJSON vs]
      (Sub s (Just vals)) -> mkFunc "Fn::Sub" [JSON.toJSON s, JSON.Object (JSON.toJSON <$> vals)]
      (Sub s Nothing)     -> JSON.object [("Fn::Sub" .= s)]
      (FindInMap mapName topKey secondKey) -> JSON.object
        [ ("Fn::FindInMap" .= ([JSON.toJSON mapName, JSON.toJSON topKey, JSON.toJSON secondKey] :: [JSON.Value]))
        ]
  
  -- | Simple version of 'Sub' without a map of values.
  sub :: Text -> Value Text
  sub s = Sub s Nothing
  
  refToJSON :: Text -> JSON.Value
  refToJSON ref = JSON.object [("Ref" .= ref)]
  
  importValueToJSON :: Value Text -> JSON.Value
  importValueToJSON ref = JSON.object [("Fn::ImportValue", JSON.toJSON ref)]
  
  mkFunc :: JSON.Key -> [JSON.Value] -> JSON.Value
  mkFunc key args = JSON.object [(key, JSON.Array $ fromList 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 (Show, Eq)
  
  instance IsList (ValueList a) where
    type Item (ValueList a) = Value a
    fromList = ValueList
  
    toList = \case
      -- This is obviously not meaningful, but the IsList instance is so useful
      -- that I decided to allow it.
      (Cidr _ _ _)        -> []
      (GetAZs _)          -> []
      (ImportValueList _) -> []
      (RefList _)         -> []
      (Split _ _)         -> []
      (ValueList xs)      -> xs
  
  instance JSON.ToJSON a => JSON.ToJSON (ValueList a) where
    toJSON = \case
      (Cidr ipBlock count cidrBits) -> JSON.object [("Fn::Cidr", cidrArray ipBlock count cidrBits)]
      (GetAZs r)                    -> JSON.object [("Fn::GetAZs", JSON.toJSON r)]
      (ImportValueList ref)         -> importValueToJSON ref
      (RefList ref)                 -> refToJSON ref
      (Split d s)                   -> mkFunc "Fn::Split" [JSON.toJSON d, JSON.toJSON s]
      (ValueList vals)              -> JSON.toJSON vals
      where
        cidrArray :: Value Text -> Value Text -> Value Text -> JSON.Value
        cidrArray ipBlock count cidrBits
          = JSON.Array
          [ JSON.toJSON ipBlock
          , JSON.toJSON count
          , JSON.toJSON cidrBits
          ]
  
  -- | Class used to create a 'Ref' from another type.
  class ToRef a b where
    toRef :: a -> Value b
  