cfn-flip 0.1.0.4 → 0.1.0.6
raw patch · 11 files changed
+113/−100 lines, 11 filesdep ~yamlPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: yaml
API changes (from Hackage documentation)
Files
- cfn-flip.cabal +9/−6
- src/CfnFlip.hs +0/−1
- src/CfnFlip/Conduit.hs +4/−6
- src/CfnFlip/IntrinsicFunction.hs +22/−21
- src/CfnFlip/JsonToYaml.hs +21/−19
- src/CfnFlip/Libyaml.hs +15/−10
- src/CfnFlip/Prelude.hs +6/−1
- src/CfnFlip/Yaml.hs +19/−20
- src/CfnFlip/YamlToJson.hs +9/−9
- test/CfnFlipSpec.hs +7/−6
- test/Spec.hs +1/−1
cfn-flip.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.18 name: cfn-flip-version: 0.1.0.4+version: 0.1.0.6 license: MIT license-file: LICENSE copyright: 2021 Renaissance Learning Inc@@ -79,7 +79,8 @@ TypeApplications TypeFamilies ghc-options:- -Weverything -Wno-missing-exported-signatures+ -Weverything -Wno-all-missed-specialisations+ -Wno-missed-specialisations -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-unsafe build-depends:@@ -91,7 +92,7 @@ text >=1.2.3.1, unliftio >=0.2.12, unliftio-core >=0.1.2.0,- yaml >=0.11.2.0+ yaml >=0.11.8.0 if impl(ghc >=9.2) ghc-options: -Wno-missing-kind-signatures@@ -117,14 +118,15 @@ TypeApplications TypeFamilies ghc-options:- -Weverything -Wno-missing-exported-signatures+ -Weverything -Wno-all-missed-specialisations+ -Wno-missed-specialisations -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-unsafe build-depends: aeson >=1.4.6.0, base >=4.11 && <10, doctest >=0.16.2,- yaml >=0.11.2.0+ yaml >=0.11.8.0 if impl(ghc >=9.2) ghc-options: -Wno-missing-kind-signatures@@ -154,7 +156,8 @@ TypeApplications TypeFamilies ghc-options:- -Weverything -Wno-missing-exported-signatures+ -Weverything -Wno-all-missed-specialisations+ -Wno-missed-specialisations -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-unsafe build-depends:
src/CfnFlip.hs view
@@ -29,7 +29,6 @@ -- | Read a file of JSON and produce a 'ByteString' of Yaml -- -- NB. The conversion occurs at 'Value'.--- jsonFileToYaml :: MonadUnliftIO m => FilePath -> m ByteString jsonFileToYaml = jsonToYaml @_ @Value <=< eitherDecodeFileStrictThrow
src/CfnFlip/Conduit.hs view
@@ -41,7 +41,6 @@ -- .| sinkList -- :} -- "this is (pretty unlikely"--- takeBalancedC :: Monad m => (a -> Bool) -> (a -> Bool) -> ConduitT a a m () takeBalancedC reopens closes = go (0 :: Int) where@@ -49,10 +48,9 @@ me <- await for_ me $ \a -> do- let- loop- | closes a = unless (balance <= 0) $ go $ balance - 1- | reopens a = go $ balance + 1- | otherwise = go balance+ let loop+ | closes a = unless (balance <= 0) $ go $ balance - 1+ | reopens a = go $ balance + 1+ | otherwise = go balance yield a >> loop
src/CfnFlip/IntrinsicFunction.hs view
@@ -6,7 +6,7 @@ import CfnFlip.Prelude -import CfnFlip.Libyaml (Event(..), Tag(..))+import CfnFlip.Libyaml (Event (..), Tag (..)) -- | If an 'Event' is using a known @"!X"@, returns the @"Fn::Y"@ for it getIntrinsicFunction :: Event -> Maybe ByteString@@ -33,26 +33,27 @@ _ -> Nothing intrinsics :: [(String, ByteString)]-intrinsics = map- toFn- [ "And"- , "Base64"- , "Cidr"- , "Equals"- , "FindInMap"- , "GetAtt"- , "GetAZs"- , "If"- , "ImportValue"- , "Join"- , "Not"- , "Or"- , "Ref"- , "Select"- , "Split"- , "Sub"- , "Transform"- ]+intrinsics =+ map+ toFn+ [ "And"+ , "Base64"+ , "Cidr"+ , "Equals"+ , "FindInMap"+ , "GetAtt"+ , "GetAZs"+ , "If"+ , "ImportValue"+ , "Join"+ , "Not"+ , "Or"+ , "Ref"+ , "Select"+ , "Split"+ , "Sub"+ , "Transform"+ ] where toFn x | x == "Ref" = ("!" <> unpack x, encodeUtf8 x)
src/CfnFlip/JsonToYaml.hs view
@@ -1,5 +1,5 @@ module CfnFlip.JsonToYaml- ( InvalidYamlEvent(..)+ ( InvalidYamlEvent (..) , translate ) where @@ -14,23 +14,22 @@ mS <- peekC case (e, mS) of- (EventMappingStart{}, Just s@EventScalar{})+ (EventMappingStart {}, Just s@EventScalar {}) | Just tag <- fromIntrinsicFunction s -> do- dropC 1 -- Scalar-- await >>= traverse_- (\case- i | tag == "!GetAtt" -> do- (resource, attribute) <- awaitGetAtt i- let key = resource <> "." <> attribute- yield $ EventScalar key (UriTag tag) SingleQuoted Nothing-- i -> do- yield $ setIntrinsicFunction tag i- when (startsMapOrSequence i) $ takeMapOrSequenceC i .| translate- )+ dropC 1 -- Scalar+ await+ >>= traverse_+ ( \case+ i | tag == "!GetAtt" -> do+ (resource, attribute) <- awaitGetAtt i+ let key = resource <> "." <> attribute+ yield $ EventScalar key (UriTag tag) SingleQuoted Nothing+ i -> do+ yield $ setIntrinsicFunction tag i+ when (startsMapOrSequence i) $ takeMapOrSequenceC i .| translate+ ) - dropC 1 -- MappingEnd+ dropC 1 -- MappingEnd _ -> yield e awaitGetAtt@@ -39,10 +38,13 @@ results <- sequence [await, await, await] case results of- [Just (EventScalar r _ _ _), Just (EventScalar a _ _ _), Just EventSequenceEnd{}]- -> pure (r, a)+ [ Just (EventScalar r _ _ _)+ , Just (EventScalar a _ _ _)+ , Just EventSequenceEnd {}+ ] ->+ pure (r, a) _ -> throwIO $ InvalidYamlEvent e $ "Unexpected GetAtt. Should be two Scalars and a SequenceEnd, saw: "- <> show results+ <> show results
src/CfnFlip/Libyaml.hs view
@@ -1,5 +1,5 @@ module CfnFlip.Libyaml- ( InvalidYamlEvent(..)+ ( InvalidYamlEvent (..) , makeMapping , makeSequence , startsMapOrSequence@@ -13,11 +13,16 @@ import CfnFlip.Conduit import Text.Libyaml- (Event(..), MappingStyle(..), SequenceStyle(..), Style(..), Tag(..))+ ( Event (..)+ , MappingStyle (..)+ , SequenceStyle (..)+ , Style (..)+ , Tag (..)+ ) data InvalidYamlEvent = InvalidYamlEvent Event String- deriving stock Show- deriving anyclass Exception+ deriving stock (Show)+ deriving anyclass (Exception) makeMapping :: Monad m => ByteString -> ConduitT i Event m () -> ConduitT i Event m ()@@ -35,20 +40,20 @@ startsMapOrSequence :: Event -> Bool startsMapOrSequence = \case- EventMappingStart{} -> True- EventSequenceStart{} -> True+ EventMappingStart {} -> True+ EventSequenceStart {} -> True _ -> False isSameStart :: Event -> Event -> Bool x `isSameStart` y = case (x, y) of- (EventMappingStart{}, EventMappingStart{}) -> True- (EventSequenceStart{}, EventSequenceStart{}) -> True+ (EventMappingStart {}, EventMappingStart {}) -> True+ (EventSequenceStart {}, EventSequenceStart {}) -> True _ -> False isStartsEnd :: Event -> Event -> Bool x `isStartsEnd` y = case (x, y) of- (EventMappingStart{}, EventMappingEnd{}) -> True- (EventSequenceStart{}, EventSequenceEnd{}) -> True+ (EventMappingStart {}, EventMappingEnd {}) -> True+ (EventSequenceStart {}, EventSequenceEnd {}) -> True _ -> False takeMapOrSequenceC :: Monad m => Event -> ConduitT Event Event m ()
src/CfnFlip/Prelude.hs view
@@ -7,7 +7,7 @@ import Prelude as X import Control.Monad as X (unless, when, (<=<))-import Control.Monad.IO.Class as X (MonadIO(..))+import Control.Monad.IO.Class as X (MonadIO (..)) import Control.Monad.IO.Unlift as X (MonadUnliftIO) import Data.ByteString as X (ByteString) import Data.Foldable as X (for_, traverse_)@@ -17,8 +17,13 @@ import Data.Word as X (Word8) import UnliftIO.Exception as X (Exception, throwIO, throwString) +{- FOURMOLU_DISABLE -}+ import qualified Data.ByteString as BS +{- FOURMOLU_ENABLE -}++{-# ANN module ("HLint: ignore Avoid restricted alias" :: String) #-} {-# ANN module ("HLint: ignore Avoid restricted qualification" :: String) #-} readFileBinary :: MonadIO m => FilePath -> m ByteString
src/CfnFlip/Yaml.hs view
@@ -1,5 +1,5 @@-{-# OPTIONS_GHC -Wno-missing-signatures #-} {-# OPTIONS_GHC -Wno-missing-local-signatures #-}+{-# OPTIONS_GHC -Wno-missing-signatures #-} module CfnFlip.Yaml ( encode@@ -8,7 +8,7 @@ import CfnFlip.Prelude -import CfnFlip.Aeson (ToJSON)+import CfnFlip.Aeson (FromJSON, ToJSON) import CfnFlip.Conduit import CfnFlip.IntrinsicFunction import CfnFlip.Libyaml@@ -17,8 +17,8 @@ import qualified Text.Libyaml as Libyaml newtype FromJSONError = FromJSONError String- deriving stock Show- deriving anyclass Exception+ deriving stock (Show)+ deriving anyclass (Exception) encode :: (MonadUnliftIO m, ToJSON a)@@ -28,9 +28,9 @@ encode c a = runConduitRes $ sourceList (Yaml.objToStream stringStyle a)- .| c- .| fixQuoting- .| Libyaml.encodeWith formatOptions+ .| c+ .| fixQuoting+ .| Libyaml.encodeWith formatOptions where stringStyle = Yaml.defaultStringStyle @@ -38,20 +38,19 @@ Libyaml.setTagRendering Libyaml.renderUriTags Libyaml.defaultFormatOptions fixQuoting :: Monad m => ConduitT Event Event m ()-fixQuoting = awaitForever $ yield . \case- e@(EventScalar x t _ z) | Just _ <- getIntrinsicFunction e ->- EventScalar x t SingleQuoted z- e -> e+fixQuoting =+ awaitForever+ $ yield . \case+ e@(EventScalar x t _ z)+ | Just _ <- getIntrinsicFunction e ->+ EventScalar x t SingleQuoted z+ e -> e --- We can't type this because Parse (nor ParserState) is exported------ TODO: File a bug------ decode--- :: (MonadIO m, FromJSON a)--- => ConduitT Event Event Yaml.Parse ()--- -> ByteString--- -> m a+decode+ :: (MonadIO m, FromJSON a)+ => ConduitT Event Event Yaml.Parse ()+ -> ByteString+ -> m a decode c bs = liftIO $ do result <- Yaml.decodeHelper $ Libyaml.decode bs .| c
src/CfnFlip/YamlToJson.hs view
@@ -1,31 +1,31 @@ module CfnFlip.YamlToJson- ( InvalidYamlEvent(..)+ ( InvalidYamlEvent (..) , translate ) where import CfnFlip.Prelude+import qualified Prelude as Unsafe (toEnum) 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 = awaitForever $ \case e@(EventScalar x (UriTag "!GetAtt") _ _) -> do (resource, attribute) <- maybe (throwInvalidGetAtt e x) pure $ parseGetAtt x - makeMapping "Fn::GetAtt" $ makeSequence $ yieldMany- [ EventScalar resource NoTag Plain Nothing- , EventScalar attribute NoTag Plain Nothing- ]-+ makeMapping "Fn::GetAtt"+ $ makeSequence+ $ yieldMany+ [ EventScalar resource NoTag Plain Nothing+ , EventScalar attribute NoTag Plain Nothing+ ] e | Just tag <- getIntrinsicFunction e -> do makeMapping tag $ do yield e when (startsMapOrSequence e) $ takeMapOrSequenceC e .| translate- e -> yield e parseGetAtt :: ByteString -> Maybe (ByteString, ByteString)@@ -38,7 +38,7 @@ throwIO $ InvalidYamlEvent e $ "!GetAtt shoule be \"Resource.Attribute\", saw "- <> show x+ <> show x charToWord8 :: Char -> Word8 charToWord8 = Unsafe.toEnum . fromEnum
test/CfnFlipSpec.hs view
@@ -22,8 +22,9 @@ describe "yaml-to-json" $ do for_ yamls $ \yaml -> do it yaml $ do- when (yaml == "test/examples/test_json_data.yaml") $ pendingWith- "Converting Scalar strings of JSON to actual Mapping objects"+ when (yaml == "test/examples/test_json_data.yaml")+ $ pendingWith+ "Converting Scalar strings of JSON to actual Mapping objects" actual <- yamlFileToJson @_ @Value yaml expected <- eitherDecodeFileStrictThrow @_ @Value $ yaml -<.> "json"@@ -43,9 +44,9 @@ runResourceT $ runConduit $ Libyaml.decodeFile yaml .| sinkList actual <- runConduit- $ sourceList expected- .| YamlToJson.translate- .| JsonToYaml.translate- .| sinkList+ $ sourceList expected+ .| YamlToJson.translate+ .| JsonToYaml.translate+ .| sinkList actual `shouldBe` expected
test/Spec.hs view
@@ -1,2 +1,2 @@-{-# OPTIONS_GHC -fno-warn-missing-export-lists #-} {-# OPTIONS_GHC -F -pgmF hspec-discover #-}+{-# OPTIONS_GHC -fno-warn-missing-export-lists #-}