summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authoraxeman <>2019-12-02 18:02:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2019-12-02 18:02:00 (GMT)
commitb16ea4e38074a47cf0de48133003d3f3e4383252 (patch)
tree5c7d2036340fd6e7f32063bdce94bbe64bcd54dd
parent8d17f94ef7f6dc7458144a64ab9e0e83800d7fc1 (diff)
version 0.2.10.2.1
-rw-r--r--ChangeLog.md4
-rw-r--r--dhall-fly.cabal7
-rw-r--r--src/Fly/Yaml.hs10
-rw-r--r--test/Fly/YamlSpec.hs32
4 files changed, 44 insertions, 9 deletions
diff --git a/ChangeLog.md b/ChangeLog.md
index 1f81711..9e7d866 100644
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -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
diff --git a/dhall-fly.cabal b/dhall-fly.cabal
index a60c357..8bc44a9 100644
--- a/dhall-fly.cabal
+++ b/dhall-fly.cabal
@@ -4,10 +4,10 @@ cabal-version: 1.12
--
-- 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 @@ library
, 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 @@ executable dhall-fly
, 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 @@ test-suite dhall-fly-test
, 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
diff --git a/src/Fly/Yaml.hs b/src/Fly/Yaml.hs
index 1858d19..87135ff 100644
--- a/src/Fly/Yaml.hs
+++ b/src/Fly/Yaml.hs
@@ -10,6 +10,7 @@ import Data.Text (Text)
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 :: [GroupedJob] -> Value
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 @@ jobsToMap jobs =
, ("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 [] = []
diff --git a/test/Fly/YamlSpec.hs b/test/Fly/YamlSpec.hs
index 82f7cf1..3dc1e7a 100644
--- a/test/Fly/YamlSpec.hs
+++ b/test/Fly/YamlSpec.hs
@@ -8,6 +8,7 @@ import Test.Hspec
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 @@ spec = do
, 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 @@ spec = do
`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"