stratosphere 0.34.0 → 0.35.0

raw patch · 4 files changed

+51/−52 lines, 4 files

Files

CHANGELOG.md +10/−0
library/Stratosphere/Values.hs +39/−31
stratosphere.cabal +2/−2
tests/Stratosphere/ValuesSpec.hs +0/−19

CHANGELOG.md view

@@ -1,5 +1,15 @@ # Change Log +## 0.35.0++* Use a GADT for `Val a` so it is properly typed. This shouldn't break any+  programs that produced valid CloudFormation templates, but it should increase+  safety for templates that use intrinsic functions. This also allows us to+  properly implement some more intrinsic functions, like `Not`. See+  https://github.com/freckle/stratosphere/pull/120+* Added the `Fn::Not` intrinsic function. Fixes+  https://github.com/freckle/stratosphere/issues/80+ ## 0.34.0  * Don't encode `Bool`, `Int`, and `Double` values as strings in JSON. See:

library/Stratosphere/Values.hs view

@@ -1,6 +1,4 @@-{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE GADTs #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE StandaloneDeriving #-}@@ -15,43 +13,54 @@  import Data.Aeson import Data.HashMap.Strict (HashMap)+import Data.Maybe (fromMaybe) import Data.String (IsString (..)) import Data.Text (Text)+import Data.Typeable import GHC.Exts (IsList(..)) --- GADTs are cool, but I couldn't get this to work with FromJSON. Now that we--- don't have FromJSON though, we can revisit this.---- data Val a where---   Literal :: a -> Val a---   Ref :: Text -> Val a---   If :: Text -> Val a -> Val a -> Val a---   And :: Val Bool -> Val Bool -> Val Bool---   Equals :: (Show a, ToJSON a) => Val a -> Val a -> Val Bool---   Or :: Val Bool -> Val Bool -> Val Bool- -- | 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 Val a- = Literal a- | Ref Text- | If Text (Val a) (Val a)- | And (Val Bool) (Val Bool)- | Equals (Val a) (Val a)- | Or (Val Bool) (Val Bool)- | GetAtt Text Text- | Base64 (Val Text)- | Join Text (ValList Text)- | Select Integer (ValList a)- | FindInMap (Val a) (Val a) (Val a) -- ^ Map name, top level key, and second level key- | ImportValue Text -- ^ The account-and-region-unique exported name of the value to import- | Sub Text (Maybe (HashMap Text (Val Text))) -- ^ Substitution string and optional map of values+data Val a where+  Literal :: a -> Val a+  Ref :: Text -> Val a+  If :: Text -> Val a -> Val a -> Val a+  And :: Val Bool -> Val Bool -> Val Bool+  Equals :: (Show a, ToJSON a, Eq a, Typeable a) => Val a -> Val a -> Val Bool+  Or :: Val Bool -> Val Bool -> Val Bool+  Not :: Val Bool -> Val Bool+  GetAtt :: Text -> Text -> Val a+  Base64 :: Val Text -> Val Text+  Join :: Text -> ValList Text -> Val Text+  Select :: Integer -> ValList a -> Val a+  FindInMap :: Val Text -> Val Text -> Val Text -> Val a -- ^ Map name, top level key, and second level key+  ImportValue :: Text -> Val a -- ^ The account-and-region-unique exported name of the value to import+  Sub :: Text -> Maybe (HashMap Text (Val Text)) -> Val Text -- ^ Substitution string and optional map of values  deriving instance (Show a) => Show (Val a)-deriving instance (Eq a) => Eq (Val a)-deriving instance Functor Val +instance Eq a => Eq (Val 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, Eq b) => 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 (Val a) where   fromString s = Literal (fromString s) @@ -62,6 +71,7 @@   toJSON (And x y) = mkFunc "Fn::And" [toJSON x, toJSON y]   toJSON (Equals x y) = mkFunc "Fn::Equals" [toJSON x, toJSON y]   toJSON (Or x y) = mkFunc "Fn::Or" [toJSON x, toJSON y]+  toJSON (Not x) = mkFunc "Fn::Not" [toJSON x]   toJSON (GetAtt x y) = mkFunc "Fn::GetAtt" [toJSON x, toJSON y]   toJSON (Base64 v) = object [("Fn::Base64", toJSON v)]   toJSON (Join d vs) = mkFunc "Fn::Join" [toJSON d, toJSON vs]@@ -96,8 +106,6 @@   | Split Text (Val a)   | GetAZs (Val Text)   deriving (Show, Eq)--deriving instance Functor ValList  instance IsList (ValList a) where   type Item (ValList a) = Val a

stratosphere.cabal view

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 10ff95d8a3bd9b30a8bd0d461d1de0b4309dd157ef361b2855e113cbbf8995dd+-- hash: ea7cd0bc0e3e727dd5d25bdf08ba888d69317a1d5ace706408c2e87601a6583e  name:           stratosphere-version:        0.34.0+version:        0.35.0 synopsis:       EDSL for AWS CloudFormation description:    EDSL for AWS CloudFormation category:       AWS, Cloud

tests/Stratosphere/ValuesSpec.hs view

@@ -20,22 +20,3 @@      it "ImportValue and ImportValueList produce the same JSON" $ do       toJSON (ImportValue "MyVal" :: Val Text) `shouldBe` toJSON (ImportValueList "MyVal" :: ValList Text)--    it "Functor conversions in nested Vals work" $ do-      let-        input :: Val Integer-        input =-          Select 1 $-            ValList-            [ Literal 1-            , Ref "Hello"-            , Literal 2-            ]-        expected =-          Select 1 $-            ValList-            [ Literal 2-            , Ref "Hello"-            , Literal 3-            ]-      fmap (+1) input `shouldBe` expected