parse-json.roc

# create this file at <roc-repo-root>/examples/parser/parse-json.roc
# run
# $ cd <roc-repo-root> && roc examples/parser/parse-json.roc
#
# one-liner: clone roc repo to /tmp + wget gist + run gist
# $ cd /tmp && git clone git@github.com:roc-lang/roc.git && cd roc && wget https://gist.github.com/travisstaloch/acae64ec4d8346597f1aaecfe8c401e4/raw/parse-json.roc -O examples/parser/parse-json.roc && roc examples/parser/parse-json.roc
# 
# resources:
# https://github.com/tsoding/haskell-json/blob/master/Main.hs

app "parse-json"
    packages { pf: "platform/main.roc" }
    imports [
        Parser.Core.{ Parser, oneOf, flatten, map, apply, many, const, maybe, between, alt, sepBy, ignore, lazy},
        Parser.Str.{ string, strFromRaw, parseStr, RawStr, codeunitSatisfies, codeunit }
    ]
    provides [main] to pf

Value : [
    Null,
    Boolean Bool,
    Number I64,
    Float F64,
    String Str,
    Array (List Value),
    # JsonObject Dict [Str, JsonValue] ,
]


backspaceC =    8  # '\b'
# tabC =          9  # '\t'
# newlineC =      10 # '\n'
vtC =           11
formfeedC =     12 # '\f'
# carriageRetC =  13 # '\r'
# spaceC =        32 # ' '
# minusC =        45 # '-'
# dotC =          45 # '.'
# dquoteC =       34 # '"'
# commaC =        44 # ','
# zeroC =         48 # '0'
# oneC =          49 # '1'
# nineC =         59 # '9'
# lbraceC =       91 # '['
# backslashC =    92 # '/'
# rbraceC =       93 # ']'


# nullP : Parser RawStr Value
nullP = 
    string "null" 
    |> map (\_ -> Null)

# trueP : Parser RawStr Value
trueP = 
    string "true" 
    |> map (\_ -> Boolean Bool.true)

# falseP : Parser RawStr Value
falseP = 
    string "false" 
    |> map (\_ -> Boolean Bool.false)

# dquoteP : Parser RawStr U8
dquoteP =  codeunit '"'

# replaceP : Str, U8 -> Parser RawStr U8
replaceP = \fromStr, toChar ->
    string fromStr |> map (\_ -> toChar)

# escapeCharP : Parser RawStr U8
escapeCharP = 
    oneOf [
        replaceP "\\n" '\n',
        replaceP "\\r" '\r',
        replaceP "\\t" '\t',
        replaceP "\\\"" '"',
        replaceP "\\/" 47,
        replaceP "\\\\" '/',
        replaceP "\\b"  backspaceC,
        replaceP "\\f" formfeedC,
        # TODO unicode escapes (stringP "\\u" *> escapeUnicode)
    ]

# parses a character that is not " or \
# normalCharP : Parser RawStr U8
normalCharP = 
    codeunitSatisfies (\c -> c != '"' && c != '/')

strlitCharsP = 
    many (alt normalCharP escapeCharP)
    |> map strFromRaw

# strlitP : Parser RawStr Value
strlitP = 
    between strlitCharsP dquoteP dquoteP 
    |> map String 

# maybeCharP : Parser RawStr U8, RawStr, RawStr -> Parser RawStr RawStr
maybeCharP = \charParser, okVal, errVal ->
    maybe charParser
    |> map \res ->
        when res is
            Ok _ -> okVal
            Err _ -> errVal

# minusP : Parser RawStr U8
minusP = codeunit '-'

# maybeMinusP : Parser RawStr RawStr
maybeMinusP = maybeCharP minusP [ '-' ] []

# oneToNineP : Parser RawStr RawStr
oneToNineP = 
    codeunitSatisfies (\c -> '1' <= c && c <= '9' )  # '1'..'9'
    |> map \c -> [c]

# zeroToNineP : Parser RawStr U8
zeroToNineP = codeunitSatisfies (\c -> '0' <= c && c <= '9' ) # '0'..'9'

# rawIntP : Parser RawStr RawStr
rawIntP = 
    const (
        \minus -> \digits0 -> \digits -> 
            List.join [minus, digits0, digits]
    )
    |> apply maybeMinusP
    |> apply oneToNineP
    |> apply (many zeroToNineP)

parseNum = 
    \rawParser, numberStrParser, numberType, numberTypeName ->
        rawParser
        |> map \rawStr ->
            str = strFromRaw rawStr
            when numberStrParser str is
                Ok num -> Ok (numberType num)
                Err _ -> Err "`\(str)` is not a valid \(numberTypeName)"
        |> flatten

# intP : Parser RawStr Value
intP = parseNum rawIntP Str.toI64 Number "I64"

# dotP : Parser RawStr U8
dotP = codeunit '.'

# maybeDotP : Parser RawStr RawStr
maybeDotP = maybeCharP dotP ['.'] []

# rawFloatP : Parser RawStr RawStr
rawFloatP = 
    const (
        \rawInt -> \dot -> \digs -> 
            List.join [rawInt, dot, digs]
    )
    |> apply rawIntP
    |> apply maybeDotP
    |> apply (many zeroToNineP)

# floatP : Parser RawStr Value
floatP = parseNum rawFloatP Str.toF64 Float "F64"

# numberP : Parser RawStr Value
numberP = alt floatP intP

wsP = many (ignore (codeunitSatisfies (\c -> List.contains [' ', '\n', '\t', '\r', formfeedC, vtC] c)))

# arrayP : Parser RawStr Value
arrayP = 
    elements = sepBy valueP (codeunit ',')
    const (\_ -> \_ -> \vals -> \_ -> \_ -> vals)
    |> apply (codeunit '[')
    |> apply wsP
    |> apply elements
    |> apply wsP
    |> apply (codeunit ']')
    |> map (\vals -> Array vals)

# valueP : Parser RawStr Value
valueP = oneOf [nullP, trueP, falseP, strlitP, numberP, lazy (\{} -> arrayP)] # arrayP]

quoted = \str -> "\"\(str)\""

# inputs: List Str
inputs = [
    "null", "true", "false", quoted "null", "123", "-123", "-1.23", 
        quoted "newline: '\\n'",
        quoted "tab: '\\t'",
        quoted "quote: '\\\"' ", 
        quoted "forward slash : '\\/'", 
        quoted "back slash: '\\\\'", 
        quoted "backspace - expecting 'X' 'XX\\b'", 
        quoted "form feed: '\\f'", 
        quoted "    carriage return: \\rEND", 

]
# failing_inputs = ["a", "truetrue", "falsee", "\"null", "0123"]

# valToStr : Result Value [ParsingFailure Str, ParsingIncomplete Str] -> Str
valToStr = \val ->
    out = when val is
        Ok parseResult -> 
            when parseResult is 
                Null -> "null"
                Boolean b -> if b then "true" else "false"
                String s -> "\"\(s)\""
                Number n -> (
                    s = Num.toStr n
                    "\(s)")
                Float n -> (
                    s = Num.toStr n
                    "\(s)")
                Array _ -> "[]"
        Err e -> when e is 
            ParsingFailure s -> "parsing failure: \(s)"
            ParsingIncomplete s -> "parsing incomplete: \(s)"
    "\(out)\n"

# strToRaw : Str -> RawStr
strToRaw = \str ->
    str |> Str.toUtf8

# run: Str -> RawStr
run = \input -> 
    parseStr valueP input 
    |> valToStr
    |> strToRaw

# main: Str
main = 
    List.join (List.map inputs \input -> run input)
    |> strFromRaw