Created
June 23, 2014 13:37
-
-
Save eulerfx/05010aa035dc52c1feee to your computer and use it in GitHub Desktop.
FSharp.Data JsonValue zipper
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
type JsonPath = | |
| Top /// The root of the JsonValue. | |
| Node of i:int * parent:JsonValue * path:JsonPath /// A node within a JsonValue: a record property or an array item. | |
type JsonZipper = JsonZipper of current:JsonValue * path:JsonPath | |
module JsonCursor = | |
let private expectRecord() = failwith "Invalid cursor state: JsonValue.Record expected!" | |
let private expectArray() = failwith "Invalid cursor state: JsonValue.Array expected!" | |
let private expectRecordOrArray() = failwith "Invalid cursor state: JsonValue.Record or JsonValue.Array expected!" | |
/// Creates a rooted zipper for a JsonValue. | |
let unit (json:JsonValue) = JsonZipper (json, Top) | |
/// Gets the current focus. | |
let focus = function JsonZipper (value,_) -> value | |
/// Moves the zipper to the top of the JsonValue. | |
let rec top = function | |
| JsonZipper (value, Top) as jz -> jz | |
| JsonZipper (_, Node(_,array,path)) -> top (JsonZipper (array,path)) | |
/// Moves the cursor to the top and returns the JsonValue. | |
let unwind = top >> focus | |
/// Moves the cursor to the parent node. | |
let up = function | |
| JsonZipper (_, Node(_,parent,path)) -> JsonZipper (parent,path) |> Some | |
| _ -> None | |
let private findPropIndex n = function | |
| JsonValue.Record props -> | |
props | |
|> Array.tryFindIndex (fun (k,_) -> k.Equals(n, StringComparison.OrdinalIgnoreCase)) | |
| _ -> expectRecord() | |
/// Focuses onto a property of the current JsonValue.Record. | |
let prop (name:string) = function | |
| JsonZipper (JsonValue.Record props as r, path) -> | |
r | |
|> findPropIndex name | |
|> Option.map (fun i -> JsonZipper (props.[i] |> snd, Node(i,r,path))) | |
| _ -> None | |
/// Selects a sibling property. | |
let propSib (name:string) = function | |
| JsonZipper (_, Node(_, (JsonValue.Record props as r), path)) -> | |
r | |
|> findPropIndex name | |
|> Option.map (fun i -> JsonZipper (props.[i] |> snd, Node(i, r, path))) | |
| _ -> None | |
/// Selects the nth element of the current JsonValue.Array. | |
let nth i = function | |
| JsonZipper (JsonValue.Array items as a, path) when items.Length > i -> | |
JsonZipper (items.[i], Node(i, a, path)) |> Some | |
| _ -> None | |
/// Selects the first element of the current JsonValue.Array. | |
let first = nth 0 | |
/// Moves the zipper to the left of the current position in the array. | |
let left = function | |
| JsonZipper (_, Node(i,(JsonValue.Array items as a),path)) -> | |
let i = i - 1 | |
if i > 0 then JsonZipper (items.[i], Node(i,a,path)) |> Some | |
else None | |
| _ -> None | |
/// Moves the zipper to the right of the current position in the array. | |
let right = function | |
| JsonZipper (_, Node(i,(JsonValue.Array items as a),path)) -> | |
let i = i + 1 | |
if i < items.Length then JsonZipper (items.[i], Node(i,a,path)) |> Some | |
else None | |
| _ -> None | |
/// Updates the JsonValue at the current position returning a new zipper pointing to the updated node. | |
let rec update f = function | |
| JsonZipper (value, Top) -> JsonZipper (f value,Top) | |
| JsonZipper (value, Node(i,JsonValue.Record props,path)) -> | |
let value = f value | |
let r = JsonValue.Record (props |> Array.mapi (fun idx (k,v) -> if (idx = i) then (k,value) else (k,v))) | |
let path = path |> splicePath r | |
JsonZipper (value, Node(i,r,path)) | |
| JsonZipper (value, Node(i,JsonValue.Array items,path)) -> | |
let items = items |> Array.mapi (fun idx v -> if idx = i then f v else v) | |
let a = JsonValue.Array items | |
let path = path |> splicePath a | |
JsonZipper (items.[i], Node(i,a,path)) | |
| _ -> expectRecordOrArray() | |
/// Replaces the JsonValue context of a path. | |
and private splicePath newParent = | |
let pointTo (i:int) = function | |
| JsonZipper (JsonValue.Record props as r, path) -> JsonZipper (props.[i] |> snd, Node(i,r,path)) | |
| JsonZipper (JsonValue.Array items as a, path) -> JsonZipper (items.[i], Node(i,a,path)) | |
| _ -> expectRecordOrArray() | |
function | |
| Top as r -> r | |
| Node (i,parent,path) -> | |
let (JsonZipper(parent,path)) = JsonZipper(parent,path) |> pointTo i |> set newParent | |
Node(i,parent,path) | |
/// Sets the current node to the specified value. | |
and set v = update (fun _ -> v) | |
/// Sets JsonValue.Null to the current node. | |
let nullify = set JsonValue.Null | |
/// Deletes the current node and moves the zipper to the youngest sibling. | |
let delete = | |
let filteri (p:int -> 'a -> bool) (arr:'a[]) = arr |> Array.mapi (fun i a -> if (p i a) then Some a else None) |> Array.choose id | |
function | |
| JsonZipper (_, Top) -> JsonZipper (JsonValue.Null,Top) | |
| JsonZipper (_, Node(i,JsonValue.Record props,path)) -> | |
let r = JsonValue.Record (props |> filteri (fun idx _ -> i <> idx)) | |
let path = path |> splicePath r | |
JsonZipper (r, Node(0, r, path)) | |
| JsonZipper (_, Node(i,JsonValue.Array items,path)) -> | |
let items = items |> filteri (fun idx _ -> i <> idx) | |
let a = JsonValue.Array items | |
let path = path |> splicePath a | |
JsonZipper (items.[0], Node(0,a,path)) | |
| _ -> expectRecordOrArray() | |
/// Adds a property to the current JsonValue.Record. | |
let addProp (name:string) (value:JsonValue) = function | |
| JsonZipper (JsonValue.Record props as r, path) -> | |
let r = JsonValue.Record (Array.append props [|name,value|]) | |
let path = path |> splicePath r | |
JsonZipper (r, path) | |
| _ -> failwith "invalid state!" | |
/// Adds an to the current JsonValue.Array. | |
let addItem (item:JsonValue) = function | |
| JsonZipper (JsonValue.Array items as a, path) -> | |
let a = JsonValue.Array (Array.append items [|item|]) | |
let path = path |> splicePath a | |
JsonZipper (a, path) | |
| _ -> expectArray() |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
// this also makes use of syntax support ported from https://github.com/mausch/Fleece | |
let json = | |
jobj [| | |
"str" .= "hello" | |
"arr" .= [ 1; 2; 3 ] | |
"obj" .= [| | |
"id" .= 123 | |
|] | |
|] | |
let json' = | |
JsonCursor.unit json | |
|> JsonCursor.prop "str" |> Option.get | |
|> JsonCursor.nullify | |
|> JsonCursor.unwind |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment