sexp.fs

module NG.SExp

open FParsec

type Node =
    | Scalar of string
    | List of Node list

let grammar =
    // special char is the one that cannot be part of a naked scalar value
    let isScalarChar c =
        match c with
        | ')' | '(' | '"' | ';' | ' ' | '\t' | '\n' | '\r' -> false // " (syntax highlighting fix)
        | _ -> true

    let isValidStringChar c =
        match c with 
        | '"' | '\\' -> false // " (syntax highlighting fix)
        | _ -> true

    let escapedChar = 
        pstring "\\" >>. (anyOf "\\\"nt" |>> function 
                                             | 'n' -> "\n"
                                             | 't' -> "\t"
                                             | c   -> string c)

    let node, noderef = createParserForwardedToRef()

    let scalar = many1SatisfyL isScalarChar "scalar" |>> (Scalar >> Some)

    let list_of_nodes = spaces >>. sepEndBy node spaces1 |>> List.choose id

    let list = pchar '(' >>. list_of_nodes .>> pchar ')' |>> (List >> Some)

    let string = between (pchar '"') (pchar '"') (stringsSepBy (manySatisfy isValidStringChar) escapedChar) |>> (Scalar >> Some)

    let comment = pchar ';' >>. skipManyTill anyChar skipNewline >>% None

    noderef := choice [|
        scalar
        list
        comment
        string
    |]

    list_of_nodes .>> eof

let test p str =
    printfn "Input was: %s" str
    match run p str with
    | Success(result, _, _) -> printfn "Success: %A" result
    | Failure(msg, _, _)    -> printfn "Failure: %s" msg

let main() =
    test grammar """
        hello world (1 2 3 (4 5)) this
        (new world ; this is comment here
         order)
        ";this\tis\ta\tstring\tliteral;"
    """