dhall-fly 0.2.0 → 0.2.1

raw patch · 4 files changed

+44/−9 lines, 4 filesdep +ordered-containersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: ordered-containers

API changes (from Hackage documentation)

Files

• ChangeLog.md +4/−0
• dhall-fly.cabal +5/−2
• src/Fly/Yaml.hs +6/−4
• test/Fly/YamlSpec.hs +29/−3

@@ -1,5 +1,9 @@ # Changelog for dhall-fly +## 0.2.1++* Groups retain the order they are in list of grouped jobs+ ## 0.2.0  * Tested with dhall-concourse 0.5.0

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: fb42954e64638266e0514c8cb46537461e36d17e1295f1d60bc2f2b48dbbf23b+-- hash: 124eab9f2a66b1fb1fe7643b0e3a4b7084264c70a29698980ec92909df051cdb  name:           dhall-fly-version:        0.2.0+version:        0.2.1 synopsis:       Translate concourse config from Dhall to YAML description:    Please see the README on GitHub at <https://github.com/akshaymankar/dhall-fly#readme> category:       Concourse, YAML, JSON, Dhall@@ -159,6 +159,7 @@     , base >=4.7 && <5     , dhall >=1.27.0 && <1.28     , optparse-applicative+    , ordered-containers >=0.2.2     , scientific >=0.3.6.2     , text >=1.2.3.1     , transformers >=0.5.6.2@@ -183,6 +184,7 @@     , dhall-fly     , dhall-json >=1.5.0 && <1.6     , optparse-applicative+    , ordered-containers >=0.2.2     , scientific >=0.3.6.2     , text >=1.2.3.1     , transformers >=0.5.6.2@@ -210,6 +212,7 @@     , dhall-fly     , hspec     , optparse-applicative+    , ordered-containers >=0.2.2     , scientific >=0.3.6.2     , text >=1.2.3.1     , transformers >=0.5.6.2

@@ -10,6 +10,7 @@ import Fly.Types  import qualified Data.HashMap.Strict as HM+import qualified Data.Map.Ordered as OM  jobsToValue :: [Job] -> Value jobsToValue = Object . jobsToMap@@ -18,8 +19,8 @@ groupedJobsToValue groupedJobs =   let mapWithoutGroups = jobsToMap $ map gjJob groupedJobs       groupsAsMap = groupedJobsToMap groupedJobs-      mkGroupValue group jobs acc = object [ "name" .= group, "jobs" .= jobs ] : acc-      groupsAsValue = toJSON $ HM.foldrWithKey mkGroupValue [] groupsAsMap+      mkGroupValue (group, jobs) acc = object [ "name" .= group, "jobs" .= jobs ] : acc+      groupsAsValue = toJSON $ foldr mkGroupValue [] (OM.assocs groupsAsMap)       groupsMap = HM.singleton "groups" groupsAsValue   in Object $ HM.union mapWithoutGroups groupsMap @@ -32,11 +33,12 @@                  , ("jobs", toJSON jobs)                  ] -groupedJobsToMap :: [GroupedJob] -> HM.HashMap Text [Text]+groupedJobsToMap :: [GroupedJob] -> OM.OMap Text [Text] groupedJobsToMap gjs =   let toGroupJobsPair (GroupedJob j groups) = map (, [jobName j]) groups       groupJobsPairs = concatMap toGroupJobsPair gjs-  in HM.fromListWith (++) groupJobsPairs+      foldFn pair = OM.unionWithL (\_ v1 v2 -> v1 ++ v2) (OM.fromList [pair])+  in foldr foldFn OM.empty groupJobsPairs  customResourceTypes :: [ResourceType] -> [ResourceType] customResourceTypes [] = []

@@ -8,6 +8,7 @@ import Data.Aeson import Fly.Types import Fly.Yaml+import qualified Data.HashMap.Strict as HM  {-# ANN module "HLint: ignore Redundant do" #-} @@ -84,7 +85,6 @@                      , jobEnsure = Nothing                      } -    -- TODO: Make unordered assertions     describe "jobsToValue (without groups)" $ do       it "should translate jobs to Value as concourse expects it" $ do         jobsToValue [testJob]@@ -100,9 +100,35 @@           `shouldBe` object [ "resources"      .= [gitResource, stepSlack, jobSlack]                             , "resource_types" .= [slackResourceType]                             , "jobs"           .= [testJob]-                            , "groups"         .= toJSON [ object [ "name" .= "group2"+                            , "groups"         .= toJSON [ object [ "name" .= "group1"                                                                   , "jobs" .= [ jobName testJob ] ]-                                                         , object [ "name" .= "group1"+                                                         , object [ "name" .= "group2"                                                                   , "jobs" .= [ jobName testJob ] ]                                                          ]                             ]+      it "should retain order of groups" $ do+        let testJob2 = (testJob{jobName = "test-job2"})+        let testJob3 = (testJob{jobName = "test-job3"})+        let groupedJob1 = GroupedJob testJob ["group1", "group2"]+        let groupedJob2 = GroupedJob testJob2 ["group1", "group3"]+        let groupedJob3 = GroupedJob testJob3 ["group1", "group3", "group4"]+        let pipelineJSON = groupedJobsToValue [groupedJob1, groupedJob2, groupedJob3]+        case pipelineJSON of+          (Object o) ->+            case HM.lookup "groups" o of+              Just groups ->+                groups `shouldBe` toJSON [ object [ "name" .= "group1"+                                                  , "jobs" .= [ jobName testJob+                                                              , jobName testJob2+                                                              , jobName testJob3 ] ]+                                         , object [ "name" .= "group2"+                                                  , "jobs" .= [ jobName testJob ] ]+                                         , object [ "name" .= "group3"+                                                  , "jobs" .= [ jobName testJob2+                                                              , jobName testJob3 ] ]+                                         , object [ "name" .= "group4"+                                                  , "jobs" .= [ jobName testJob3 ] ]++                                         ]+              Nothing -> fail "Expected groups to be present"+          _ -> fail "Expected pipeline yaml to be object"