{- Render a `JSON` value as `Text` in either JSON or YAML format. -} let JSON = ./core.dhall sha256:5dc1135d5481cfd6fde625aaed9fcbdb7aa7c14f2e76726aa5fdef028a5c10f5 ? ./core.dhall let Function/identity = ../Function/identity sha256:f78b96792b459cb664f41c6119bd8897dd04353a3343521d436cd82ad71cb4d4 ? ../Function/identity let Text/concatMap = ../Text/concatMap sha256:7a0b0b99643de69d6f94ba49441cd0fa0507cbdfa8ace0295f16097af37e226f ? ../Text/concatMap let List/take = ../List/take sha256:b3e08ee8c3a5bf3d8ccee6b2b2008fbb8e51e7373aef6f1af67ad10078c9fbfa ? ../List/take let List/drop = ../List/drop sha256:af983ba3ead494dd72beed05c0f3a17c36a4244adedf7ced502c6512196ed0cf ? ../List/drop let List/null = ../List/null sha256:2338e39637e9a50d66ae1482c0ed559bbcc11e9442bfca8f8c176bbcd9c4fc80 ? ../List/null let List/map = ../List/map sha256:dd845ffb4568d40327f2a817eb42d1c6138b929ca758d50bc33112ef3c885680 ? ../List/map let List/concatMap = ../List/concatMap sha256:3b2167061d11fda1e4f6de0522cbe83e0d5ac4ef5ddf6bb0b2064470c5d3fb64 ? ../List/concatMap let Optional/map = ../Optional/map sha256:501534192d988218d43261c299cc1d1e0b13d25df388937add784778ab0054fa ? ../Optional/map let NonEmpty : Type → Type = λ(a : Type) → { head : a, tail : List a } let List/uncons : ∀(a : Type) → List a → Optional (NonEmpty a) = λ(a : Type) → λ(ls : List a) → Optional/map a (NonEmpty a) (λ(head : a) → { head, tail = List/drop 1 a ls }) (List/head a ls) let NonEmpty/singleton : ∀(a : Type) → a → NonEmpty a = λ(a : Type) → λ(x : a) → { head = x, tail = [] : List a } let NonEmpty/toList : ∀(a : Type) → NonEmpty a → List a = λ(a : Type) → λ(nonEmpty : NonEmpty a) → [ nonEmpty.head ] # nonEmpty.tail let NonEmpty/concat : ∀(a : Type) → NonEmpty (NonEmpty a) → NonEmpty a = λ(a : Type) → λ(lss : NonEmpty (NonEmpty a)) → { head = lss.head.head , tail = lss.head.tail # List/concatMap (NonEmpty a) a (NonEmpty/toList a) lss.tail } let NonEmpty/map : ∀(a : Type) → ∀(b : Type) → (a → b) → NonEmpty a → NonEmpty b = λ(a : Type) → λ(b : Type) → λ(fn : a → b) → λ(ls : NonEmpty a) → { head = fn ls.head, tail = List/map a b fn ls.tail } 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 List/splitAt : Natural → ∀(a : Type) → List a → { head : List a, tail : List a } = λ(index : Natural) → λ(a : Type) → λ(ls : List a) → { head = List/take index a ls, tail = List/drop index a ls } let _testSplitAt0 = assert : List/splitAt 0 Natural [ 1, 2, 3 ] ≡ { head = [] : List Natural, tail = [ 1, 2, 3 ] } let _testSplitAt1 = assert : List/splitAt 1 Natural [ 1, 2, 3 ] ≡ { head = [ 1 ], tail = [ 2, 3 ] } let _testSplitAt3 = assert : List/splitAt 3 Natural [ 1, 2, 3 ] ≡ { head = [ 1, 2, 3 ], tail = [] : List Natural } let _testSplitAt = assert : List/splitAt 1 Natural ([] : List Natural) ≡ { head = [] : List Natural, tail = [] : List Natural } let List/splitLast = λ(a : Type) → λ(ls : List a) → List/splitAt (Natural/subtract 1 (List/length a ls)) a ls 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 NonEmpty/append : ∀(a : Type) → a → NonEmpty a → NonEmpty a = λ(a : Type) → λ(suffix : a) → λ(ls : NonEmpty a) → { head = ls.head, tail = ls.tail # [ suffix ] } let NonEmpty/mapLast : ∀(a : Type) → (a → a) → NonEmpty a → NonEmpty a = λ(a : Type) → λ(fn : a → a) → λ(ls : NonEmpty a) → if List/null a ls.tail then { head = fn ls.head, tail = [] : List a } else let split = List/splitLast a ls.tail in { head = ls.head , tail = split.head # List/map a a fn split.tail } let NonEmpty/mapLeading : ∀(a : Type) → (a → a) → NonEmpty a → NonEmpty a = λ(a : Type) → λ(fn : a → a) → λ(ls : NonEmpty a) → if List/null a ls.tail then ls else let split = List/splitLast a ls.tail in { head = fn ls.head , tail = List/map a a fn split.head # split.tail } 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) → merge { Some = λ(inputs : NonEmpty a) → Block.Complex (render inputs) , None = Block.Simple ifEmpty } (List/uncons a inputs) 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 sha256:d7936b510cfc091faa994652af0eb5feb889cd44bc989edbe4f1eb8c5623caac ? ./Format let ObjectField = { mapKey : Text, mapValue : Block } let renderJSONStruct = λ(prefix : Text) → λ(suffix : Text) → λ(blocks : NonEmpty Lines) → let indent = NonEmpty/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 if List/null Text block.tail then NonEmpty/singleton Text "${prefix} ${block.head} ${suffix}" else NonEmpty/prepend Text prefix (NonEmpty/append Text suffix (indent block)) let renderObject = λ(format : Format) → λ(fields : NonEmpty ObjectField) → let keystr = λ(field : ObjectField) → "${Text/show 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 (Text/show 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" } ) let example0 = let data = JSON.array [ JSON.bool True , JSON.string "Hello" , JSON.object [ { mapKey = "foo", mapValue = JSON.null } , { mapKey = "bar", mapValue = JSON.double 1.0 } ] ] let yaml = assert : renderAs Format.YAML data ≡ '' - true - "Hello" - "foo": null "bar": 1.0 '' let json = assert : renderAs Format.JSON data ≡ '' [ true, "Hello", { "foo": null, "bar": 1.0 } ] '' in True let example1 = let data = JSON.object [ { mapKey = "zero", mapValue = JSON.array ([] : List JSON.Type) } , { mapKey = "one", mapValue = JSON.array [ JSON.string "a" ] } , { mapKey = "two" , mapValue = JSON.array [ JSON.string "a", JSON.string "b" ] } ] let yaml = assert : renderAs Format.YAML data ≡ '' "zero": [] "one": - "a" "two": - "a" - "b" '' let json = assert : renderAs Format.JSON data ≡ '' { "zero": [], "one": [ "a" ], "two": [ "a", "b" ] } '' in True let example2 = let data = JSON.object [ { mapKey = "zero" , mapValue = JSON.object (toMap {=} : List { mapKey : Text, mapValue : JSON.Type }) } , { mapKey = "one" , mapValue = JSON.object (toMap { a = JSON.null }) } , { mapKey = "two" , mapValue = JSON.object (toMap { a = JSON.null, b = JSON.null }) } ] let yaml = assert : renderAs Format.YAML data ≡ '' "zero": {} "one": "a": null "two": "a": null "b": null '' let json = assert : renderAs Format.JSON data ≡ '' { "zero": {}, "one": { "a": null }, "two": { "a": null, "b": null } } '' in True in renderAs