Skip to content

Instantly share code, notes, and snippets.

@Tyrrrz

Tyrrrz/Json.fs

Last active Oct 1, 2020
Embed
What would you like to do?
Parsing in F# with FParsec (final project)
namespace Xmlparser
type JsonNode =
// Literals
| JsonNull // null
| JsonBool of bool // true | false
| JsonNumber of float // 10 | 5.63
| JsonString of string // "foobar"
// Complex types
| JsonArray of List<JsonNode> // [ "hello", 10, true ]
| JsonObject of Map<string, JsonNode> // { "count": 4, "items": [5, 1, -8, 3.14] }
module JsonGrammar =
open FParsec
let jsonNull = stringReturn "null" JsonNull .>> spaces
// ~~~~ ~~~~~~~~ ~~~~~~
// ^ ^ ^-- skip trailing whitespace
// | |
// match this -- -- produce this
let jsonBoolTrue = stringReturn "true" <| JsonBool true .>> spaces
let jsonBoolFalse = stringReturn "false" <| JsonBool false .>> spaces
let jsonBool = jsonBoolTrue <|> jsonBoolFalse
let jsonNumber = pfloat .>> spaces |>> JsonNumber
// Applies popen, then pchar repeatedly until pclose succeeds, returns the string in the middle
let manyCharsBetween popen pclose pchar = popen >>? manyCharsTill pchar pclose
// Parses any string between popen and pclose
let anyStringBetween popen pclose = manyCharsBetween popen pclose anyChar
// Parses any string between double quotes
let quotedString = skipChar '"' |> anyStringBetween <| skipChar '"'
// is equivalent to: anyStringBetween (skipChar '"') (skipChar '"')
let jsonString = quotedString .>> spaces |>> JsonString
let jsonLiteral =
choice [
jsonNull
jsonBool
jsonNumber
jsonString
]
let jsonNode, jsonNodeRef = createParserForwardedToRef()
// Parses: popen p psep p psep p psep ... p pclose
let manyContained popen pclose psep p = between popen pclose <| sepBy p psep
let jsonArray =
jsonNode // parse JSON nodes...
|> manyContained // contained within...
(skipChar '[' .>> spaces) // openning square bracket...
(skipChar ']' .>> spaces) // and closing square bracket...
(skipChar ',' .>> spaces) // separated by commas
|>> JsonArray
// Produces a tuple: (string, JsonNode)
let jsonProperty =
quotedString .>> spaces .>> skipChar ':' .>> spaces .>>. jsonNode .>> spaces
let jsonObject =
jsonProperty
|> manyContained
(skipChar '{' .>> spaces)
(skipChar '}' .>> spaces)
(skipChar ',' .>> spaces)
|>> Map.ofList
|>> JsonObject
do jsonNodeRef :=
choice [
jsonObject
jsonArray
jsonLiteral
]
module Json =
open FParsec
/// Tries to parse a string as a JSON node.
let tryParse source =
// Discard leading whitespace and ensure the parser reaches end of stream
let jsonNodeFull = spaces >>. JsonGrammar.jsonNode .>> eof
// Run parser and convert FParsec's result to F#'s standard result
match run jsonNodeFull source with
| Success (res, _, _) -> Result.Ok res
| Failure (err, _, _) -> Result.Error err
/// Tries to extract a boolean value from a node.
let tryBool (node : JsonNode) =
match node with
| JsonBool b -> Some b
| _ -> None
/// Tries to extract a string value from a node.
let tryString (node : JsonNode) =
match node with
| JsonString s -> Some s
| _ -> None
/// Tries to extract a float value from a node.
let tryFloat (node : JsonNode) =
match node with
| JsonNumber n -> Some n
| _ -> None
/// Tries to extract an int value from a node.
let tryInt (node : JsonNode) =
node |> tryFloat |> Option.map int
/// Tries to get an item by its index.
let tryItem (i : int) (node : JsonNode) =
match node with
| JsonArray a -> a |> List.tryItem i
| _ -> None
/// Tries to get a child node by its name.
let tryChild (name : string) (node : JsonNode) =
match node with
| JsonObject o -> o |> Map.tryFind name
| _ -> None
module Program =
[<EntryPoint>]
let main _ =
let str = """
{
"quiz": {
"sport": {
"q1": {
"question": "Which one is correct team name in NBA?",
"options": [
"New York Bulls",
"Los Angeles Kings",
"Golden State Warriors",
"Huston Rocket"
],
"answer": "Huston Rocket"
}
},
"math": {
"q1": {
"question": "5 + 7 = ?",
"options": [
"10",
"11",
"12",
"13"
],
"answer": "12"
},
"q2": {
"question": "12 - 8 = ?",
"options": [
1,
2,
3,
4
],
"answer": 4
}
}
}
}
"""
// Get the value of quiz.sport.q1.options[2]
match Json.tryParse str with
| Ok result ->
result
|> Json.tryChild "quiz"
|> Option.bind (Json.tryChild "sport")
|> Option.bind (Json.tryChild "q1")
|> Option.bind (Json.tryChild "options")
|> Option.bind (Json.tryItem 2)
|> Option.bind (Json.tryString)
|> Option.iter (printfn "Value: %s")
0
| Error err ->
printfn "Parsing failed: %s" err
1
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment