Skip to content

Instantly share code, notes, and snippets.

@SLAVONchick
Created June 9, 2020 13:31
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save SLAVONchick/52c1484f92602004d6cc32a795b3540c to your computer and use it in GitHub Desktop.
Save SLAVONchick/52c1484f92602004d6cc32a795b3540c to your computer and use it in GitHub Desktop.
Write JSONs in F#!
open System.Collections.Generic
open Quotations.Patterns
let inline ( ==> ) a b = KeyValuePair(a, b)
let isCall = function Call _ -> true | _ -> false
let findQuotes q =
let rec findQuotes' q res = seq {
match q with
| Call (_, _, [Lambda (_, Call (_, _, [Call (_, _, [Call (_, _, l)]); next]))] ) ->
yield! findQuotes' next (seq { yield! res; l })
| Call (_, _, [Lambda (_, Call (_, _, l))] ) ->
match l with
| [Call (None, op, list); q] when op.Name = nameof(==>) ->
yield! findQuotes' q (seq { yield! res; list })
| [Call (None, op, list)] when op.Name = nameof(==>) -> yield! (seq { yield! res; list })
| q -> yield! (seq { yield! res; q })
| q -> failwithf "Unexpected quote {%A}" q
}
findQuotes' q [] |> Seq.toList
let rec toJson quotes =
let rec getString quote =
match quote with
| NewArray(_, list) ->
list |> List.map getString
|> fun s -> System.String.Join(",", s)
|> fun s -> "[" + s + "]"
| Value(v, _) -> sprintf "%A" v
| Application (Lambda (_, Call (_, _, [Quote call])), _) ->
findQuotes call
|> toJson
| q -> failwithf "Unexpected {%A}" q
let rec toJson' quotes res =
match quotes with
| q::[] ->
res + (getString q)
| h :: t :: [] ->
(getString h) + ":" + (getString t)
quotes
|> List.map (fun x -> toJson' x "")
|> fun s ->
let result = System.String.Join(",", s)
if s.Length = 1 then result else "{" + result + "}"
type JsonBuilder() =
member _.Yield (a: KeyValuePair<string, string>) = a
member _.Yield (a: KeyValuePair<string, int>) = a
member _.Yield (a: KeyValuePair<string, float>) = a
member _.Yield (a: KeyValuePair<string, 'a []>) = a
member _.Yield (a: 'a []) = a
member _.Combine(KeyValue(a1, a2), KeyValue(b1, b2)) =
seq {yield KeyValuePair(a1, sprintf "%A" a2); yield KeyValuePair(b1, sprintf "%A" b2)}
member _.Combine(KeyValue(a1, a2), b) =
seq {yield KeyValuePair(a1, sprintf "%A" a2); yield! seq { for KeyValue(b1, b2) in b -> KeyValuePair(b1, sprintf "%A" b2) }}
member _.Delay f = f()
member _.Quote q = q
member _.Run(q: Quotations.Expr<'T>) =
findQuotes q
|> toJson
member _.Zero() = ()
let json = JsonBuilder()
// {"a":"b","c":1,"d":[1.2,3.4,5.6]}
let a = json {
"a" ==> "b"
"c" ==> 1
"d" ==> [|1.2; 3.4; 5.6|]
}
// [{"abc":"def","123":456},{"abc":"def","123":456}]
let b = json {
[| json
{ "abc" ==> "def"
"123" ==> 456 }
json
{ "abc" ==> "def"
"123" ==> 456 } |]
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment