diff --git a/JSON/Format.dhall b/JSON/Format.dhall new file mode 100644 index 0000000..649600b --- /dev/null +++ b/JSON/Format.dhall @@ -0,0 +1,7 @@ +{-| +An internal type used by `./renderAs` to select the output format. + +You should not need to use this type directly, simply use `./render` +or `./renderYAML` as appropriate. +-} +< YAML | JSON > diff --git a/JSON/Nesting.dhall b/JSON/Nesting.dhall new file mode 100644 index 0000000..b371f73 --- /dev/null +++ b/JSON/Nesting.dhall @@ -0,0 +1,35 @@ +{-| +This type is used as part of `dhall-json`'s support for preserving alternative +names + +For example, this Dhall code: + +``` +let Example = < Left : { foo : Natural } | Right : { bar : Bool } > + +let Nesting = < Inline | Nested : Text > + +in { field = + "name" + , nesting = + Nesting.Inline + , contents = + Example.Left { foo = 2 } + } +``` + +... generates this JSON: + +``` +{ + "foo": 2, + "name": "Left" +} +``` + +-} +let Nesting + : Type + = < Inline | Nested : Text > + +in Nesting diff --git a/JSON/Tagged.dhall b/JSON/Tagged.dhall new file mode 100644 index 0000000..9576d46 --- /dev/null +++ b/JSON/Tagged.dhall @@ -0,0 +1,67 @@ +{-| +This is a convenient type-level function when using `dhall-to-json`'s support +for preserving alternative names + +For example, this code: + +``` +let map = ../List/map + +let Provisioner = + < shell : + { inline : List Text } + | file : + { source : Text, destination : Text } + > + +let Tagged = ./Tagged + +let Nesting = ./Nesting + +let wrap + : Provisioner → Tagged Provisioner + = λ(x : Provisioner) → + { field = "type", nesting = Nesting.Nested "params", contents = x } + +in { provisioners = + map + Provisioner + (Tagged Provisioner) + wrap + [ Provisioner.shell { inline = [ "echo foo" ] } + , Provisioner.file + { source = "app.tar.gz", destination = "/tmp/app.tar.gz" } + ] + } +``` + +... produces this JSON: + +``` +{ + "provisioners": [ + { + "params": { + "inline": [ + "echo foo" + ] + }, + "type": "shell" + }, + { + "params": { + "destination": "/tmp/app.tar.gz", + "source": "app.tar.gz" + }, + "type": "file" + } + ] +} +``` + +-} +let Tagged + : Type → Type + = λ(a : Type) → { field : Text, nesting : ./Nesting.dhall, contents : a } + +in Tagged diff --git a/JSON/Type.dhall b/JSON/Type.dhall new file mode 100644 index 0000000..83caf24 --- /dev/null +++ b/JSON/Type.dhall @@ -0,0 +1,63 @@ +{-| +Dhall encoding of an arbitrary JSON value + +For example, the following JSON value: + +``` +[ { "foo": null, "bar": [ 1.0, true ] } ] +``` + +... corresponds to the following Dhall expression: + +``` +λ(JSON : Type) → +λ ( json + : { array : List JSON → JSON + , bool : Bool → JSON + , null : JSON + , double : Double → JSON + , integer : Integer → JSON + , object : List { mapKey : Text, mapValue : JSON } → JSON + , string : Text → JSON + } + ) → + json.object + [ { mapKey = "foo", mapValue = json.null } + , { mapKey = "bar" + , mapValue = json.array [ json.double 1.0, json.bool True ] + } + ] +``` + + You do not need to create these values directly, though. You can use + the utilities exported by `./package.dhall` to create values of this type, + such as: + +``` +let JSON = ./package.dhall + +in JSON.object + [ { mapKey = "foo", mapValue = JSON.null } + , { mapKey = "bar" + , mapValue = JSON.array [ JSON.double 1.0, JSON.bool True ] + } + ] +``` + +-} +let JSON/Type + : Type + = ∀(JSON : Type) → + ∀ ( json + : { array : List JSON → JSON + , bool : Bool → JSON + , double : Double → JSON + , integer : Integer → JSON + , null : JSON + , object : List { mapKey : Text, mapValue : JSON } → JSON + , string : Text → JSON + } + ) → + JSON + +in JSON/Type diff --git a/JSON/array.dhall b/JSON/array.dhall new file mode 100644 index 0000000..3ad7bc7 --- /dev/null +++ b/JSON/array.dhall @@ -0,0 +1,35 @@ +{-| +Create a JSON array from a `List` of JSON values + +``` +let JSON = ./package.dhall +in JSON.render (JSON.array [ JSON.double 1.0, JSON.bool True ]) += "[ 1.0, true ]" + +let JSON/Type = ./Type +let JSON = ./package.dhall +in JSON.render (JSON.array ([] : List JSON/Type)) += "[ ]" +``` +-} +let JSON = ./Type.dhall + +let List/map = ../List/map.dhall + +let array + : List JSON → JSON + = λ(x : List JSON) → + λ(JSON : Type) → + λ ( json + : { array : List JSON → JSON + , bool : Bool → JSON + , double : Double → JSON + , integer : Integer → JSON + , null : JSON + , object : List { mapKey : Text, mapValue : JSON } → JSON + , string : Text → JSON + } + ) → + json.array (List/map JSON@1 JSON (λ(j : JSON@1) → j JSON json) x) + +in array diff --git a/JSON/bool.dhall b/JSON/bool.dhall new file mode 100644 index 0000000..de45b0c --- /dev/null +++ b/JSON/bool.dhall @@ -0,0 +1,32 @@ +{-| +Create a JSON bool from a Dhall `Bool` + +``` +let JSON = ./package.dhall +in JSON.render (JSON.bool True) += "true" + +let JSON = ./package.dhall +in JSON.render (JSON.bool False) += "false" +``` +-} +let JSON = ./Type.dhall + +let bool + : Bool → JSON + = λ(x : Bool) → + λ(JSON : Type) → + λ ( json + : { array : List JSON → JSON + , bool : Bool → JSON + , double : Double → JSON + , integer : Integer → JSON + , null : JSON + , object : List { mapKey : Text, mapValue : JSON } → JSON + , string : Text → JSON + } + ) → + json.bool x + +in bool diff --git a/JSON/core.dhall b/JSON/core.dhall new file mode 100644 index 0000000..77c1fd8 --- /dev/null +++ b/JSON/core.dhall @@ -0,0 +1,25 @@ +{-| +A record of functions useful for constructing `JSON` values. + +This is only a subset of what `package.dhall` exports. If you are not writing a +JSON prelude function, you should use the `package.dhall` file instead. + +It is used internally by `render`, `renderYAML` and `omitNullFields` instead of +`package.dhall` to avoid import cycles. +-} +{ Type = ./Type.dhall +, Tagged = ./Tagged.dhall +, Nesting = ./Nesting.dhall +, keyText = ./keyText.dhall +, keyValue = ./keyValue.dhall +, string = ./string.dhall +, number = ./number.dhall +, double = ./double.dhall +, integer = ./integer.dhall +, natural = ./natural.dhall +, object = ./object.dhall +, array = ./array.dhall +, bool = ./bool.dhall +, null = ./null.dhall +, renderInteger = ./renderInteger.dhall +} diff --git a/JSON/double.dhall b/JSON/double.dhall new file mode 100644 index 0000000..5c0c8f3 --- /dev/null +++ b/JSON/double.dhall @@ -0,0 +1,32 @@ +{-| +Create a JSON number from a Dhall `Double` + +``` +let JSON = ./package.dhall +in JSON.render (JSON.double 42.0) += "42.0" + +let JSON = ./package.dhall +in JSON.render (JSON.double -1.5e-10) += "-1.5e-10" +``` +-} +let JSON = ./Type.dhall + +let double + : Double → JSON + = λ(x : Double) → + λ(JSON : Type) → + λ ( json + : { array : List JSON → JSON + , bool : Bool → JSON + , double : Double → JSON + , integer : Integer → JSON + , null : JSON + , object : List { mapKey : Text, mapValue : JSON } → JSON + , string : Text → JSON + } + ) → + json.double x + +in double diff --git a/JSON/integer.dhall b/JSON/integer.dhall new file mode 100644 index 0000000..2aaa3bd --- /dev/null +++ b/JSON/integer.dhall @@ -0,0 +1,32 @@ +{-| +Create a JSON number from a Dhall `Integer` + +``` +let JSON = ./package.dhall +in JSON.render (JSON.integer -1) += "-1" + +let JSON = ./package.dhall +in JSON.render (JSON.integer +2) += "+2" +``` +-} +let JSON = ./Type.dhall + +let integer + : Integer → JSON + = λ(x : Integer) → + λ(JSON : Type) → + λ ( json + : { array : List JSON → JSON + , bool : Bool → JSON + , double : Double → JSON + , integer : Integer → JSON + , null : JSON + , object : List { mapKey : Text, mapValue : JSON } → JSON + , string : Text → JSON + } + ) → + json.integer x + +in integer diff --git a/JSON/keyText.dhall b/JSON/keyText.dhall new file mode 100644 index 0000000..170a41e --- /dev/null +++ b/JSON/keyText.dhall @@ -0,0 +1 @@ +../Map/keyText.dhall diff --git a/JSON/keyValue.dhall b/JSON/keyValue.dhall new file mode 100644 index 0000000..81f1a24 --- /dev/null +++ b/JSON/keyValue.dhall @@ -0,0 +1 @@ +../Map/keyValue.dhall diff --git a/JSON/natural.dhall b/JSON/natural.dhall new file mode 100644 index 0000000..18680c8 --- /dev/null +++ b/JSON/natural.dhall @@ -0,0 +1,28 @@ +{-| +Create a JSON number from a Dhall `Natural` + +``` +let JSON = ./package.dhall +in JSON.render (JSON.natural 42) += "42" +``` +-} +let JSON = ./Type.dhall + +let natural + : Natural → JSON + = λ(x : Natural) → + λ(JSON : Type) → + λ ( json + : { array : List JSON → JSON + , bool : Bool → JSON + , double : Double → JSON + , integer : Integer → JSON + , null : JSON + , object : List { mapKey : Text, mapValue : JSON } → JSON + , string : Text → JSON + } + ) → + json.integer (Natural/toInteger x) + +in natural diff --git a/JSON/null.dhall b/JSON/null.dhall new file mode 100644 index 0000000..d25198c --- /dev/null +++ b/JSON/null.dhall @@ -0,0 +1,27 @@ +{-| +Create a JSON null + +``` +let JSON = ./package.dhall +in JSON.render JSON.null += "null" +``` +-} +let JSON = ./Type.dhall + +let null + : JSON + = λ(JSON : Type) → + λ ( json + : { array : List JSON → JSON + , bool : Bool → JSON + , double : Double → JSON + , integer : Integer → JSON + , null : JSON + , object : List { mapKey : Text, mapValue : JSON } → JSON + , string : Text → JSON + } + ) → + json.null + +in null diff --git a/JSON/number.dhall b/JSON/number.dhall new file mode 100644 index 0000000..a940106 --- /dev/null +++ b/JSON/number.dhall @@ -0,0 +1,22 @@ +{-| +Create a JSON number from a Dhall `Double` + +``` +let JSON = ./package.dhall +in JSON.render (JSON.number 42.0) += "42.0" + +let JSON = ./package.dhall +in JSON.render (JSON.number -1.5e-10) += "-1.5e-10" +``` +-} +let JSON = ./Type.dhall + +let double = ./double.dhall + +let number + : Double → JSON + = double + +in number diff --git a/JSON/object.dhall b/JSON/object.dhall new file mode 100644 index 0000000..d945e96 --- /dev/null +++ b/JSON/object.dhall @@ -0,0 +1,49 @@ +{-| +Create a JSON object from a Dhall `Map` + +``` +let JSON = ./package.dhall +in JSON.render + ( JSON.object + [ { mapKey = "foo", mapValue = JSON.double 1.0 } + , { mapKey = "bar", mapValue = JSON.bool True } + ] + ) += "{ \"foo\": 1.0, \"bar\": true }" + +let JSON/Type = ./Type +let JSON = ./package.dhall +in JSON.render + (JSON.object ([] : List { mapKey : Text, mapValue : JSON/Type })) += "{ }" +``` +-} +let JSON = ./Type.dhall + +let List/map = ../List/map.dhall + +let object + : List { mapKey : Text, mapValue : JSON } → JSON + = λ(x : List { mapKey : Text, mapValue : JSON }) → + λ(JSON : Type) → + λ ( json + : { array : List JSON → JSON + , bool : Bool → JSON + , double : Double → JSON + , integer : Integer → JSON + , null : JSON + , object : List { mapKey : Text, mapValue : JSON } → JSON + , string : Text → JSON + } + ) → + json.object + ( List/map + { mapKey : Text, mapValue : JSON@1 } + { mapKey : Text, mapValue : JSON } + ( λ(kv : { mapKey : Text, mapValue : JSON@1 }) → + { mapKey = kv.mapKey, mapValue = kv.mapValue JSON json } + ) + x + ) + +in object diff --git a/JSON/omitNullFields.dhall b/JSON/omitNullFields.dhall new file mode 100644 index 0000000..b0be24e --- /dev/null +++ b/JSON/omitNullFields.dhall @@ -0,0 +1,136 @@ +{-| +This utility omits all `null` record fields, which is often the idiomatic way +for a configuration to encode absent fields +-} +let JSON = ./core.dhall + +let List/concatMap = ../List/concatMap.dhall + +let List/map = ../List/map.dhall + +let omitNullFields + : JSON.Type → JSON.Type + = λ(old : JSON.Type) → + λ(JSON : Type) → + λ ( json + : { array : List JSON → JSON + , bool : Bool → JSON + , double : Double → JSON + , integer : Integer → JSON + , null : JSON + , object : List { mapKey : Text, mapValue : JSON } → JSON + , string : Text → JSON + } + ) → + let result = + old + { value : JSON, isNull : Bool } + { string = + λ(x : Text) → { value = json.string x, isNull = False } + , double = + λ(x : Double) → { value = json.double x, isNull = False } + , integer = + λ(x : Integer) → { value = json.integer x, isNull = False } + , object = + λ ( keyValues + : List + { mapKey : Text + , mapValue : { value : JSON, isNull : Bool } + } + ) → + let value = + json.object + ( List/concatMap + { mapKey : Text + , mapValue : { value : JSON, isNull : Bool } + } + { mapKey : Text, mapValue : JSON } + ( λ ( keyValue + : { mapKey : Text + , mapValue : + { value : JSON, isNull : Bool } + } + ) → + if keyValue.mapValue.isNull + then [] : List + { mapKey : Text + , mapValue : JSON + } + else [ keyValue.{ mapKey } + ∧ { mapValue = + keyValue.mapValue.value + } + ] + ) + keyValues + ) + + in { value, isNull = False } + , array = + λ(xs : List { value : JSON, isNull : Bool }) → + let value = + json.array + ( List/map + { value : JSON, isNull : Bool } + JSON + ( λ(x : { value : JSON, isNull : Bool }) → + x.value + ) + xs + ) + + in { value, isNull = False } + , bool = λ(x : Bool) → { value = json.bool x, isNull = False } + , null = { value = json.null, isNull = True } + } + + in result.value + +let property = + λ(a : Text) → + λ(b : Double) → + λ(c : Bool) → + assert + : omitNullFields + ( JSON.object + ( toMap + { string = JSON.string a + , double = JSON.double b + , bool = JSON.bool c + , null = JSON.null + } + ) + ) + ≡ JSON.object + ( toMap + { string = JSON.string a + , double = JSON.double b + , bool = JSON.bool c + } + ) + +let example = + assert + : omitNullFields + ( JSON.object + ( toMap + { array = + JSON.array [ JSON.object (toMap { null = JSON.null }) ] + } + ) + ) + ≡ JSON.object + ( toMap + { array = + JSON.array + [ JSON.object + ([] : List { mapKey : Text, mapValue : JSON.Type }) + ] + } + ) + +let example = + assert + : omitNullFields (JSON.array [ JSON.null ]) ≡ JSON.array [ JSON.null ] + +in omitNullFields diff --git a/JSON/package.dhall b/JSON/package.dhall new file mode 100644 index 0000000..d7c3139 --- /dev/null +++ b/JSON/package.dhall @@ -0,0 +1,9 @@ +λ(nix : ../NixPrelude.dhall) → + { render = ./render.dhall nix + , renderCompact = ./renderCompact.dhall + , renderYAML = ./renderYAML.dhall nix + , omitNullFields = ./omitNullFields.dhall + , tagInline = ./tagInline.dhall + , tagNested = ./tagNested.dhall + } + ∧ ./core.dhall diff --git a/JSON/render.dhall b/JSON/render.dhall new file mode 100644 index 0000000..de45c78 --- /dev/null +++ b/JSON/render.dhall @@ -0,0 +1,12 @@ +λ(nix : ../NixPrelude.dhall) → + let JSON = ./core.dhall + + let Format = ./Format.dhall + + let renderAs = ./renderAs.dhall nix + + let render + : JSON.Type → Text + = renderAs Format.JSON + + in render diff --git a/JSON/renderAs.dhall b/JSON/renderAs.dhall new file mode 100644 index 0000000..12f0855 --- /dev/null +++ b/JSON/renderAs.dhall @@ -0,0 +1,298 @@ +--| Render a `JSON` value as `Text` in either JSON or YAML format. +λ(nix : ../NixPrelude.dhall) → + let JSON = ./core.dhall + + let Function/identity = ../Function/identity.dhall + + let Text/concatMap = ../Text/concatMap.dhall + + let List/map = ../List/map.dhall + + let NonEmpty = ../NonEmpty/Type.dhall + + let NonEmpty/toList = ../NonEmpty/toList.dhall + + let NonEmpty/concat = ../NonEmpty/concat.dhall + + let NonEmpty/map = ../NonEmpty/map.dhall + + let NonEmpty/singleton = ../NonEmpty/singleton.dhall + + let Optional/fold = ../Optional/fold.dhall nix + + let List/uncons + : ∀(a : Type) → List a → Optional (NonEmpty a) + = {- This version uses the `ls` argument only once to prevent cache blowups at the price + of performing two passes over the list: + A first one to reverse it, a second one with `List/fold` to determine + the head element. + See https://github.com/dhall-lang/dhall-lang/pull/1015#issuecomment-633381024 + for some context regarding the caching issue. + -} + λ(a : Type) → + λ(ls : List a) → + List/fold + a + (List/reverse a ls) + (Optional (NonEmpty a)) + ( λ(x : a) → + λ(acc : Optional (NonEmpty a)) → + Optional/fold + (NonEmpty a) + acc + (Optional (NonEmpty a)) + (λ(ne : NonEmpty a) → Some (ne ⫽ { tail = ne.tail # [ x ] })) + (Some (NonEmpty/singleton a x)) + ) + (None (NonEmpty a)) + + let NonEmpty/mapHead + : ∀(a : Type) → (a → a) → NonEmpty a → NonEmpty a + = λ(a : Type) → + λ(fn : a → a) → + λ(ls : NonEmpty a) → + ls ⫽ { head = fn ls.head } + + let NonEmpty/mapTail + : ∀(a : Type) → (a → a) → NonEmpty a → NonEmpty a + = λ(a : Type) → + λ(fn : a → a) → + λ(ls : NonEmpty a) → + ls ⫽ { tail = List/map a a fn ls.tail } + + let NonEmpty/prepend + : ∀(a : Type) → a → NonEmpty a → NonEmpty a + = λ(a : Type) → + λ(prefix : a) → + λ(ls : NonEmpty a) → + { head = prefix, tail = NonEmpty/toList a ls } + + let NonYtpme + : Type → Type + = λ(a : Type) → { init : List a, last : a } + + let List/unsnoc + : ∀(a : Type) → List a → Optional (NonYtpme a) + = λ(a : Type) → + λ(ls : List a) → + List/fold + a + ls + (Optional (NonYtpme a)) + ( λ(x : a) → + λ(acc : Optional (NonYtpme a)) → + Optional/fold + (NonYtpme a) + acc + (Optional (NonYtpme a)) + (λ(ny : NonYtpme a) → Some (ny ⫽ { init = [ x ] # ny.init })) + (Some { init = [] : List a, last = x }) + ) + (None (NonYtpme a)) + + let NonEmpty/mapLast + : ∀(a : Type) → (a → a) → NonEmpty a → NonEmpty a + = λ(a : Type) → + λ(fn : a → a) → + λ(ls : NonEmpty a) → + Optional/fold + (NonYtpme a) + (List/unsnoc a ls.tail) + (NonEmpty a) + (λ(x : NonYtpme a) → ls ⫽ { tail = x.init # [ fn x.last ] }) + (NonEmpty/singleton a (fn ls.head)) + + let NonEmpty/mapLeading + : ∀(a : Type) → (a → a) → NonEmpty a → NonEmpty a + = λ(a : Type) → + λ(fn : a → a) → + λ(ls : NonEmpty a) → + Optional/fold + (NonYtpme a) + (List/unsnoc a ls.tail) + (NonEmpty a) + ( λ(x : NonYtpme a) → + { head = fn ls.head + , tail = List/map a a fn x.init # [ x.last ] + } + ) + ls + + let Lines + : Type + = NonEmpty Text + + let Block + : Type + = < Simple : Text | Complex : Lines > + + let Block/toLines + : Block → Lines + = λ(block : Block) → + merge + { Simple = NonEmpty/singleton Text + , Complex = Function/identity Lines + } + block + + let manyBlocks + : ∀(a : Type) → Text → (NonEmpty a → Lines) → List a → Block + = λ(a : Type) → + λ(ifEmpty : Text) → + λ(render : NonEmpty a → Lines) → + λ(inputs : List a) → + Optional/fold + (NonEmpty a) + (List/uncons a inputs) + Block + (λ(inputs : NonEmpty a) → Block.Complex (render inputs)) + (Block.Simple ifEmpty) + + let blockToText + : Block → Text + = λ(block : Block) → + Text/concatMap + Text + (λ(line : Text) → line ++ "\n") + (NonEmpty/toList Text (Block/toLines block)) + + let addPrefix = λ(prefix : Text) → λ(line : Text) → prefix ++ line + + let addIndent = addPrefix " " + + let indentTail = NonEmpty/mapTail Text addIndent + + let Format = + ./Format.dhall + sha256:d7936b510cfc091faa994652af0eb5feb889cd44bc989edbe4f1eb8c5623caac + ? ./Format.dhall + + let ObjectField = { mapKey : Text, mapValue : Block } + + let -- Essentially the same thing as `Text/show`, except that this does not + -- escape `$` + escape = + List/fold + (Text → Text) + [ Text/replace "\"" "\\\"" + , Text/replace "\b" "\\b" + , Text/replace "\f" "\\f" + , Text/replace "\n" "\\n" + , Text/replace "\r" "\\r" + , Text/replace "\t" "\\t" + , Text/replace "\\" "\\\\" + ] + Text + (λ(replace : Text → Text) → λ(text : Text) → replace text) + + let renderJSONStruct = + λ(prefix : Text) → + λ(suffix : Text) → + λ(blocks : NonEmpty Lines) → + let indent = List/map Text Text addIndent + + let appendComma + : Lines → Lines + = NonEmpty/mapLast Text (λ(line : Text) → line ++ ",") + + let blocks = NonEmpty/mapLeading Lines appendComma blocks + + let block = NonEmpty/concat Text blocks + + in Optional/fold + (NonYtpme Text) + (List/unsnoc Text block.tail) + (NonEmpty Text) + ( λ(ny : NonYtpme Text) → + { head = prefix + , tail = + indent ([ block.head ] # ny.init # [ ny.last ]) + # [ suffix ] + } + ) + (NonEmpty/singleton Text "${prefix} ${block.head} ${suffix}") + + let renderObject = + λ(format : Format) → + λ(fields : NonEmpty ObjectField) → + let keystr = λ(field : ObjectField) → "\"${escape field.mapKey}\":" + + let prefixKeyOnFirst = + λ(field : ObjectField) → + NonEmpty/mapHead + Text + (addPrefix "${keystr field} ") + (Block/toLines field.mapValue) + + let prependKeyLine = + λ(field : ObjectField) → + NonEmpty/prepend + Text + (keystr field) + (Block/toLines field.mapValue) + + let renderYAMLField = + λ(field : ObjectField) → + merge + { Simple = + λ(line : Text) → + NonEmpty/singleton Text "${keystr field} ${line}" + , Complex = λ(_ : Lines) → indentTail (prependKeyLine field) + } + field.mapValue + + in merge + { JSON = + renderJSONStruct + "{" + "}" + (NonEmpty/map ObjectField Lines prefixKeyOnFirst fields) + , YAML = + NonEmpty/concat + Text + (NonEmpty/map ObjectField Lines renderYAMLField fields) + } + format + + let renderYAMLArrayField = + λ(block : Block) → + NonEmpty/mapHead + Text + (addPrefix "- ") + (indentTail (Block/toLines block)) + + let renderArray = + λ(format : Format) → + λ(fields : NonEmpty Block) → + merge + { JSON = + renderJSONStruct + "[" + "]" + (NonEmpty/map Block Lines Block/toLines fields) + , YAML = + NonEmpty/concat + Text + (NonEmpty/map Block Lines renderYAMLArrayField fields) + } + format + + let renderAs + : Format → JSON.Type → Text + = λ(format : Format) → + λ(json : JSON.Type) → + blockToText + ( json + Block + { string = λ(x : Text) → Block.Simple "\"${escape x}\"" + , double = λ(x : Double) → Block.Simple (Double/show x) + , integer = λ(x : Integer) → Block.Simple (JSON.renderInteger x) + , object = manyBlocks ObjectField "{}" (renderObject format) + , array = manyBlocks Block "[]" (renderArray format) + , bool = + λ(x : Bool) → Block.Simple (if x then "true" else "false") + , null = Block.Simple "null" + } + ) + + in renderAs diff --git a/JSON/renderCompact.dhall b/JSON/renderCompact.dhall new file mode 100644 index 0000000..6a4e8e2 --- /dev/null +++ b/JSON/renderCompact.dhall @@ -0,0 +1,52 @@ +--| This renders JSON on a single line +let JSON = ./core.dhall + +let Text/concatMapSep = ../Text/concatMapSep.dhall + +let renderInteger = ./renderInteger.dhall + +let renderCompact + : JSON.Type → Text + = λ(j : JSON.Type) → + j + Text + { string = Text/show + , double = Double/show + , integer = renderInteger + , object = + λ(x : List { mapKey : Text, mapValue : Text }) → + let body = + Text/concatMapSep + "," + { mapKey : Text, mapValue : Text } + ( λ(e : { mapKey : Text, mapValue : Text }) → + " ${Text/show e.mapKey}: ${e.mapValue}" + ) + x + + in "{${body} }" + , array = + λ(x : List Text) → + let body = Text/concatMapSep "," Text (λ(y : Text) → " ${y}") x + + in "[${body} ]" + , bool = λ(x : Bool) → if x then "true" else "false" + , null = "null" + } + +let example = + assert + : renderCompact + ( JSON.array + [ JSON.bool True + , JSON.string "Hello" + , JSON.object + [ { mapKey = "foo", mapValue = JSON.null } + , { mapKey = "bar", mapValue = JSON.double 1.1 } + , { mapKey = "baz", mapValue = JSON.integer +2 } + ] + ] + ) + ≡ "[ true, \"Hello\", { \"foo\": null, \"bar\": 1.1, \"baz\": 2 } ]" + +in renderCompact diff --git a/JSON/renderInteger.dhall b/JSON/renderInteger.dhall new file mode 100644 index 0000000..67b17de --- /dev/null +++ b/JSON/renderInteger.dhall @@ -0,0 +1,20 @@ +{-| +Render an `Integer` value as a `JSON number`, according to the JSON standard, in +which a number may not start with a plus sign (`+`). +-} +let Integer/nonNegative = ../Integer/nonNegative.dhall + +let renderInteger + : Integer → Text + = λ(integer : Integer) → + if Integer/nonNegative integer + then Natural/show (Integer/clamp integer) + else Integer/show integer + +let positive = assert : renderInteger +1 ≡ "1" + +let zero = assert : renderInteger +0 ≡ "0" + +let negative = assert : renderInteger -1 ≡ "-1" + +in renderInteger diff --git a/JSON/renderYAML.dhall b/JSON/renderYAML.dhall new file mode 100644 index 0000000..a755beb --- /dev/null +++ b/JSON/renderYAML.dhall @@ -0,0 +1,12 @@ +λ(nix : ../NixPrelude.dhall) → + let JSON = ./core.dhall + + let Format = ./Format.dhall + + let renderAs = ./renderAs.dhall nix + + let renderYAML + : JSON.Type → Text + = renderAs Format.YAML + + in renderYAML diff --git a/JSON/string.dhall b/JSON/string.dhall new file mode 100644 index 0000000..872cacc --- /dev/null +++ b/JSON/string.dhall @@ -0,0 +1,32 @@ +{-| +Create a JSON string from Dhall `Text` + +``` +let JSON = ./package.dhall +in JSON.render (JSON.string "ABC $ \" 🙂") += "\"ABC \\u0024 \\\" 🙂\"" + +let JSON = ./package.dhall +in JSON.render (JSON.string "") += "\"\"" +``` +-} +let JSON = ./Type.dhall + +let string + : Text → JSON + = λ(x : Text) → + λ(JSON : Type) → + λ ( json + : { array : List JSON → JSON + , bool : Bool → JSON + , double : Double → JSON + , integer : Integer → JSON + , null : JSON + , object : List { mapKey : Text, mapValue : JSON } → JSON + , string : Text → JSON + } + ) → + json.string x + +in string diff --git a/JSON/tagInline.dhall b/JSON/tagInline.dhall new file mode 100644 index 0000000..842cb04 --- /dev/null +++ b/JSON/tagInline.dhall @@ -0,0 +1,23 @@ +--| Prepare a union value for JSON- or YAML-encoding with the inline layout +let Nesting = ./Nesting.dhall + +let Tagged = ./Tagged.dhall + +let tagInline + : Text → ∀(a : Type) → a → Tagged a + = λ(tagFieldName : Text) → + λ(a : Type) → + λ(contents : a) → + { nesting = Nesting.Inline, field = tagFieldName, contents } + +let example0 = + let Example = < Left : { foo : Natural } | Right : { bar : Bool } > + + in assert + : tagInline "name" Example (Example.Left { foo = 2 }) + ≡ { field = "name" + , nesting = Nesting.Inline + , contents = Example.Left { foo = 2 } + } + +in tagInline diff --git a/JSON/tagNested.dhall b/JSON/tagNested.dhall new file mode 100644 index 0000000..b32ed2d --- /dev/null +++ b/JSON/tagNested.dhall @@ -0,0 +1,27 @@ +--| Prepare a union value for JSON- or YAML-encoding with the nested layout +let Nesting = ./Nesting.dhall + +let Tagged = ./Tagged.dhall + +let tagNested + : Text → Text → ∀(a : Type) → a → Tagged a + = λ(contentsFieldName : Text) → + λ(tagFieldName : Text) → + λ(a : Type) → + λ(contents : a) → + { nesting = Nesting.Nested contentsFieldName + , field = tagFieldName + , contents + } + +let example0 = + let Example = < Left : { foo : Natural } | Right : { bar : Bool } > + + in assert + : tagNested "value" "name" Example (Example.Left { foo = 2 }) + ≡ { field = "name" + , nesting = Nesting.Nested "value" + , contents = Example.Left { foo = 2 } + } + +in tagNested diff --git a/Text/default.dhall b/Text/default.dhall index 6b87191..110c3e2 100644 --- a/Text/default.dhall +++ b/Text/default.dhall @@ -1,10 +1,9 @@ --| Unwrap an `Optional` `Text` value, defaulting `None` to `""` -let default - : Optional Text → Text - = λ(o : Optional Text) → merge { Some = λ(t : Text) → t, None = "" } o +λ(nix : ../NixPrelude.dhall) → + let Optional/default = ../Optional/default.dhall nix -let example0 = assert : default (Some "ABC") ≡ "ABC" + let default + : Optional Text → Text + = λ(o : Optional Text) → Optional/default Text "" o -let example1 = assert : default (None Text) ≡ "" - -in default + in default diff --git a/Text/defaultMap.dhall b/Text/defaultMap.dhall index e181211..fb02441 100644 --- a/Text/defaultMap.dhall +++ b/Text/defaultMap.dhall @@ -1,13 +1,14 @@ --| Transform the value in an `Optional` into `Text`, defaulting `None` to `""` -let defaultMap - : ∀(a : Type) → (a → Text) → Optional a → Text - = λ(a : Type) → - λ(f : a → Text) → - λ(o : Optional a) → - merge { Some = f, None = "" } o +λ(nix : ../NixPrelude.dhall) → + let Optional/map = ../Optional/map.dhall nix -let example0 = assert : defaultMap Natural Natural/show (Some 0) ≡ "0" + let default = ./default.dhall nix -let example1 = assert : defaultMap Natural Natural/show (None Natural) ≡ "" + let defaultMap + : ∀(a : Type) → (a → Text) → Optional a → Text + = λ(a : Type) → + λ(f : a → Text) → + λ(o : Optional a) → + default (Optional/map a Text f o) -in defaultMap + in defaultMap diff --git a/Text/package.dhall b/Text/package.dhall index bc61515..3704252 100644 --- a/Text/package.dhall +++ b/Text/package.dhall @@ -1,14 +1,15 @@ -{ concat = ./concat.dhall -, concatMap = ./concatMap.dhall -, concatMapSep = ./concatMapSep.dhall -, concatSep = ./concatSep.dhall -, default = ./default.dhall -, defaultMap = ./defaultMap.dhall -, lowerASCII = ./lowerASCII.dhall -, replace = ./replace.dhall -, replicate = ./replicate.dhall -, shell-escape = ./shell-escape.dhall -, show = ./show.dhall -, spaces = ./spaces.dhall -, upperASCII = ./upperASCII.dhall -} +λ(nix : ../NixPrelude.dhall) → + { concat = ./concat.dhall + , concatMap = ./concatMap.dhall + , concatMapSep = ./concatMapSep.dhall + , concatSep = ./concatSep.dhall + , default = ./default.dhall nix + , defaultMap = ./defaultMap.dhall nix + , lowerASCII = ./lowerASCII.dhall + , replace = ./replace.dhall + , replicate = ./replicate.dhall + , shell-escape = ./shell-escape.dhall + , show = ./show.dhall + , spaces = ./spaces.dhall + , upperASCII = ./upperASCII.dhall + } diff --git a/package.dhall b/package.dhall index 8f68d0f..26ce6af 100644 --- a/package.dhall +++ b/package.dhall @@ -4,6 +4,7 @@ , Double = ./Double/package.dhall nix , Function = ./Function/package.dhall , Integer = ./Integer/package.dhall nix + , JSON = ./JSON/package.dhall nix , List = ./List/package.dhall nix , Location = ./Location/package.dhall , Map = ./Map/package.dhall nix @@ -15,5 +16,5 @@ , Optional = ./Optional/package.dhall nix , Path = ./Path/package.dhall nix , Set = ./Set/package.dhall nix - , Text = ./Text/package.dhall + , Text = ./Text/package.dhall nix }