Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
F# FSharp.Data.JsonValue codec syntax
/// port of https://github.com/mausch/Fleece
type ToJsonClass = ToJsonClass
type FromJsonClass = FromJsonClass
type ParseResult<'a> = Choice<'a, string>
module ParseResult =
let inline unit a : ParseResult<'a> = Choice1Of2 a
let inline error err : ParseResult<'a> = Choice2Of2 err
let get<'a> (r:ParseResult<'a>) : 'a =
match r with
| Success r -> r
| Failure err -> failwith (sprintf "parse failed=%s" err)
let tryGetOpt<'a> (r:ParseResult<'a option>) : 'a option =
match r with
| Success r -> r
| _ -> None
let map f (r:ParseResult<'a>) : ParseResult<'b> =
match r with
| Success a -> unit (f a)
| Failure err -> error err
let bind f (r:ParseResult<'a>) : ParseResult<'b> =
match r with
| Success a -> f a
| Failure err -> error err
let traverseA (f:'a -> ParseResult<'b>) (xs:'a[]) : ParseResult<'b[]> =
let length = Array.length xs
let acc : 'b[] = Array.zeroCreate length
let rec go i =
if i = length then null
else
match f xs.[i] with
| Success a ->
acc.[i] <- a
go (i + 1)
| Failure err -> err
let err = go 0
if err = null then unit acc
else error err
type JsonParserBuilder() =
member x.Return a = unit a
member x.ReturnFrom r = r
member x.Bind (inp:ParseResult<'a>, body:'a -> ParseResult<'b>) : ParseResult<'b> = bind body inp
[<AutoOpen>]
module Helpers =
let jsonParse = new ParseResult.JsonParserBuilder()
let inline toJson_ (a: ^a, b: ^b) = ((^a or ^b) : (static member ToJson: ^b -> JsonValue) b)
/// Encodes a value of a type containing a ToJson function into a JsonValue.
let inline toJson x : JsonValue = toJson_ (ToJsonClass, x)
/// Encodes a value into a JSON string.
let inline toJsonString x : string = x |> toJson |> JsonValue.toString
/// Encodes a value into a JSON byte array.
let inline toJsonBytes x : byte[] = x |> toJson |> JsonValue.toString |> Encoding.UTF8.GetBytes
/// Creates a JSON property.
let inline jprop (name:string) (x:'a) = (name,toJson x)
/// Creates a JSON object.
let inline jobj (props:(string * JsonValue)[]) = props |> JsonValue.Record
/// Creates a successful ParseResult.
let succeed x = ParseResult.unit x
/// Creates a failed ParseResult.
let fail err = ParseResult.error err
let inline private fromJson_ (a:^a, b:^b) = ((^a or ^b) : (static member FromJson:^b -> (JsonValue -> ^b ParseResult)) b)
/// Parses a JsonValue into a specified type containing a FromJson function.
let inline fromJson (json:JsonValue) = fromJson_ (FromJsonClass, Unchecked.defaultof<'a>) json
/// Parse a JsonValue into a specified type and applies a mapping.
let inline fromJsonTo (json:JsonValue) (f:'a -> 'b) = fromJson json |> ParseResult.map f
/// Parses a JSON string.
let inline parseJson (json:string) = JsonValue.Parse json |> fromJson
/// Parses a byte array.
let inline parseJsonBytes (json:byte[]) = Encoding.UTF8.GetString(json) |> JsonValue.Parse |> fromJson
/// Parses a JSON property into a specified type.
let inline jget (json:JsonValue) key =
let prop = json.TryGetProperty key
match prop with
| Some prop -> fromJson prop
| None -> fail (sprintf "can't find key '%s'" key)
/// Optionally parses a JSON property into a specified type.
let inline jgetopt (json:JsonValue) key =
let prop = json.TryGetProperty key
match prop with
| Some prop -> fromJson prop |> ParseResult.map Some
| None -> succeed None
let parseObj (f:JsonValue -> ParseResult<'a>) (json:JsonValue) : ParseResult<'a> =
match json with
| JsonValue.Record _ as json -> f json
| _ -> fail "JSON object expected."
type ToJsonClass with
static member inline ToJson (x:JsonValue) = x
static member inline ToJson (x:(string * JsonValue)[]) = JsonValue.Record x
static member inline ToJson (x:int) = JsonValue.Number (decimal x)
static member inline ToJson (x:int64) = JsonValue.Number (decimal x)
static member inline ToJson (x:int16) = JsonValue.Number (decimal x)
static member inline ToJson (x:bool) = JsonValue.Boolean x
static member inline ToJson (x:float) = JsonValue.Float x
static member inline ToJson (x:single) = JsonValue.Float (float x)
static member inline ToJson (x:char) = JsonValue.String (x.ToString())
static member inline ToJson (x:decimal) = JsonValue.Number x
static member inline ToJson (x:string) = if x = null then JsonValue.Null else JsonValue.String x
static member inline ToJson (x:DateTime) = JsonValue.String (x.ToString("yyyy-MM-ddTHH:mm:ssZ"))
static member inline ToJson (x:DateTimeOffset) = JsonValue.String (x.ToString("yyyy-MM-ddTHH:mm:ssK"))
static member inline ToJson (x:'a array) = x |> Array.map toJson |> JsonValue.Array
//static member inline ToJson (x:System.Collections.Generic.IEnumerable<'a>) = x |> Seq.toArray |> ToJsonClass.ToJson
static member inline ToJson (x:'a list) = x |> List.toArray |> ToJsonClass.ToJson
static member inline ToJson (x:'a Set) = x |> Set.toArray |> ToJsonClass.ToJson
static member inline ToJson (x:Map<string, 'a>) = x |> Map.map (fun _ v -> toJson v) |> Map.toArray |> jobj
static member inline ToJson (x:'a option) = match x with Some x -> toJson x | None -> JsonValue.Null
static member inline ToJson (x:Choice<_,_>) =
match x with
| Choice1Of2 a -> jobj [| "left" .= a |]
| Choice2Of2 b -> jobj [| "right" .= b |]
type FromJsonClass with
static member FromJson (_:string) = function
| JsonValue.String s -> succeed s
| JsonValue.Null -> succeed null
| _ -> fail "string"
static member FromJson (_:int) = function
| JsonValue.Number _ as j -> j.AsInteger() |> succeed
| JsonValue.Float _ as j -> j.AsInteger() |> succeed
| _ -> fail "int"
static member FromJson (_:decimal) = function
| JsonValue.Number _ as j -> j.AsDecimal() |> succeed
| JsonValue.Float _ as j -> j.AsDecimal() |> succeed
| _ -> fail "decimal"
static member FromJson (_:float) = function
| JsonValue.Number _ as j -> j.AsFloat() |> succeed
| JsonValue.Float _ as j -> j.AsFloat() |> succeed
| _ -> fail "float"
static member FromJson (_:bool) = function
| JsonValue.Boolean b -> b |> succeed
| _ -> fail "bool"
static member FromJson (_:DateTime) = function
| JsonValue.String s ->
match DateTime.TryParseExact(s, "yyyy-MM-ddTHH:mm:ssZ", null, DateTimeStyles.RoundtripKind) with
| true,dt -> succeed dt
| _ -> fail "datetime"
| _ -> fail "datetime"
static member FromJson (_:DateTimeOffset) = function
| JsonValue.String s ->
match DateTimeOffset.TryParseExact(s, "yyyy-MM-ddTHH:mm:ssK", null, DateTimeStyles.RoundtripKind) with
| true,dt -> succeed dt
| _ -> fail "datetime"
| _ -> fail "datetime"
static member inline FromJson (_:'a option) = function
| JsonValue.Null -> succeed None
| json ->
let a : ParseResult<'a> = fromJson json
a |> ParseResult.map Some
static member inline FromJson (_:'a[]) = function
| JsonValue.Array xs ->
let xs : ParseResult<'a[]> = xs |> ParseResult.traverseA fromJson
xs
| _ -> fail "array"
static member inline FromJson (_:list<'a>) = function
| JsonValue.Array xs ->
let xs : ParseResult<'a[]> = xs |> ParseResult.traverseA fromJson
xs |> ParseResult.map List.ofArray
| _ -> fail "list"
static member inline FromJson (_:Set<'a>) = function
| JsonValue.Array xs ->
let xs : ParseResult<'a[]> = xs |> ParseResult.traverseA fromJson
xs |> ParseResult.map Set.ofArray
| _ -> fail "list"
static member inline FromJson (_:Choice<'a, 'b>) = function
| JsonValue.Record [| "left" , json |] -> let r : ParseResult<'a> = json |> fromJson in r |> ParseResult.map Choice1Of2
| JsonValue.Record [| "right" , json |] -> let r : ParseResult<'b> = json |> fromJson in r |> ParseResult.map Choice2Of2
| _ -> fail "choice"
[<AutoOpen>]
module Ops =
/// Creates a JSON property given a key (property name) and corresponding value.
let inline (.=) key value = jprop key value
/// Parses a property from a JSON value.
let inline (.@) json key = jget json key
/// Parses a property from a JSON value, which may be absent.
let inline (.@?) json key = jgetopt json key
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.
You signed in with another tab or window. Reload to refresh your session. You signed out in another tab or window. Reload to refresh your session.