dhall-fly (empty) → 0.1.0
raw patch · 77 files changed
+1433/−0 lines, 77 filesdep +aesondep +aeson-casingdep +aeson-yamlsetup-changed
Dependencies added: aeson, aeson-casing, aeson-yaml, base, bytestring, dhall, dhall-fly, dhall-json, hspec, scientific, text, transformers, unordered-containers, vector
Files
- ChangeLog.md +7/−0
- LICENSE +30/−0
- README.md +15/−0
- Setup.hs +2/−0
- app/Main.hs +16/−0
- dhall-concourse/README.md +77/−0
- dhall-concourse/defaults/CustomResourceType.dhall +12/−0
- dhall-concourse/defaults/GetStep.dhall +13/−0
- dhall-concourse/defaults/ImageResource.dhall +8/−0
- dhall-concourse/defaults/Job.dhall +19/−0
- dhall-concourse/defaults/PutStep.dhall +12/−0
- dhall-concourse/defaults/Resource.dhall +13/−0
- dhall-concourse/defaults/StepHooks.dhall +8/−0
- dhall-concourse/defaults/TaskConfig.dhall +18/−0
- dhall-concourse/defaults/TaskRunConfig.dhall +8/−0
- dhall-concourse/defaults/TaskStep.dhall +15/−0
- dhall-concourse/defaults/package.dhall +11/−0
- dhall-concourse/helpers/aggregateStep.dhall +21/−0
- dhall-concourse/helpers/doStep.dhall +21/−0
- dhall-concourse/helpers/getStep.dhall +10/−0
- dhall-concourse/helpers/inParallelStep.dhall +41/−0
- dhall-concourse/helpers/inParallelStepSimple.dhall +9/−0
- dhall-concourse/helpers/package.dhall +9/−0
- dhall-concourse/helpers/putStep.dhall +12/−0
- dhall-concourse/helpers/taskStep.dhall +12/−0
- dhall-concourse/helpers/tryStep.dhall +14/−0
- dhall-concourse/lib/prelude.dhall +2/−0
- dhall-concourse/package.dhall +5/−0
- dhall-concourse/schemas/CustomResourceType.dhall +3/−0
- dhall-concourse/schemas/GetStep.dhall +1/−0
- dhall-concourse/schemas/ImageResource.dhall +3/−0
- dhall-concourse/schemas/Job.dhall +1/−0
- dhall-concourse/schemas/PutStep.dhall +1/−0
- dhall-concourse/schemas/Resource.dhall +1/−0
- dhall-concourse/schemas/StepHooks.dhall +1/−0
- dhall-concourse/schemas/TaskConfig.dhall +1/−0
- dhall-concourse/schemas/TaskRunConfig.dhall +3/−0
- dhall-concourse/schemas/TaskStep.dhall +1/−0
- dhall-concourse/schemas/package.dhall +11/−0
- dhall-concourse/types/BasicStep.dhall +9/−0
- dhall-concourse/types/CustomResourceType.dhall +9/−0
- dhall-concourse/types/GetStep.dhall +12/−0
- dhall-concourse/types/GetVersion.dhall +1/−0
- dhall-concourse/types/ImageResource.dhall +5/−0
- dhall-concourse/types/InParallelConfig.dhall +2/−0
- dhall-concourse/types/InParallelStep.dhall +4/−0
- dhall-concourse/types/JSONObject.dhall +3/−0
- dhall-concourse/types/Job.dhall +19/−0
- dhall-concourse/types/JobBuildLogRetention.dhall +1/−0
- dhall-concourse/types/PutStep.dhall +11/−0
- dhall-concourse/types/Resource.dhall +10/−0
- dhall-concourse/types/ResourceType.dhall +5/−0
- dhall-concourse/types/Step.dhall +6/−0
- dhall-concourse/types/StepConstructors.dhall +11/−0
- dhall-concourse/types/StepHooks.dhall +9/−0
- dhall-concourse/types/TaskCache.dhall +1/−0
- dhall-concourse/types/TaskConfig.dhall +10/−0
- dhall-concourse/types/TaskContainerLimits.dhall +1/−0
- dhall-concourse/types/TaskInput.dhall +1/−0
- dhall-concourse/types/TaskOutput.dhall +1/−0
- dhall-concourse/types/TaskRunConfig.dhall +5/−0
- dhall-concourse/types/TaskSpec.dhall +1/−0
- dhall-concourse/types/TaskStep.dhall +12/−0
- dhall-concourse/types/TextTextPair.dhall +1/−0
- dhall-concourse/types/package.dhall +26/−0
- dhall-concourse/utils/resourcesFromJobs.dhall +76/−0
- dhall-fly.cabal +164/−0
- src/Fly/Internal/AesonOrphans.hs +21/−0
- src/Fly/Internal/DhallOrphans.hs +28/−0
- src/Fly/Internal/DhallWithPrefix.hs +17/−0
- src/Fly/Types.hs +317/−0
- src/Fly/Yaml.hs +48/−0
- test/Fly/InterpretSpec.hs +77/−0
- test/Spec.hs +1/−0
- test/data/custom-resource-type.dhall +19/−0
- test/data/in-built-resource-type.dhall +3/−0
- test/data/resource.dhall +19/−0
+ ChangeLog.md view
@@ -0,0 +1,7 @@+# Changelog for dhall-fly++## 0.1.0++* Support for dhall-concourse 0.2.2++## Unreleased changes
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Akshay Mankar (c) 2019++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Akshay Mankar nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,15 @@+# dhall-fly [](https://travis-ci.org/akshaymankar/dhall-fly)++Tool to read concourse config written using [dhall-concourse](https://github.com/akshaymankar/dhall-concourse).++## Installation++1. Install stack: https://docs.haskellstack.org/en/stable/README/+1. Clone this repository **recursively**+1. Run `stack install` in the repository. This will install `dhall-fly` binary in `~/.local/bin`.++## Usage++```bash+fly -t <TARGET> set-pipeline -c <(dhall-fly <<< '/path/to/pipeline.dhall')+```
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,16 @@+module Main where++import Data.Aeson.Yaml (encode)+import Dhall (auto, input)+import Dhall.JSON (omitNull)+import Fly.Types (Job)+import Fly.Yaml (dhallToYaml)++import qualified Data.ByteString.Lazy.Char8 as LBS+import qualified Data.Text.IO (getContents)++main :: IO ()+main = do+ stdin <- Data.Text.IO.getContents+ jobs <- input auto stdin :: IO [Job]+ LBS.putStrLn $ encode $ omitNull $ dhallToYaml jobs
+ dhall-concourse/README.md view
@@ -0,0 +1,77 @@+# Dhall Concourse+Concourse types and helpers in dhall.++**Note:** A lot of this README is inspired (some of it copied) from the [dhall-kubernetes README](https://github.com/dhall-lang/dhall-kubernetes/blob/master/README.md), so thanks to the authors!++Dhall Concourse provides Dhall bindings for Concourse, so you can generate concourse pipelines from Dhall expressions. This will let you easily typecheck, template and modularize your Concourse pipelines.++## Why do I need this?++There are a lot of issues one could face while building any non-trivial pipeline. Few of them could be:+1. Pipeline yaml becomes very big and unmanageable+2. Same set of jobs are required to be run in different environments+3. Same set of hooks but with slight changes in all jobs. E.g. slack notifications, releasing resources on failure, etc.++Most common way to deal with these have been to use a templating language like erb, but it gets very messy very fast. We can do a lot better.++Dhall solves all of this, being a programming language with builtin templating, all while being non-Turing complete, strongly typed and [strongly normalizing](https://en.wikipedia.org/wiki/Normalization_property_(abstract_rewriting)) (i.e.: reduces everything to a normal form, no matter how much abstraction you build), so saving you from the _"oh-noes-I-made-my-config-in-code-and-now-its-too-abstract"_ nightmare.++For a Dhall Tutorial, see the [readme of the project](https://github.com/dhall-lang/dhall-lang), or the [full tutorial](http://hackage.haskell.org/package/dhall-1.17.0/docs/Dhall-Tutorial.html).++## Usage++To use dhall-concourse you need to install [dhall-fly](https://github.com/akshaymankar/dhall-fly#installation).++## Defining a pipeline++### Example 1: Hello World++This dhall expression will create a pipeline with one job, which would have one task. The task would run in a busybox container and echo "Hello Dhall".++```dhall+let Concourse =+ https://raw.githubusercontent.com/akshaymankar/dhall-concourse/0.2.1/package.dhall sha256:afc1f4a27ac5a1f4746065ee2e318041698cc9bb57096aa4f0d4d665f44a6ef2++let Prelude =+ https://prelude.dhall-lang.org/v11.1.0/package.dhall sha256:99462c205117931c0919f155a6046aec140c70fb8876d208c7c77027ab19c2fa++let busyboxImage =+ Concourse.schemas.ImageResource::{+ , type = "docker-image"+ , source = Some (toMap { repository = Prelude.JSON.string "busybox" })+ }++let job =+ Concourse.schemas.Job::{+ , name = "hello"+ , plan =+ [ Concourse.helpers.taskStep+ Concourse.schemas.TaskStep::{+ , task = "hello"+ , config =+ Concourse.Types.TaskSpec.Config+ Concourse.schemas.TaskConfig::{+ , image_resource = Some busyboxImage+ , run =+ Concourse.schemas.TaskRunConfig::{+ , path = "bash"+ , args = Some [ "-c", "echo Hello Dhall" ]+ }+ }+ }+ ]+ }++in [ job ]+```++To set the pipeline, run this command:++```+fly -t <TARGET> set-pipeline -p hello-dhall -c <(dhall-fly <pipeline.dhall)+```++### Example 2 (Real World™️)+++We in the Eirini team were facing issues with templating our pipeline YAMLs. Recently, we started converting our spruce/aviator based yaml templating into dhall. The work in progress can be seen in [our CI repo](https://github.com/cloudfoundry-incubator/eirini-ci/blob/47d2f229e33d9fcdb5641cec06fa68a0d82c0bff/pipelines/ci/pipeline.dhall).
+ dhall-concourse/defaults/CustomResourceType.dhall view
@@ -0,0 +1,12 @@+let Types = ../types/package.dhall++in { name = "CHANGEME"+ , type = "CHANGEME"+ , source = None Types.JSONObject+ , privileged = None Bool+ , params = None Types.JSONObject+ , check_every = None Text+ , tags = None Text+ , unique_version_history = None Bool+ }+ : Types.CustomResourceType
+ dhall-concourse/defaults/GetStep.dhall view
@@ -0,0 +1,13 @@+let Types = ../types/package.dhall++in { get = None Text+ , resource = ./Resource.dhall+ , params = None Types.JSONObject+ , version = None Types.GetVersion+ , passed = None (List Text)+ , trigger = None Bool+ , tags = None (List Text)+ , timeout = None Text+ , attempts = None Natural+ }+ : Types.GetStep
+ dhall-concourse/defaults/ImageResource.dhall view
@@ -0,0 +1,8 @@+let Types = ../types/package.dhall++in { type = "CHANGEME"+ , source = None Types.JSONObject+ , params = None Types.JSONObject+ , version = None (List Types.TextTextPair)+ }+ : Types.ImageResource
+ dhall-concourse/defaults/Job.dhall view
@@ -0,0 +1,19 @@+let Types = ../types/package.dhall++in { name = "CHANGEME"+ , old_name = None Text+ , plan = [] : List Types.Step+ , serial = None Bool+ , build_log_retention = None Types.JobBuildLogRetention+ , build_logs_to_retain = None Natural+ , serial_groups = None (List Text)+ , max_in_flight = None Natural+ , public = None Bool+ , disable_manual_trigger = None Bool+ , interruptible = None Bool+ , on_success = None Types.Step+ , on_failure = None Types.Step+ , on_abort = None Types.Step+ , ensure = None Types.Step+ }+ : Types.Job
+ dhall-concourse/defaults/PutStep.dhall view
@@ -0,0 +1,12 @@+let Types = ../types/package.dhall++in { put = None Text+ , resource = ./Resource.dhall+ , inputs = None (List Text)+ , params = None Types.JSONObject+ , get_params = None Types.JSONObject+ , tags = None (List Text)+ , timeout = None Text+ , attempts = None Natural+ }+ : Types.PutStep
+ dhall-concourse/defaults/Resource.dhall view
@@ -0,0 +1,13 @@+let Types = ../types/package.dhall++in { name = "CHANGEME"+ , type = Types.ResourceType.InBuilt "CHANGEME"+ , icon = None Text+ , source = None Types.JSONObject+ , version = None (List Types.TextTextPair)+ , check_every = None Text+ , tags = None (List Text)+ , public = None Bool+ , webhook_token = None Text+ }+ : Types.Resource
+ dhall-concourse/defaults/StepHooks.dhall view
@@ -0,0 +1,8 @@+ λ(Step : Type)+→ let Types = ../types/package.dhall+ in { on_success = None Step+ , on_failure = None Step+ , on_abort = None Step+ , ensure = None Step+ }+ : Types.StepHooks Step
+ dhall-concourse/defaults/TaskConfig.dhall view
@@ -0,0 +1,18 @@+let Types = ../types/package.dhall++in { platform = "linux"+ , run =+ { path = "CHANGEME"+ , args = None (List Text)+ , dir = None Text+ , user = None Text+ }+ , container_limits = None Types.TaskContainerLimits+ , image_resource = None Types.ImageResource+ , rootfs_uri = None Text+ , inputs = None (List Types.TaskInput)+ , outputs = None (List Types.TaskOutput)+ , caches = None (List Types.TaskCache)+ , params = None (List { mapKey : Text, mapValue : Optional Text })+ }+ : Types.TaskConfig
+ dhall-concourse/defaults/TaskRunConfig.dhall view
@@ -0,0 +1,8 @@+let Types = ../types/package.dhall++in { path = "CHANGEME"+ , args = None (List Text)+ , dir = None Text+ , user = None Text+ }+ : Types.TaskRunConfig
+ dhall-concourse/defaults/TaskStep.dhall view
@@ -0,0 +1,15 @@+let Types = ../types/package.dhall++in { task = "CHANGEME"+ , config = Types.TaskSpec.Config ./TaskConfig.dhall+ , privileged = None Bool+ , params = None (List Types.TextTextPair)+ , image = None Text+ , input_mapping = None (List Types.TextTextPair)+ , output_mapping = None (List Types.TextTextPair)+ , vars = None Types.JSONObject+ , tags = None (List Text)+ , timeout = None Text+ , attempts = None Natural+ }+ : Types.TaskStep
+ dhall-concourse/defaults/package.dhall view
@@ -0,0 +1,11 @@+{ CustomResourceType = ./CustomResourceType.dhall+, Resource = ./Resource.dhall+, Job = ./Job.dhall+, GetStep = ./GetStep.dhall+, ImageResource = ./ImageResource.dhall+, StepHooks = ./StepHooks.dhall+, TaskStep = ./TaskStep.dhall+, TaskConfig = ./TaskConfig.dhall+, TaskRunConfig = ./TaskRunConfig.dhall+, PutStep = ./PutStep.dhall+}
+ dhall-concourse/helpers/aggregateStep.dhall view
@@ -0,0 +1,21 @@+let Types = ../types/package.dhall++let Defaults = ../defaults/package.dhall++let Prelude = ../lib/prelude.dhall++let aggregateStep+ : List Types.Step → Types.Step+ = λ(aggregatedSteps : List Types.Step)+ → λ(Step : Type)+ → λ(constructors : Types.StepConstructors Step)+ → let stepTypeFix =+ Prelude.List.map+ Types.Step+ Step+ (λ(s : Types.Step) → s Step constructors)+ aggregatedSteps+ + in constructors.aggregate stepTypeFix (Defaults.StepHooks Step)++in aggregateStep
+ dhall-concourse/helpers/doStep.dhall view
@@ -0,0 +1,21 @@+let Types = ../types/package.dhall++let Defaults = ../defaults/package.dhall++let Prelude = ../lib/prelude.dhall++let doStep+ : List Types.Step → Types.Step+ = λ(steps : List Types.Step)+ → λ(Step : Type)+ → λ(constructors : Types.StepConstructors Step)+ → let stepTypeFix =+ Prelude.List.map+ Types.Step+ Step+ (λ(s : Types.Step) → s Step constructors)+ steps+ + in constructors.do stepTypeFix (Defaults.StepHooks Step)++in doStep
+ dhall-concourse/helpers/getStep.dhall view
@@ -0,0 +1,10 @@+let Types = ../types/package.dhall++let Defaults = ../defaults/package.dhall++in ( λ(getStep : Types.GetStep)+ → λ(Step : Type)+ → λ(constructors : Types.StepConstructors Step)+ → constructors.get getStep (Defaults.StepHooks Step)+ )+ : Types.GetStep → Types.Step
+ dhall-concourse/helpers/inParallelStep.dhall view
@@ -0,0 +1,41 @@+let Types = ../types/package.dhall++let Defaults = ../defaults/package.dhall++let Prelude = ../lib/prelude.dhall++let typeFixSteps+ : ∀(T : Type) → Types.StepConstructors T → List Types.Step → List T+ = λ(T : Type)+ → λ(constructors : Types.StepConstructors T)+ → Prelude.List.map Types.Step T (λ(s : Types.Step) → s T constructors)++let typeFix+ : ∀(T : Type)+ → Types.StepConstructors T+ → Types.InParallelStep Types.Step+ → Types.InParallelStep T+ = λ(T : Type)+ → λ(constructors : Types.StepConstructors T)+ → λ(parallel : Types.InParallelStep Types.Step)+ → merge+ { Steps =+ λ(s : List Types.Step)+ → (Types.InParallelStep T).Steps (typeFixSteps T constructors s)+ , Config =+ λ(cfg : Types.InParallelConfig Types.Step)+ → (Types.InParallelStep T).Config+ (cfg ⫽ { steps = typeFixSteps T constructors cfg.steps })+ }+ parallel++let inParallelStep+ : Types.InParallelStep Types.Step → Types.Step+ = λ(parallelSteps : Types.InParallelStep Types.Step)+ → λ(Step : Type)+ → λ(constructors : Types.StepConstructors Step)+ → let stepTypeFix = typeFix Step constructors parallelSteps+ + in constructors.in_parallel stepTypeFix (Defaults.StepHooks Step)++in inParallelStep
+ dhall-concourse/helpers/inParallelStepSimple.dhall view
@@ -0,0 +1,9 @@+let Types = ../types/package.dhall++let inParallelStep+ : List Types.Step → Types.Step+ = λ(parallelSteps : List Types.Step)+ → ./inParallelStep.dhall+ ((Types.InParallelStep Types.Step).Steps parallelSteps)++in inParallelStep
+ dhall-concourse/helpers/package.dhall view
@@ -0,0 +1,9 @@+{ taskStep = ./taskStep.dhall+, putStep = ./putStep.dhall+, getStep = ./getStep.dhall+, aggregateStep = ./aggregateStep.dhall+, inParallelStep = ./inParallelStep.dhall+, inParallelStepSimple = ./inParallelStepSimple.dhall+, doStep = ./doStep.dhall+, tryStep = ./tryStep.dhall+}
+ dhall-concourse/helpers/putStep.dhall view
@@ -0,0 +1,12 @@+let Types = ../types/package.dhall++let Defaults = ../defaults/package.dhall++let putStep+ : Types.PutStep → Types.Step+ = λ(putStep : Types.PutStep)+ → λ(Step : Type)+ → λ(constructors : Types.StepConstructors Step)+ → constructors.put putStep (Defaults.StepHooks Step)++in putStep
+ dhall-concourse/helpers/taskStep.dhall view
@@ -0,0 +1,12 @@+let Types = ../types/package.dhall++let Defaults = ../defaults/package.dhall++let taskStep+ : Types.TaskStep → Types.Step+ = λ(taskStep : Types.TaskStep)+ → λ(Step : Type)+ → λ(constructors : Types.StepConstructors Step)+ → constructors.task taskStep (Defaults.StepHooks Step)++in taskStep
+ dhall-concourse/helpers/tryStep.dhall view
@@ -0,0 +1,14 @@+let Types = ../types/package.dhall++let Defaults = ../defaults/package.dhall++let tryStep+ : Types.Step → Types.Step+ = λ(step : Types.Step)+ → λ(Step : Type)+ → λ(constructors : Types.StepConstructors Step)+ → let stepTypeFix = step Step constructors+ + in constructors.try stepTypeFix (Defaults.StepHooks Step)++in tryStep
+ dhall-concourse/lib/prelude.dhall view
@@ -0,0 +1,2 @@+ https://prelude.dhall-lang.org/v11.1.0/package.dhall sha256:99462c205117931c0919f155a6046aec140c70fb8876d208c7c77027ab19c2fa+? https://prelude.dhall-lang.org/v11.1.0/package.dhall
+ dhall-concourse/package.dhall view
@@ -0,0 +1,5 @@+{ Types = ./types/package.dhall+, defaults = ./defaults/package.dhall+, schemas = ./schemas/package.dhall+, helpers = ./helpers/package.dhall+}
+ dhall-concourse/schemas/CustomResourceType.dhall view
@@ -0,0 +1,3 @@+{ Type = ../types/CustomResourceType.dhall+, default = ../defaults/CustomResourceType.dhall+}
+ dhall-concourse/schemas/GetStep.dhall view
@@ -0,0 +1,1 @@+{ Type = ../types/GetStep.dhall, default = ../defaults/GetStep.dhall }
+ dhall-concourse/schemas/ImageResource.dhall view
@@ -0,0 +1,3 @@+{ Type = ../types/ImageResource.dhall+, default = ../defaults/ImageResource.dhall+}
+ dhall-concourse/schemas/Job.dhall view
@@ -0,0 +1,1 @@+{ Type = ../types/Job.dhall, default = ../defaults/Job.dhall }
+ dhall-concourse/schemas/PutStep.dhall view
@@ -0,0 +1,1 @@+{ Type = ../types/PutStep.dhall, default = ../defaults/PutStep.dhall }
+ dhall-concourse/schemas/Resource.dhall view
@@ -0,0 +1,1 @@+{ Type = ../types/Resource.dhall, default = ../defaults/Resource.dhall }
+ dhall-concourse/schemas/StepHooks.dhall view
@@ -0,0 +1,1 @@+{ Type = ../types/StepHooks.dhall, default = ../defaults/StepHooks.dhall }
+ dhall-concourse/schemas/TaskConfig.dhall view
@@ -0,0 +1,1 @@+{ Type = ../types/TaskConfig.dhall, default = ../defaults/TaskConfig.dhall }
+ dhall-concourse/schemas/TaskRunConfig.dhall view
@@ -0,0 +1,3 @@+{ Type = ../types/TaskRunConfig.dhall+, default = ../defaults/TaskRunConfig.dhall+}
+ dhall-concourse/schemas/TaskStep.dhall view
@@ -0,0 +1,1 @@+{ Type = ../types/TaskStep.dhall, default = ../defaults/TaskStep.dhall }
+ dhall-concourse/schemas/package.dhall view
@@ -0,0 +1,11 @@+{ CustomResourceType = ./CustomResourceType.dhall+, Resource = ./Resource.dhall+, Job = ./Job.dhall+, GetStep = ./GetStep.dhall+, ImageResource = ./ImageResource.dhall+, StepHooks = ./StepHooks.dhall+, TaskStep = ./TaskStep.dhall+, TaskConfig = ./TaskConfig.dhall+, TaskRunConfig = ./TaskRunConfig.dhall+, PutStep = ./PutStep.dhall+}
+ dhall-concourse/types/BasicStep.dhall view
@@ -0,0 +1,9 @@+let GetStep = ./GetStep.dhall++let PutStep = ./PutStep.dhall++let TaskStep = ./TaskStep.dhall++let BasicStep = < Get : GetStep | Put : PutStep | Task : TaskStep >++in BasicStep
+ dhall-concourse/types/CustomResourceType.dhall view
@@ -0,0 +1,9 @@+{ name : Text+, type : Text+, source : Optional ./JSONObject.dhall+, privileged : Optional Bool+, params: Optional ./JSONObject.dhall+, check_every: Optional Text+, tags : Optional Text+, unique_version_history: Optional Bool+}
+ dhall-concourse/types/GetStep.dhall view
@@ -0,0 +1,12 @@+let Resource = ./Resource.dhall++in { get : Optional Text+ , resource : Resource+ , params : Optional ./JSONObject.dhall+ , version : Optional ./GetVersion.dhall+ , passed : Optional (List Text)+ , trigger : Optional Bool+ , tags : Optional (List Text)+ , timeout : Optional Text+ , attempts : Optional Natural+ }
+ dhall-concourse/types/GetVersion.dhall view
@@ -0,0 +1,1 @@+< Latest : Text | Every : Text | SpecificVersion : List ./TextTextPair.dhall >
+ dhall-concourse/types/ImageResource.dhall view
@@ -0,0 +1,5 @@+{ type : Text+, source : Optional (./JSONObject.dhall)+, params : Optional (./JSONObject.dhall)+, version : Optional (List ./TextTextPair.dhall)+}
+ dhall-concourse/types/InParallelConfig.dhall view
@@ -0,0 +1,2 @@+ λ(Step : Type)+→ { steps : List Step, limit : Optional Natural, fail_fast : Optional Bool }
+ dhall-concourse/types/InParallelStep.dhall view
@@ -0,0 +1,4 @@+ λ(Step : Type)+→ let InParallelConfig = ./InParallelConfig.dhall Step+ + in < Steps : List Step | Config : InParallelConfig >
+ dhall-concourse/types/JSONObject.dhall view
@@ -0,0 +1,3 @@+let Prelude = ../lib/prelude.dhall++in List { mapKey : Text, mapValue : Prelude.JSON.Type }
+ dhall-concourse/types/Job.dhall view
@@ -0,0 +1,19 @@+let Step = ./Step.dhall++in { name : Text+ , old_name : Optional Text+ , plan : List Step+ , serial : Optional Bool+ , build_log_retention :+ Optional ./JobBuildLogRetention.dhall+ , build_logs_to_retain : Optional Natural+ , serial_groups : Optional (List Text)+ , max_in_flight : Optional Natural+ , public : Optional Bool+ , disable_manual_trigger : Optional Bool+ , interruptible : Optional Bool+ , on_success : Optional Step+ , on_failure : Optional Step+ , on_abort : Optional Step+ , ensure : Optional Step+ }
+ dhall-concourse/types/JobBuildLogRetention.dhall view
@@ -0,0 +1,1 @@+{ days : Optional Natural, builds : Optional Natural }
+ dhall-concourse/types/PutStep.dhall view
@@ -0,0 +1,11 @@+let Resource = ./Resource.dhall++in { put : Optional Text+ , resource : Resource+ , inputs : Optional (List Text)+ , params : Optional ./JSONObject.dhall+ , get_params : Optional ./JSONObject.dhall+ , tags : Optional (List Text)+ , timeout : Optional Text+ , attempts : Optional Natural+ }
+ dhall-concourse/types/Resource.dhall view
@@ -0,0 +1,10 @@+{ name : Text+, type : ./ResourceType.dhall+, icon : Optional Text+, source : Optional ./JSONObject.dhall+, version : Optional (List ./TextTextPair.dhall)+, check_every : Optional Text+, tags : Optional (List Text)+, public: Optional Bool+, webhook_token : Optional Text+}
+ dhall-concourse/types/ResourceType.dhall view
@@ -0,0 +1,5 @@+let CustomResourceType = ./CustomResourceType.dhall++let ResourceType = < Custom : CustomResourceType | InBuilt : Text >++in ResourceType
+ dhall-concourse/types/Step.dhall view
@@ -0,0 +1,6 @@+let Step =+ ∀(Step : Type)+ → ./StepConstructors.dhall Step+ → Step++in Step
+ dhall-concourse/types/StepConstructors.dhall view
@@ -0,0 +1,11 @@+let StepHooks = ./StepHooks.dhall++in λ(Step : Type)+ → { get : ./GetStep.dhall → StepHooks Step → Step+ , put : ./PutStep.dhall → StepHooks Step → Step+ , task : ./TaskStep.dhall → StepHooks Step → Step+ , aggregate : List Step → StepHooks Step → Step+ , in_parallel : ./InParallelStep.dhall Step → StepHooks Step → Step+ , do : List Step → StepHooks Step → Step+ , try : Step → StepHooks Step → Step+ }
+ dhall-concourse/types/StepHooks.dhall view
@@ -0,0 +1,9 @@+let StepHooks =+ λ(Step : Type)+ → { on_success : Optional Step+ , on_failure : Optional Step+ , on_abort : Optional Step+ , ensure : Optional Step+ }++in StepHooks
+ dhall-concourse/types/TaskCache.dhall view
@@ -0,0 +1,1 @@+{ path : Text }
+ dhall-concourse/types/TaskConfig.dhall view
@@ -0,0 +1,10 @@+{ platform : Text+, run : ./TaskRunConfig.dhall+, image_resource : Optional ./ImageResource.dhall+, rootfs_uri : Optional Text+, container_limits : Optional ./TaskContainerLimits.dhall+, inputs : Optional (List ./TaskInput.dhall)+, outputs : Optional (List ./TaskOutput.dhall)+, caches : Optional (List ./TaskCache.dhall)+, params : Optional (List { mapKey : Text, mapValue : Optional Text })+}
+ dhall-concourse/types/TaskContainerLimits.dhall view
@@ -0,0 +1,1 @@+{ cpu : Optional Natural, memory : Optional Natural }
+ dhall-concourse/types/TaskInput.dhall view
@@ -0,0 +1,1 @@+{ name : Text, path : Optional Text, optional : Optional Bool }
+ dhall-concourse/types/TaskOutput.dhall view
@@ -0,0 +1,1 @@+{ name : Text, path : Optional Text }
+ dhall-concourse/types/TaskRunConfig.dhall view
@@ -0,0 +1,5 @@+{ path : Text+, args : Optional (List Text)+, dir : Optional Text+, user : Optional Text+}
+ dhall-concourse/types/TaskSpec.dhall view
@@ -0,0 +1,1 @@+< File : Text | Config : ./TaskConfig.dhall >
+ dhall-concourse/types/TaskStep.dhall view
@@ -0,0 +1,12 @@+{ task : Text+, config : ./TaskSpec.dhall+, privileged : Optional Bool+, vars : Optional ./JSONObject.dhall+, params : Optional (List ./TextTextPair.dhall)+, image : Optional Text+, input_mapping : Optional (List ./TextTextPair.dhall)+, output_mapping : Optional (List ./TextTextPair.dhall)+, tags : Optional (List Text)+, timeout : Optional Text+, attempts : Optional Natural+}
+ dhall-concourse/types/TextTextPair.dhall view
@@ -0,0 +1,1 @@+{ mapKey : Text, mapValue : Text }
+ dhall-concourse/types/package.dhall view
@@ -0,0 +1,26 @@+{ BasicStep = ./BasicStep.dhall+, CustomResourceType = ./CustomResourceType.dhall+, GetStep = ./GetStep.dhall+, GetVersion = ./GetVersion.dhall+, ImageResource = ./ImageResource.dhall+, InParallelConfig = ./InParallelConfig.dhall+, InParallelStep = ./InParallelStep.dhall+, Job = ./Job.dhall+, JobBuildLogRetention = ./JobBuildLogRetention.dhall+, JSONObject = ./JSONObject.dhall+, PutStep = ./PutStep.dhall+, Resource = ./Resource.dhall+, ResourceType = ./ResourceType.dhall+, Step = ./Step.dhall+, StepConstructors = ./StepConstructors.dhall+, StepHooks = ./StepHooks.dhall+, TaskConfig = ./TaskConfig.dhall+, TaskInput = ./TaskInput.dhall+, TaskOutput = ./TaskOutput.dhall+, TaskCache = ./TaskCache.dhall+, TaskContainerLimits = ./TaskContainerLimits.dhall+, TaskRunConfig = ./TaskRunConfig.dhall+, TaskStep = ./TaskStep.dhall+, TaskSpec = ./TaskSpec.dhall+, TextTextPair = ./TextTextPair.dhall+}
+ dhall-concourse/utils/resourcesFromJobs.dhall view
@@ -0,0 +1,76 @@+let Prelude = ../lib/prelude.dhall++let Types = ../types/package.dhall++let Resource = Types.Resource++let StepHooks = Types.StepHooks++let catOptionals+ : ∀(x : Type) → List (Optional x) → List x+ = λ(x : Type)+ → λ(os : List (Optional x))+ → Prelude.List.fold+ (Optional x)+ os+ (List x)+ (λ(a : Optional x) → λ(l : List x) → Prelude.Optional.toList x a # l)+ ([] : List x)++let resourcesFromStepHooks+ : StepHooks (List Resource) → List Resource+ = λ(h : StepHooks (List Resource))+ → let listOfListOfResources =+ catOptionals+ (List Resource)+ [ h.ensure, h.on_success, h.on_failure, h.on_abort ]+ + in Prelude.List.concat Resource listOfListOfResources++let resourcesFromGetStep+ : Types.GetStep → StepHooks (List Resource) → List Resource+ = λ(g : Types.GetStep)+ → λ(h : StepHooks (List Resource))+ → [ g.resource ] # resourcesFromStepHooks h++let resourcesFromPutStep+ : Types.PutStep → StepHooks (List Resource) → List Resource+ = λ(p : Types.PutStep)+ → λ(h : StepHooks (List Resource))+ → [ p.resource ] # resourcesFromStepHooks h++let resourcesFromTaskStep+ : Types.TaskStep → StepHooks (List Resource) → List Resource+ = λ(_ : Types.TaskStep)+ → λ(h : StepHooks (List Resource))+ → resourcesFromStepHooks h++let resourcesFromAggregateOrDo+ : List (List Resource) → StepHooks (List Resource) → List Resource+ = λ(rs : List (List Resource))+ → λ(h : StepHooks (List Resource))+ → Prelude.List.concat Resource rs # resourcesFromStepHooks h++let resourcesFromTry+ : List Resource → StepHooks (List Resource) → List Resource+ = λ(rs : List Resource)+ → λ(h : StepHooks (List Resource))+ → rs # resourcesFromStepHooks h++let resourcesFromStep =+ λ(s : Types.Step)+ → s+ (List Resource)+ resourcesFromGetStep+ resourcesFromPutStep+ resourcesFromTaskStep+ resourcesFromAggregateOrDo+ resourcesFromAggregateOrDo+ resourcesFromTry++let resourcesFromJob =+ λ(j : Types.Job)+ → Prelude.List.concatMap Types.Step Resource resourcesFromStep j.plan++in Prelude.List.concatMap Types.Job Resource resourcesFromJob+ : List Types.Job → List Resource
+ dhall-fly.cabal view
@@ -0,0 +1,164 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: 34a102125b5ca6677a5bc0feae708c3b5f1137b172bb562d0b770ad6367e6e12++name: dhall-fly+version: 0.1.0+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+homepage: https://github.com/akshaymankar/dhall-fly#readme+bug-reports: https://github.com/akshaymankar/dhall-fly/issues+author: Akshay Mankar+maintainer: itsakshaymankar@gmail.com+copyright: Akshay Mankar+license: BSD3+license-file: LICENSE+build-type: Simple+extra-source-files:+ README.md+ ChangeLog.md+ dhall-concourse/defaults/CustomResourceType.dhall+ dhall-concourse/defaults/GetStep.dhall+ dhall-concourse/defaults/ImageResource.dhall+ dhall-concourse/defaults/Job.dhall+ dhall-concourse/defaults/package.dhall+ dhall-concourse/defaults/PutStep.dhall+ dhall-concourse/defaults/Resource.dhall+ dhall-concourse/defaults/StepHooks.dhall+ dhall-concourse/defaults/TaskConfig.dhall+ dhall-concourse/defaults/TaskRunConfig.dhall+ dhall-concourse/defaults/TaskStep.dhall+ dhall-concourse/helpers/aggregateStep.dhall+ dhall-concourse/helpers/doStep.dhall+ dhall-concourse/helpers/getStep.dhall+ dhall-concourse/helpers/inParallelStep.dhall+ dhall-concourse/helpers/inParallelStepSimple.dhall+ dhall-concourse/helpers/package.dhall+ dhall-concourse/helpers/putStep.dhall+ dhall-concourse/helpers/taskStep.dhall+ dhall-concourse/helpers/tryStep.dhall+ dhall-concourse/lib/prelude.dhall+ dhall-concourse/package.dhall+ dhall-concourse/README.md+ dhall-concourse/schemas/CustomResourceType.dhall+ dhall-concourse/schemas/GetStep.dhall+ dhall-concourse/schemas/ImageResource.dhall+ dhall-concourse/schemas/Job.dhall+ dhall-concourse/schemas/package.dhall+ dhall-concourse/schemas/PutStep.dhall+ dhall-concourse/schemas/Resource.dhall+ dhall-concourse/schemas/StepHooks.dhall+ dhall-concourse/schemas/TaskConfig.dhall+ dhall-concourse/schemas/TaskRunConfig.dhall+ dhall-concourse/schemas/TaskStep.dhall+ dhall-concourse/types/BasicStep.dhall+ dhall-concourse/types/CustomResourceType.dhall+ dhall-concourse/types/GetStep.dhall+ dhall-concourse/types/GetVersion.dhall+ dhall-concourse/types/ImageResource.dhall+ dhall-concourse/types/InParallelConfig.dhall+ dhall-concourse/types/InParallelStep.dhall+ dhall-concourse/types/Job.dhall+ dhall-concourse/types/JobBuildLogRetention.dhall+ dhall-concourse/types/JSONObject.dhall+ dhall-concourse/types/package.dhall+ dhall-concourse/types/PutStep.dhall+ dhall-concourse/types/Resource.dhall+ dhall-concourse/types/ResourceType.dhall+ dhall-concourse/types/Step.dhall+ dhall-concourse/types/StepConstructors.dhall+ dhall-concourse/types/StepHooks.dhall+ dhall-concourse/types/TaskCache.dhall+ dhall-concourse/types/TaskConfig.dhall+ dhall-concourse/types/TaskContainerLimits.dhall+ dhall-concourse/types/TaskInput.dhall+ dhall-concourse/types/TaskOutput.dhall+ dhall-concourse/types/TaskRunConfig.dhall+ dhall-concourse/types/TaskSpec.dhall+ dhall-concourse/types/TaskStep.dhall+ dhall-concourse/types/TextTextPair.dhall+ dhall-concourse/utils/resourcesFromJobs.dhall+ test/data/custom-resource-type.dhall+ test/data/in-built-resource-type.dhall+ test/data/resource.dhall++source-repository head+ type: git+ location: https://github.com/akshaymankar/dhall-fly++library+ exposed-modules:+ Fly.Internal.AesonOrphans+ Fly.Internal.DhallOrphans+ Fly.Internal.DhallWithPrefix+ Fly.Types+ Fly.Yaml+ other-modules:+ Paths_dhall_fly+ hs-source-dirs:+ src+ ghc-options: -Wall+ build-depends:+ aeson >=1.4.5.0+ , aeson-casing >=0.2.0.0+ , base >=4.7 && <5+ , dhall >=1.27.0 && <1.28+ , scientific >=0.3.6.2+ , text >=1.2.3.1+ , transformers >=0.5.6.2+ , unordered-containers >=0.2.10.0+ , vector >=0.12.0.3+ default-language: Haskell2010++executable dhall-fly+ main-is: Main.hs+ other-modules:+ Paths_dhall_fly+ hs-source-dirs:+ app+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall+ build-depends:+ aeson >=1.4.5.0+ , aeson-casing >=0.2.0.0+ , aeson-yaml >=1.0.3.0+ , base >=4.7 && <5+ , bytestring >=0.10.8.2+ , dhall >=1.27.0 && <1.28+ , dhall-fly+ , dhall-json >=1.5.0 && <1.6+ , scientific >=0.3.6.2+ , text >=1.2.3.1+ , transformers >=0.5.6.2+ , unordered-containers >=0.2.10.0+ , vector >=0.12.0.3+ default-language: Haskell2010++test-suite dhall-fly-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ Fly.InterpretSpec+ Paths_dhall_fly+ hs-source-dirs:+ test+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-tool-depends:+ hspec-discover:hspec-discover+ build-depends:+ aeson >=1.4.5.0+ , aeson-casing >=0.2.0.0+ , base >=4.7 && <5+ , dhall >=1.27.0 && <1.28+ , dhall-fly+ , hspec+ , scientific >=0.3.6.2+ , text >=1.2.3.1+ , transformers >=0.5.6.2+ , unordered-containers >=0.2.10.0+ , vector >=0.12.0.3+ default-language: Haskell2010
+ src/Fly/Internal/AesonOrphans.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE FlexibleInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Fly.Internal.AesonOrphans where++import Data.Aeson+import Data.HashMap.Strict as M+import Data.Text++instance {-# OVERLAPPING #-} ToJSON (HashMap Text Text) where+ toJSON theMap =+ object (toPairs $ M.toList theMap)+ where toPairs [] = []+ toPairs ((key, value):xs) = (key .= value) : toPairs xs++instance {-# OVERLAPPING #-} ToJSON (HashMap Text (Maybe Text)) where+ toJSON theMap =+ object (toPairs $ M.toList theMap)+ where toPairs [] = []+ toPairs ((key, value):xs) = (key .= value) : toPairs xs++
+ src/Fly/Internal/DhallOrphans.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Fly.Internal.DhallOrphans where++import Data.Aeson+import Data.Scientific (fromFloatDigits)+import Dhall+import Dhall.Core+import Dhall.TH++import qualified Data.Vector as V++instance FromDhall Value where+ autoWith _ = Dhall.Type{..} where+ expected = $(staticDhallExpression "let Prelude = ./dhall-concourse/lib/prelude.dhall in Prelude.JSON.Type")+ extract (Lam _ (Const Dhall.Core.Type)+ (Lam _ _ x)) = extractJSONFromApps x+ extract x = extractJSONFromApps x+ extractJSONFromApps (App (Field (Var (V _ 0)) "bool") (BoolLit b)) = pure $ Data.Aeson.Bool b+ extractJSONFromApps (App (Field (Var (V _ 0)) "string") (TextLit (Chunks _ t))) = pure $ String t+ extractJSONFromApps (App (Field (Var (V _ 0)) "number") (DoubleLit n)) = pure $ Number $ fromFloatDigits $ getDhallDouble n+ extractJSONFromApps (App (Field (Var (V _ 0)) "object") o) = Object <$> Dhall.extract auto o+ extractJSONFromApps (App (Field (Var (V _ 0)) "array") a) = Array . V.fromList <$> Dhall.extract auto a+ extractJSONFromApps (Field (Var (V _ 0)) "null") = pure Null+ extractJSONFromApps t = typeError expected t+
+ src/Fly/Internal/DhallWithPrefix.hs view
@@ -0,0 +1,17 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-}+module Fly.Internal.DhallWithPrefix where++import Control.Monad.Trans.State.Strict+import Data.Aeson+import Data.Aeson.Casing+import Data.Text+import Dhall+import GHC.Generics++newtype FromDhallWithPrefix a = FromDhallWithPrefix a++instance (Generic a, GenericFromDhall (Rep a)) => FromDhall (FromDhallWithPrefix a) where+ autoWith opts =+ let modifier = pack . fieldLabelModifier (aesonPrefix snakeCase) . unpack+ in FromDhallWithPrefix <$> fmap GHC.Generics.to (evalState (genericAutoWith opts{fieldModifier = modifier}) 1)
+ src/Fly/Types.hs view
@@ -0,0 +1,317 @@+{-# LANGUAGE ApplicativeDo #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE UndecidableInstances #-}+module Fly.Types where++import Data.Aeson hiding (Result)+import Data.Aeson.Casing+import Data.Aeson.TH+import Data.HashMap.Strict+import Data.Maybe (fromMaybe)+import Dhall+import Dhall.Core+import Dhall.TH+import Fly.Internal.AesonOrphans ()+import Fly.Internal.DhallOrphans ()+import Fly.Internal.DhallWithPrefix++import qualified Data.HashMap.Strict as M++data CustomResourceType = CustomResourceType { crtName :: Text+ , crtType :: Text+ , crtSource :: Maybe (HashMap Text Value)+ , crtPrivileged :: Maybe Bool+ , crtParams :: Maybe (HashMap Text Value)+ , crtCheckEvery :: Maybe Text+ , crtTags :: Maybe Text+ , crtUniqueVersionHistory :: Maybe Bool+ }+ deriving (Show, Generic, Eq)+ deriving FromDhall via FromDhallWithPrefix CustomResourceType++data ResourceType = ResourceTypeInBuilt Text+ | ResourceTypeCustom CustomResourceType+ deriving (Show, Generic, Eq)++instance FromDhall ResourceType where+ autoWith _ = Dhall.union ( ( ResourceTypeInBuilt <$> constructor "InBuilt" strictText)+ <> ( ResourceTypeCustom <$> constructor "Custom" auto ))++data Resource = Resource { resourceName :: Text+ , resourceType :: ResourceType+ , resourceIcon :: Maybe Text+ , resourcePublic :: Maybe Bool+ , resourceSource :: Maybe (HashMap Text Value)+ , resourceVersion :: Maybe (HashMap Text Text)+ , resourceCheckEvery :: Maybe Text+ , resourceTags :: Maybe [Text]+ , resourceWebhookToken :: Maybe Text}+ deriving (Show, Generic, Eq)+ deriving FromDhall via FromDhallWithPrefix Resource++instance ToJSON Resource where+ toJSON x = case genericToJSON (aesonPrefix snakeCase) x of+ Object m -> Object $ M.insert "type" (resourceTypeValue $ resourceType x) m+ v -> error ("Expected " ++ show v ++ "to be Object")+ where+ resourceTypeValue (ResourceTypeInBuilt t) = String t+ resourceTypeValue (ResourceTypeCustom t) = String $ crtName t++data TaskRunConfig = TaskRunConfig { trcPath :: Text+ , trcArgs :: Maybe [Text]+ , trcDir :: Maybe Text+ , trcUser :: Maybe Text+ }+ deriving (Show, Generic, Eq)+ deriving FromDhall via FromDhallWithPrefix TaskRunConfig++data TaskImageResource = TaskImageResource { tirType :: Text+ , tirSource :: Maybe (HashMap Text Value)+ , tirParams :: Maybe (HashMap Text Value)+ , tirVersion :: Maybe (HashMap Text Text)+ }+ deriving (Show, Generic, Eq)+ deriving FromDhall via FromDhallWithPrefix TaskImageResource++data TaskInput = TaskInput { tiName :: Text+ , tiPath :: Maybe Text+ , tiOptional :: Maybe Bool+ }+ deriving (Show, Generic, Eq)+ deriving FromDhall via FromDhallWithPrefix TaskInput++data TaskOutput = TaskOutput { toName :: Text, toPath :: Maybe Text }+ deriving (Show, Generic, Eq)+ deriving FromDhall via FromDhallWithPrefix TaskOutput++newtype TaskCache = TaskCache { taskcachePath :: Text}+ deriving (Show, Generic, Eq)+ deriving FromDhall via FromDhallWithPrefix TaskCache++data TaskContainerLimits = TaskContainerLimits { tclCpu :: Maybe Natural+ , tclMemory :: Maybe Natural}+ deriving (Show, Generic, Eq)+ deriving FromDhall via FromDhallWithPrefix TaskContainerLimits++data TaskConfig = TaskConfig { tcPlatform :: Text+ , tcRun :: TaskRunConfig+ , tcImageResource :: Maybe TaskImageResource+ , tcRootfsUri :: Maybe Text+ , tcInputs :: Maybe [TaskInput]+ , tcOutputs :: Maybe [TaskOutput]+ , tcCaches :: Maybe [TaskCache]+ , tcParams :: Maybe (HashMap Text (Maybe Text))+ , tcContainerLimits :: Maybe TaskContainerLimits+ }+ deriving (Show, Generic, Eq)+ deriving FromDhall via FromDhallWithPrefix TaskConfig++data TaskSpec = TaskSpecFile Text | TaskSpecConfig TaskConfig+ deriving (Show, Generic, Eq)++instance FromDhall TaskSpec where+ autoWith _ = Dhall.union ((TaskSpecFile <$> constructor "File" strictText)+ <> (TaskSpecConfig <$> constructor "Config" auto))++instance ToJSON TaskSpec where+ toJSON (TaskSpecFile f) = object [ "file" .= f ]+ toJSON (TaskSpecConfig c) = object [ "config" .= c ]++data GetVersion = GetVersionLatest+ | GetVersionEvery+ | GetVersionSpecific (HashMap Text Text)+ deriving (Show, Generic, Eq)++instance ToJSON GetVersion where+ toJSON GetVersionLatest = String "latest"+ toJSON GetVersionEvery = String "every"+ toJSON (GetVersionSpecific v) = toJSON v++instance FromDhall GetVersion where+ autoWith _ = Dhall.union ((GetVersionLatest <$ constructor "Latest" strictText)+ <> (GetVersionEvery <$ constructor "Every" strictText)+ <> (GetVersionSpecific <$> constructor "SpecificVersion" auto))++data GetStep = GetStep { getGet :: Maybe Text+ , getResource :: Resource+ , getParams :: Maybe (HashMap Text Value)+ , getVersion :: Maybe GetVersion+ , getPassed :: Maybe [Text]+ , getTrigger :: Maybe Bool+ , getTags :: Maybe [Text]+ , getTimeout :: Maybe Text+ , getAttempts :: Maybe Natural+ }+ deriving (Show, Generic, Eq)+ deriving FromDhall via FromDhallWithPrefix GetStep++instance ToJSON GetStep where+ toJSON GetStep{..} = object [ "get" .= fromMaybe (resourceName getResource) getGet+ , "resource" .= toJSON (resourceName getResource <$ getGet)+ , "params" .= getParams+ , "version" .= getVersion+ , "passed" .= getPassed+ , "trigger" .= getTrigger+ , "tags" .= getTags+ , "timeout" .= getTimeout+ , "attempts" .= getAttempts+ ]++data PutStep = PutStep { putPut :: Maybe Text+ , putResource :: Resource+ , putParams :: Maybe (HashMap Text Value)+ , putGetParams :: Maybe (HashMap Text Value)+ , putTags :: Maybe [Text]+ , putTimeout :: Maybe Text+ , putAttempts :: Maybe Natural+ }+ deriving (Show, Generic, Eq)+ deriving FromDhall via FromDhallWithPrefix PutStep++instance ToJSON PutStep where+ toJSON PutStep{..} = object [ "put" .= fromMaybe (resourceName putResource) putPut+ , "resource" .= toJSON (resourceName putResource <$ putPut)+ , "params" .= putParams+ , "get_params" .= putGetParams+ ]++data TaskStep = TaskStep { taskTask :: Text+ , taskConfig :: TaskSpec+ , taskPrivileged :: Maybe Bool+ , taskParams :: Maybe (HashMap Text Text)+ , taskImage :: Maybe Text+ , taskInputMapping :: Maybe (HashMap Text Text)+ , taskOutputMapping :: Maybe (HashMap Text Text)+ }+ deriving (Show, Generic, Eq)+ deriving FromDhall via FromDhallWithPrefix TaskStep++instance ToJSON TaskStep where+ toJSON t@TaskStep{..} =+ case genericToJSON (aesonPrefix snakeCase) t of+ Object o1 ->+ case toJSON taskConfig of+ Object o2 -> Object (M.delete "config" o1 `M.union` o2)+ v -> error ("Expected " ++ show v ++ "to be Object")+ v -> error ("Expected " ++ show v ++ "to be Object")++data InParallelStep = InParallelSteps {ipSteps :: [Step]}+ | InParallelStepConfig {ipConfig :: InParallelConfig}+ deriving (Show, Generic, Eq)++inParallelSteps :: InParallelStep -> [Step]+inParallelSteps (InParallelSteps steps ) = steps+inParallelSteps (InParallelStepConfig InParallelConfig{..}) = ipcSteps++instance ToJSON InParallelStep where+ toJSON (InParallelSteps steps) = toJSON steps+ toJSON (InParallelStepConfig cfg) = toJSON cfg++instance FromDhall InParallelStep where+ autoWith _ = Dhall.union ((InParallelSteps <$> constructor "Steps" auto)+ <> (InParallelStepConfig <$> constructor "Config" auto))++data InParallelConfig = InParallelConfig { ipcSteps :: [Step]+ , ipcLimit :: Maybe Natural+ , ipcFailFast :: Maybe Bool+ }+ deriving (Show, Generic, Eq)+ deriving FromDhall via FromDhallWithPrefix InParallelConfig++data Step = Get { stepGet :: GetStep, stepHooks :: StepHooks }+ | Put { stepPut :: PutStep, stepHooks :: StepHooks }+ | Task { stepTask :: TaskStep, stepHooks :: StepHooks }+ | Aggregate { aggregatedSteps :: [Step], stepHooks :: StepHooks }+ | InParallel { stepInParallel :: InParallelStep, stepHooks :: StepHooks }+ | Do { doSteps :: [Step], stepHooks :: StepHooks }+ | Try { tryStep :: Step, stepHooks :: StepHooks }+ deriving (Show, Generic, Eq)++instance FromDhall Step where+ autoWith _ = Dhall.Type{..} where+ expected = $(staticDhallExpression "./dhall-concourse/types/Step.dhall")+ extract (Lam _ _ --Step+ (Lam _ _ --Constructors+ c)) = extractStepFromConstructors c+ extract x = extractStepFromConstructors x -- While recursing, only the constructor applications are available+ extractStepFromConstructors (App (App (Field (Var (V _ 0)) "get") s) hooks) = buildStep Get s hooks+ extractStepFromConstructors (App (App (Field (Var (V _ 0)) "put") s) hooks) = buildStep Put s hooks+ extractStepFromConstructors (App (App (Field (Var (V _ 0)) "task") s) hooks) = buildStep Task s hooks+ extractStepFromConstructors (App (App (Field (Var (V _ 0)) "aggregate") s) hooks) = buildStep Aggregate s hooks+ extractStepFromConstructors (App (App (Field (Var (V _ 0)) "do") s) hooks) = buildStep Do s hooks+ extractStepFromConstructors (App (App (Field (Var (V _ 0)) "try") s) hooks) = buildStep Try s hooks+ extractStepFromConstructors (App (App (Field (Var (V _ 0)) "in_parallel")+ (App (Field (Union _) "Steps") s)) hooks) = buildStep (InParallel . InParallelSteps ) s hooks+ extractStepFromConstructors (App (App (Field (Var (V _ 0)) "in_parallel")+ (App (Field (Union _) "Config") s)) hooks) = buildStep (InParallel . InParallelStepConfig ) s hooks+ extractStepFromConstructors t = typeError expected t+ buildStep f x y = f <$> Dhall.extract auto x <*> Dhall.extract auto y++mergeHooks :: ToJSON a => a -> StepHooks -> Value+mergeHooks step hooks = case toJSON step of+ Object o1 -> case toJSON hooks of+ Object o2 -> Object (o1 `M.union` o2)+ v -> error ("Expected " ++ show v ++ "to be Object")+ v -> error ("Expected " ++ show v ++ "to be Object")++instance ToJSON Step where+ toJSON (Get g h) = mergeHooks g h+ toJSON (Put p h) = mergeHooks p h+ toJSON (Task t h) = mergeHooks t h+ toJSON (Aggregate steps h) = mergeHooks (object ["aggregate" .= steps]) h+ toJSON (Do steps h) = mergeHooks (object ["do" .= steps]) h+ toJSON (Try step h) = mergeHooks (object ["try" .= step]) h+ toJSON (InParallel cfg h) = mergeHooks (object ["in_parallel" .= cfg]) h++data StepHooks = StepHooks { hookOnSuccess :: Maybe Step+ , hookOnFailure :: Maybe Step+ , hookOnAbort :: Maybe Step+ , hookEnsure :: Maybe Step+ }+ deriving (Show, Generic, Eq)+ deriving FromDhall via FromDhallWithPrefix StepHooks++data JobBuildLogRetention = JobBuildLogRetention { jblrDays :: Maybe Natural+ , jblrBuilds :: Maybe Natural+ }+ deriving (Show, Generic, Eq)+ deriving FromDhall via FromDhallWithPrefix JobBuildLogRetention++data Job = Job { jobName :: Text+ , jobOldName :: Maybe Text+ , jobPlan :: [Step]+ , jobSerial :: Maybe Bool+ , jobBuildLogRetention :: Maybe JobBuildLogRetention+ , jobBuildLogsToRetain :: Maybe Natural+ , jobSerialGroups :: Maybe [Text]+ , jobMaxInFlight :: Maybe Natural+ , jobPublic :: Maybe Bool+ , jobDisableManualTrigger :: Maybe Bool+ , jobInterruptible :: Maybe Bool+ , jobOnSuccess :: Maybe Step+ , jobOnFailure :: Maybe Step+ , jobOnAbort :: Maybe Step+ , jobEnsure :: Maybe Step+ }+ deriving (Show, Generic, Eq)+ deriving FromDhall via FromDhallWithPrefix Job++$(deriveToJSON (aesonPrefix snakeCase) ''CustomResourceType)+$(deriveToJSON (aesonPrefix snakeCase){sumEncoding = UntaggedValue} ''ResourceType)+$(deriveToJSON (aesonPrefix snakeCase) ''TaskRunConfig)+$(deriveToJSON (aesonPrefix snakeCase) ''TaskImageResource)+$(deriveToJSON (aesonPrefix snakeCase) ''TaskInput)+$(deriveToJSON (aesonPrefix snakeCase) ''TaskOutput)+$(deriveToJSON (aesonPrefix snakeCase) ''TaskCache)+$(deriveToJSON (aesonPrefix snakeCase) ''TaskConfig)+$(deriveToJSON (aesonPrefix snakeCase) ''TaskContainerLimits)+$(deriveToJSON (aesonPrefix snakeCase) ''InParallelConfig)+$(deriveToJSON (aesonPrefix snakeCase) ''StepHooks)+$(deriveToJSON (aesonPrefix snakeCase) ''JobBuildLogRetention)+$(deriveToJSON (aesonPrefix snakeCase) ''Job)
+ src/Fly/Yaml.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+module Fly.Yaml where++import Data.Aeson+import Data.List (nub)+import Data.Maybe (catMaybes)+import Fly.Types++customResourceTypes :: [ResourceType] -> [ResourceType]+customResourceTypes [] = []+customResourceTypes (ResourceTypeInBuilt _ : rts) = customResourceTypes rts+customResourceTypes (x : rts) = x : customResourceTypes rts++getResourcesFromHooks :: StepHooks -> [Resource]+getResourcesFromHooks StepHooks{..} =+ concatMap getResourcesFromStep+ $ catMaybes [hookOnSuccess, hookOnFailure, hookOnAbort, hookEnsure]++getResourcesFromStep :: Step -> [Resource]+getResourcesFromStep s =+ stepResources s ++ getResourcesFromHooks (Fly.Types.stepHooks s)+ where+ stepResources (Get GetStep{..} _) = [getResource]+ stepResources (Put PutStep{..} _) = [putResource]+ stepResources (Task _ _) = []+ stepResources (Aggregate steps _) = getResourcesFromSteps steps+ stepResources (Do steps _) = getResourcesFromSteps steps+ stepResources (Try step _) = getResourcesFromStep step+ stepResources (InParallel inParallel _) =+ getResourcesFromSteps $ inParallelSteps inParallel++getResourcesFromSteps :: [Step] -> [Resource]+getResourcesFromSteps = concatMap getResourcesFromStep++getResourcesFromJob :: Job -> [Resource]+getResourcesFromJob Job{..} =+ getResourcesFromSteps+ $ jobPlan ++ catMaybes [ jobOnSuccess, jobOnFailure, jobOnAbort, jobEnsure ]++dhallToYaml :: [Job] -> Value+dhallToYaml jobs =+ let resources = nub $ concatMap getResourcesFromJob jobs+ resourceTypes = nub $ customResourceTypes $ map Fly.Types.resourceType resources+ in object [ "resource_types" .= resourceTypes+ , "resources" .= resources+ , "jobs" .= jobs+ ]
+ test/Fly/InterpretSpec.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE ExtendedDefaultRules #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+module Fly.InterpretSpec where++import Test.Hspec++import Data.Aeson+import Data.HashMap.Strict+import Dhall+import Fly.Types++spec :: Spec+spec = do+ describe "Fly.Interpret" $ do+ describe "Interpret ResourceType" $ do+ it "should interpret in built resource type" $ do+ resourceType <- input auto "./test/data/in-built-resource-type.dhall"+ resourceType `shouldBe` ResourceTypeInBuilt "git"++ it "should interpret custom resource type" $ do+ resourceType <- input auto "./test/data/custom-resource-type.dhall"+ resourceType `shouldBe` boshDeploymentResourceType++ describe "Interpret Resource" $ do+ it "should interpret a git resource" $ do+ resource <- input auto "./test/data/resource.dhall"+ resource `shouldBe` gitKuboCI++ describe "Interpret TaskConfig" $ do+ it "should interpret a File task" $ do+ task <- input auto "./dhall-concourse/defaults/TaskConfig.dhall"+ task `shouldBe` defaultTaskConfig++boshDeploymentResourceType = ResourceTypeCustom (CustomResourceType{..}) where+ crtName = "bosh-deployment"+ crtType = "docker-image"+ crtSource = pure $ fromList [ ("repository", String "cloudfoundry/bosh-deployment-resource")+ , ("tag", String "latest")+ ]+ crtPrivileged = Nothing+ crtParams = Nothing+ crtCheckEvery = Nothing+ crtTags = Nothing+ crtUniqueVersionHistory = Nothing++gitKuboCI = Resource{..} where+ resourceName = "git-kubo-ci"+ resourceType = ResourceTypeInBuilt "git"+ resourceCheckEvery = Nothing+ resourceParams = Nothing+ resourceSource = Just $ fromList [ "privateKey" .= "((git-ssh-key.private_key))"+ , "uri" .= "git@github.com:cloudfoundry-incubator/kubo-ci"+ , "branch" .= "master"+ ]+ resourceTags = Nothing+ resourceVersion = Nothing+ resourceWebhookToken = Nothing+ resourceIcon = Nothing+ resourcePublic = Nothing++defaultTaskRunConfig = TaskRunConfig{..} where+ trcPath = "CHANGEME"+ trcArgs = Nothing+ trcDir = Nothing+ trcUser = Nothing++defaultTaskConfig = TaskConfig{..} where+ tcPlatform = "linux"+ tcRun = defaultTaskRunConfig+ tcCaches = Nothing+ tcImageResource = Nothing+ tcInputs = Nothing+ tcOutputs = Nothing+ tcParams = Nothing+ tcRootfsUri = Nothing+ tcContainerLimits = Nothing
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ test/data/custom-resource-type.dhall view
@@ -0,0 +1,19 @@+let Concourse = ../../dhall-concourse/package.dhall++let Prelude = ../../dhall-concourse/lib/prelude.dhall++let JSON = Prelude.JSON++in Concourse.Types.ResourceType.Custom+ Concourse.schemas.CustomResourceType::{+ , name = "bosh-deployment"+ , type = "docker-image"+ , source =+ Some+ ( toMap+ { repository =+ JSON.string "cloudfoundry/bosh-deployment-resource"+ , tag = JSON.string "latest"+ }+ )+ }
+ test/data/in-built-resource-type.dhall view
@@ -0,0 +1,3 @@+let Concourse = ../../dhall-concourse/package.dhall++in Concourse.Types.ResourceType.InBuilt "git"
+ test/data/resource.dhall view
@@ -0,0 +1,19 @@+let Concourse = ../../dhall-concourse/package.dhall++let Prelude = ../../dhall-concourse/lib/prelude.dhall++let JSON = Prelude.JSON++in Concourse.schemas.Resource::{+ , name = "git-kubo-ci"+ , type = ./in-built-resource-type.dhall+ , source =+ Some+ ( toMap+ { privateKey = JSON.string "((git-ssh-key.private_key))"+ , uri =+ JSON.string "git@github.com:cloudfoundry-incubator/kubo-ci"+ , branch = JSON.string "master"+ }+ )+ }