add json
This commit is contained in:
parent
990cc12183
commit
f04b341fdf
29 changed files with 1110 additions and 31 deletions
7
JSON/Format.dhall
Normal file
7
JSON/Format.dhall
Normal file
|
@ -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 >
|
35
JSON/Nesting.dhall
Normal file
35
JSON/Nesting.dhall
Normal file
|
@ -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
|
67
JSON/Tagged.dhall
Normal file
67
JSON/Tagged.dhall
Normal file
|
@ -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
|
63
JSON/Type.dhall
Normal file
63
JSON/Type.dhall
Normal file
|
@ -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
|
35
JSON/array.dhall
Normal file
35
JSON/array.dhall
Normal file
|
@ -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
|
32
JSON/bool.dhall
Normal file
32
JSON/bool.dhall
Normal file
|
@ -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
|
25
JSON/core.dhall
Normal file
25
JSON/core.dhall
Normal file
|
@ -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
|
||||
}
|
32
JSON/double.dhall
Normal file
32
JSON/double.dhall
Normal file
|
@ -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
|
32
JSON/integer.dhall
Normal file
32
JSON/integer.dhall
Normal file
|
@ -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
|
1
JSON/keyText.dhall
Normal file
1
JSON/keyText.dhall
Normal file
|
@ -0,0 +1 @@
|
|||
../Map/keyText.dhall
|
1
JSON/keyValue.dhall
Normal file
1
JSON/keyValue.dhall
Normal file
|
@ -0,0 +1 @@
|
|||
../Map/keyValue.dhall
|
28
JSON/natural.dhall
Normal file
28
JSON/natural.dhall
Normal file
|
@ -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
|
27
JSON/null.dhall
Normal file
27
JSON/null.dhall
Normal file
|
@ -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
|
22
JSON/number.dhall
Normal file
22
JSON/number.dhall
Normal file
|
@ -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
|
49
JSON/object.dhall
Normal file
49
JSON/object.dhall
Normal file
|
@ -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
|
136
JSON/omitNullFields.dhall
Normal file
136
JSON/omitNullFields.dhall
Normal file
|
@ -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
|
9
JSON/package.dhall
Normal file
9
JSON/package.dhall
Normal file
|
@ -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
|
12
JSON/render.dhall
Normal file
12
JSON/render.dhall
Normal file
|
@ -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
|
298
JSON/renderAs.dhall
Normal file
298
JSON/renderAs.dhall
Normal file
|
@ -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
|
52
JSON/renderCompact.dhall
Normal file
52
JSON/renderCompact.dhall
Normal file
|
@ -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
|
20
JSON/renderInteger.dhall
Normal file
20
JSON/renderInteger.dhall
Normal file
|
@ -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
|
12
JSON/renderYAML.dhall
Normal file
12
JSON/renderYAML.dhall
Normal file
|
@ -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
|
32
JSON/string.dhall
Normal file
32
JSON/string.dhall
Normal file
|
@ -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
|
23
JSON/tagInline.dhall
Normal file
23
JSON/tagInline.dhall
Normal file
|
@ -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
|
27
JSON/tagNested.dhall
Normal file
27
JSON/tagNested.dhall
Normal file
|
@ -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
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
}
|
||||
|
|
|
@ -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
|
||||
}
|
||||
|
|
Loading…
Reference in a new issue