Source

Linq2vk / src / Common / JsonParser.fs

Full commit
namespace Linq2vk.Core

module JsonParserImpl =
    open Newtonsoft.Json.Linq

    type JsonArrayParser<'a> =
        JsonArrayParser of (JToken[] -> ('a * JToken[]) list)

    let runParser (JsonArrayParser p) tokens =
        p tokens

    type JsonParserException(msg:string) =
        inherit System.Exception(msg)        
    
    let getParsingResult = function
        | [] -> raise <| JsonParserException("Parsing failed")
        | [(res, _)] -> res
        | _ -> raise <| System.NotSupportedException("This should not normally happen")

    type JsonArrayBuilder() = 
        member this.Return(x) =
            JsonArrayParser (fun ts -> [(x, ts)])
        member this.Fail() =
            JsonArrayParser (fun _ -> [])
        member this.Zero() =
            JsonArrayParser (fun _ -> [])
        member this.Bind(p, f) =
            JsonArrayParser (fun ts ->
                match runParser p ts with
                | [(r, ts')] -> runParser (f r) ts'
                | _ -> []
            )

module JsonParser =             
    open JsonParserImpl
    
    let jarr = JsonArrayBuilder()
    
    let at idx =
        JsonArrayParser (fun ts ->
            if ts.Length <> 0 && idx < ts.Length then
                [(ts.[idx]), ts]
            else
                []
        )
        
    let parse parser tokens =
        runParser parser tokens
            |> getParsingResult
    
    let parseOrDefault parser defaultValue =
        JsonArrayParser (fun ts ->
            match runParser parser ts with
            | [] -> [(defaultValue, ts)]
            | res -> res
        )
        
    let (<|>) = parseOrDefault
    
    let parseOrFail condition parser =
        JsonArrayParser (fun ts ->
            if condition then
                runParser parser ts
            else
                []
        )
        
    let (<?>) = parseOrFail
    
    let tokenAtAs idx converter =
        jarr {
            let! t = at idx
            return (converter t)
        }
        
    let (<@>) converter idx =
        tokenAtAs idx converter
        
        
#if DEBUG
// simple tests to be used in REPL
//
module JsonParserTests =
    open JsonParser
    open Newtonsoft.Json.Linq

    let singleItemParser =        
        jarr {
            let! a =  int <@> 0
            let! c = (string <@> 2) <|> "default"
            return (a,c)
        }

    let tokens = JArray.Parse("[1,2]") |> Seq.toArray
    let a = parse singleItemParser tokens
#endif