FParsec tutorial

FParsecTutorial.fsx

#I @"..\packages\FParsec.1.0.1\lib\net40-client"
#r "FParsec.dll"
#r "FParsecCS.dll"

open FParsec

// 4.2 Parsing a single float

let test (p:Parser<_,_>) str =
    match run p str with
    | Success(result, _, _) -> printfn "Success: %A" result
    | Failure(errorMsg, _, _) -> printfn "Failure: %A" errorMsg

test pfloat "1.25"
test pfloat "1.25E 3"

// 4.3 Parsing a float between brackets

let str s = pstring s
let floatBetweenBrackets = str "[" >>. pfloat .>> str "]"

test floatBetweenBrackets "[1.0]"
test floatBetweenBrackets "[]"
test floatBetweenBrackets "[1.0"

// 4.4 Abstracting parsers

let betweenStrings s1 s2 p = str s1 >>. p .>> str s2
let floatBetweenBrackets' = pfloat |> betweenStrings "[" "]"
let floatBetweenDoubleBrackets = pfloat |> betweenStrings "[[" "]]"

test floatBetweenBrackets' "[1.0]"
test floatBetweenDoubleBrackets "[[1.0]]"

//let between pBegin pEnd p  = pBegin >>. p .>> pEnd
let betweenStrings' s1 s2 p = p |> between (str s1) (str s2)

let h1 = pfloat |> betweenStrings' "<h1>" "</h1>"

test h1 "<h1>1.5</h1>"

// 4.5 Parsing a list of floats

test (many floatBetweenBrackets) ""
test (many floatBetweenBrackets) "[1.0]"
test (many floatBetweenBrackets) "[2][3][4]"
test (many floatBetweenBrackets) "(1)"

test (many floatBetweenBrackets) "[1][2.0E]"

test (many1 floatBetweenBrackets) "(1)"
test (many1 (floatBetweenBrackets <?> "float between brackets")) "(1)";;


test (skipMany floatBetweenBrackets) "[2][3][4](1)"

let floatList = str "[" >>. sepBy pfloat (str ",") .>> str "]"

test floatList "[]"
test floatList "[1.0]";;
test floatList "[4,5,6]"

test floatList "[1.0,]"
test floatList "[1.0,2.0"


// 4.6 Handling whitespace

test floatList "[1.0, 2.0]"

let ws = spaces

let str_ws s = pstring s .>> ws
let float_ws = pfloat .>> ws
let numberList = str_ws "[" >>. sepBy float_ws (str_ws ",") .>> str_ws "]"

test numberList @"[ 1 ,
                          2 ] "

test numberList @"[ 1,
                         2; 3]"

let numberListFile = ws >>. numberList .>> eof

test numberListFile " [1, 2, 3]    "
test numberListFile " [1, 2, 3] [4]"


// 4.7 Parsing string data

test (many (str "a" <|> str "b")) "abba"

test (skipStringCI "<float>" >>. pfloat) "<FLOAT>1.0"

let identifier =
    let isIdentifierFirstChar c = isLetter c || c = '_'
    let isIdentifierChar c = isLetter c || isDigit c || c = '_'

    many1Satisfy2L isIdentifierFirstChar isIdentifierChar "identifier"
    .>> ws // skips trailing whitespace

test identifier "_"
test identifier "_test1="
test identifier "1"

let stringLiteral =
    let normalChar = satisfy (fun c -> c <> '\\' && c <> '"')
    let unescape c = match c with
                     | 'n' -> '\n'
                     | 'r' -> '\r'
                     | 't' -> '\t'
                     | c   -> c
    let escapedChar = pstring "\\" >>. (anyOf "\\nrt\"" |>> unescape)
    between (pstring "\"") (pstring "\"")
            (manyChars (normalChar <|> escapedChar))

test stringLiteral "\"abc\""
test stringLiteral "\"abc\\\"def\\\\ghi\""
test stringLiteral "\"abc\\def\""

let stringLiteral2 =
    let normalCharSnippet = many1Satisfy (fun c -> c <> '\\' && c <> '"')
    let escapedChar = pstring "\\" >>. (anyOf "\\nrt\"" |>> function
                                                            | 'n' -> "\n"
                                                            | 'r' -> "\r"
                                                            | 't' -> "\t"
                                                            | c   -> string c)
    between (pstring "\"") (pstring "\"")
            (manyStrings (normalCharSnippet <|> escapedChar))

test stringLiteral2 "\"abc\""
test stringLiteral2 "\"abc\\\"def\\\\ghi\""
test stringLiteral2 "\"abc\\def\""
test stringLiteral2 "\"\""

let stringLiteral3 =
    let normalCharSnippet = manySatisfy (fun c -> c <> '\\' && c <> '"')
    let escapedChar = pstring "\\" >>. (anyOf "\\nrt\"" |>> function | 'n' -> "\n" | 'r' -> "\r" | 't' -> "\t" | c -> string c)
    between (pstring "\"") (pstring "\"")
            (stringsSepBy normalCharSnippet escapedChar)

test stringLiteral3 "\"abc\""
test stringLiteral3 "\"abc\\\"def\\\\ghi\""
test stringLiteral3 "\"abc\\def\""
test stringLiteral3 "\"\""

// 4.8 Sequentially applying parsers

let product = pipe2 float_ws (str_ws "*" >>. float_ws) (*)

test product "3 * 5"

type StringConstant = StringConstant of string * string

let stringConstant = pipe3 identifier (str_ws "=") stringLiteral
                           (fun id _ str -> StringConstant(id, str))

test stringConstant "myString = \"stringValue\""

let ptuple2 = float_ws .>>. (str_ws "," >>. float_ws)
let ptuple2' = tuple2 float_ws (str_ws "," >>. float_ws)
test ptuple2 "123, 456"

// 4.9 Parsing alternatives

let boolean =     (stringReturn "true"  true)
              <|> (stringReturn "false" false)

test boolean "false"
test boolean "true"
test boolean "tru"

test ((ws >>. str "a") <|> (ws >>. str "b")) " b"
test (ws >>. (str "a" <|> str "b")) " b"

test (str "a" <|> str "b" <|> str "c") "ab"
test (str "a" <|> str "b" <|> str "c") "bc"
test (str "a" <|> str "b" <|> str "c") "cd"
test (choice [str "a"; str "b"; str "c"]) "cd"
test (str "a" <|> str "b" <|> str "c") "da"

test (many1 (str "a" <|> str "b" <|> str "c")) "bcabfae"
test (many1 (str "a" <|> str "b" <|> str "c")) "da"

ParsingJson.fsx

#I @"..\packages\FParsec.1.0.1\lib\net40-client"
#r "FParsec.dll"
#r "FParsecCS.dll"

open FParsec

type Json =
    | JString of string
    | JNumber of float
    | JBool   of bool
    | JNull
    | JList   of Json list
    | JObject of Map<string, Json>


let test (p:Parser<_,_>) str =
    match run p str with
    | Success(result, _, _) -> printfn "Success: %A" result
    | Failure(errorMsg, _, _) -> printfn "Failure: %A" errorMsg

let str = pstring
let ws = spaces
let str_ws s = str s .>> ws
let float_ws = pfloat .>> ws

let stringLiteral =
    let ptext = manySatisfy (fun c -> c <> '\\' && c <> '"')
    (between (str "\"") (str "\"") ptext)

let jstring = stringLiteral |>> JString

test jstring "\"abc\" dd "
test jstring "\"\" dd "

let jnumber = float_ws |>> JNumber

test jnumber "123 dd "
test jnumber "1.23e-2 dd "

let jbool =     (stringReturn "true"  (JBool true))
            <|> (stringReturn "false" (JBool false))

test jbool "true x"
test jbool "false x"

let jnull = stringReturn "null" JNull
test jnull "null "


let jvalue, jvalueRef = createParserForwardedToRef<Json, unit>()

let listBetweenStrings sOpen sClose pElement f =
    between (str sOpen) (str sClose)
            (ws >>. sepBy (pElement .>> ws) (str "," >>. ws) |>> f)

//let jlist =
//    let primitive = choice [jstring; jnumber; jbool; jnull]
//    between (str_ws "[") (str_ws "]") (sepBy (primitive .>> ws) (str_ws ","))


let jlist = listBetweenStrings "[" "]" jvalue JList

let keyValue = stringLiteral .>>. (ws >>. str ":" >>. ws >>. jvalue)

let jobject = listBetweenStrings "{" "}" keyValue (Map.ofList >> JObject)

do jvalueRef := choice [jstring; jnumber; jbool; jnull; jlist; jobject]


test jlist "[]"
test jlist "[ ]"
test jlist "[\"a\"]"
test jlist "[ \"b\" ]"
test jlist "[0]"
test jlist "[ 1 ]"
test jlist "[true]"
test jlist "[ true ]"
test jlist "[false]"
test jlist "[ false ]"
test jlist "[null]"
test jlist "[ null ]"
test jlist "[0,1]"
test jlist "[0,\"a\",true,false,null]"
test jlist "[ 1 , \"b\" , true , false , null ]"
test jlist "[[]]"
test jlist "[1,[\"1\"],[]]"

test jobject "{}"
test jobject "{\"abc\": 123}"
test jobject "{\"abc\": \"def\"}"


let json = ws >>. jvalue .>> ws .>> eof

test json "1"
test json "[ {}, 1, \"a\" ]"


test json """

{
    "empty": [],

    "obj": { "Abs": null },

    "cplx":
    [ {},
      1,
      "xx",
      [],
      null,
      true ]

}


"""