0 people like it.

Toml parser (untyped)

Untyped version of toml parser. The lines of code was reduced 173 to 45. It's based on some implementations in other languages (https://github.com/mojombo/toml#implementations). I was surprised that even a parser written in Objctive-c was simpler than mine (http://fssnip.net/jd). Then I read some others code and found that removing types which describes toml values simplifies the implementation. The code may seem little crazy, but I'm fine :)

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 
24: 
25: 
26: 
27: 
28: 
29: 
30: 
31: 
32: 
33: 
34: 
35: 
36: 
37: 
38: 
39: 
40: 
41: 
42: 
43: 
44: 
45: 

module Toml
// based on https://github.com/mackwic/To.ml and https://github.com/seliopou/toml
open System
open FParsec
type Token = KeyGroup of string list | KeyValue of string * obj

let (<||>) p1 p2 = attempt (p1 |>> box) <|> attempt (p2 |>> box)
let spc      = many (anyOf [' '; '\t']) 
let lexeme s = pstring s .>> spc
let lexemel s= pstring s .>> spaces
let comment  = pchar '#' .>>. restOfLine false 
let blanks   = skipMany ((comment <||> spc) .>> newline .>> spc) .>> spc
let brace p  = between (lexemel "[") (lexemel "]") p
let pbool    = (lexeme "true" >>% true) <|> (lexeme "false" >>% false)
let pstr     = between (lexeme "\"") (lexeme "\"") (manySatisfy ((<>)'"'))
let pdate' s = try preturn (DateTime.Parse (s, null, Globalization.DateTimeStyles.RoundtripKind)) with _ -> fail ""
let pdate    = between spc spc (anyString 20) >>= pdate'
let ary elem = brace (sepBy (elem .>> spaces) (lexemel ","))
let pary     = ary pbool <||> ary pdate <||> ary pint32 <||> ary pstr <||> ary pfloat
let value    = pbool <||> pdate <||> pstr <||> pfloat <||> pint32 <||> pary <||> ary pary
let kvKey    = many1Chars (noneOf " \t\n=")
let keyvalue = (kvKey .>> spc) .>>. (lexeme "=" >>. value) |>> KeyValue
let kgKey    = (many1Chars (noneOf " \t\n].")) .>> spc
let keygroup = blanks >>. brace (sepBy kgKey (lexeme ".")) |>> KeyGroup
let document = blanks >>. many (keygroup <|> keyvalue .>> blanks)

let parse text =
  let toml = Collections.Generic.Dictionary<string, obj>()
  let currentKg = ref []
  match run document text with
  | Success(tokens,_,_) ->
    for token in tokens do
      match token with
      | KeyGroup kg -> currentKg := kg
      | KeyValue (key,value) -> 
        let key = String.concat "." [ yield! !currentKg; yield key]
        toml.Add(key, value)
  | __ -> ()
  toml

let example = toml example

for tomlValue in parse example do
  printfn "%A" tomlValue
Console.ReadLine() |> ignore
module Toml
namespace System
namespace FParsec
type Token =
  | KeyGroup of string list
  | KeyValue of string * obj

Full name: Toml.Token
union case Token.KeyGroup: string list -> Token
Multiple items
val string : value:'T -> string

Full name: Microsoft.FSharp.Core.Operators.string

--------------------
type string = String

Full name: Microsoft.FSharp.Core.string
type 'T list = List<'T>

Full name: Microsoft.FSharp.Collections.list<_>
Multiple items
union case Token.KeyValue: string * obj -> Token

--------------------
active recognizer KeyValue: Collections.Generic.KeyValuePair<'Key,'Value> -> 'Key * 'Value

Full name: Microsoft.FSharp.Core.Operators.( |KeyValue| )
type obj = Object

Full name: Microsoft.FSharp.Core.obj
val p1 : Parser<'a,'b>
val p2 : Parser<'c,'b>
val attempt : Parser<'a,'u> -> Parser<'a,'u>

Full name: FParsec.Primitives.attempt
val box : value:'T -> obj

Full name: Microsoft.FSharp.Core.Operators.box
val spc : Parser<char list,unit>

Full name: Toml.spc
val many : Parser<'a,'u> -> Parser<'a list,'u>

Full name: FParsec.Primitives.many
val anyOf : seq<char> -> Parser<char,'u>

Full name: FParsec.CharParsers.anyOf
val lexeme : s:string -> Parser<string,unit>

Full name: Toml.lexeme
val s : string
val pstring : string -> Parser<string,'u>

Full name: FParsec.CharParsers.pstring
val lexemel : s:string -> Parser<string,'a>

Full name: Toml.lexemel
val spaces : Parser<unit,'u>

Full name: FParsec.CharParsers.spaces
val comment : Parser<(char * string),unit>

Full name: Toml.comment
val pchar : char -> Parser<char,'u>

Full name: FParsec.CharParsers.pchar
val restOfLine : bool -> Parser<string,'u>

Full name: FParsec.CharParsers.restOfLine
val blanks : Parser<unit,unit>

Full name: Toml.blanks
val skipMany : Parser<'a,'u> -> Parser<unit,'u>

Full name: FParsec.Primitives.skipMany
val newline<'u> : Parser<char,'u>

Full name: FParsec.CharParsers.newline
val brace : p:Parser<'a,'b> -> Parser<'a,'b>

Full name: Toml.brace
val p : Parser<'a,'b>
val between : Parser<'a,'u> -> Parser<'b,'u> -> Parser<'c,'u> -> Parser<'c,'u>

Full name: FParsec.Primitives.between
val pbool : Parser<bool,unit>

Full name: Toml.pbool
val pstr : Parser<string,unit>

Full name: Toml.pstr
val manySatisfy : (char -> bool) -> Parser<string,'u>

Full name: FParsec.CharParsers.manySatisfy
val pdate' : s:string -> Parser<DateTime,'a>

Full name: Toml.pdate'
val preturn : 'a -> Parser<'a,'u>

Full name: FParsec.Primitives.preturn
Multiple items
type DateTime =
  struct
    new : ticks:int64 -> DateTime + 10 overloads
    member Add : value:TimeSpan -> DateTime
    member AddDays : value:float -> DateTime
    member AddHours : value:float -> DateTime
    member AddMilliseconds : value:float -> DateTime
    member AddMinutes : value:float -> DateTime
    member AddMonths : months:int -> DateTime
    member AddSeconds : value:float -> DateTime
    member AddTicks : value:int64 -> DateTime
    member AddYears : value:int -> DateTime
    ...
  end

Full name: System.DateTime

--------------------
DateTime()
   (+0 other overloads)
DateTime(ticks: int64) : unit
   (+0 other overloads)
DateTime(ticks: int64, kind: DateTimeKind) : unit
   (+0 other overloads)
DateTime(year: int, month: int, day: int) : unit
   (+0 other overloads)
DateTime(year: int, month: int, day: int, calendar: Globalization.Calendar) : unit
   (+0 other overloads)
DateTime(year: int, month: int, day: int, hour: int, minute: int, second: int) : unit
   (+0 other overloads)
DateTime(year: int, month: int, day: int, hour: int, minute: int, second: int, kind: DateTimeKind) : unit
   (+0 other overloads)
DateTime(year: int, month: int, day: int, hour: int, minute: int, second: int, calendar: Globalization.Calendar) : unit
   (+0 other overloads)
DateTime(year: int, month: int, day: int, hour: int, minute: int, second: int, millisecond: int) : unit
   (+0 other overloads)
DateTime(year: int, month: int, day: int, hour: int, minute: int, second: int, millisecond: int, kind: DateTimeKind) : unit
   (+0 other overloads)
DateTime.Parse(s: string) : DateTime
DateTime.Parse(s: string, provider: IFormatProvider) : DateTime
DateTime.Parse(s: string, provider: IFormatProvider, styles: Globalization.DateTimeStyles) : DateTime
namespace System.Globalization
type DateTimeStyles =
  | None = 0
  | AllowLeadingWhite = 1
  | AllowTrailingWhite = 2
  | AllowInnerWhite = 4
  | AllowWhiteSpaces = 7
  | NoCurrentDateDefault = 8
  | AdjustToUniversal = 16
  | AssumeLocal = 32
  | AssumeUniversal = 64
  | RoundtripKind = 128

Full name: System.Globalization.DateTimeStyles
field Globalization.DateTimeStyles.RoundtripKind = 128
val fail : string -> Parser<'a,'u>

Full name: FParsec.Primitives.fail
val pdate : Parser<DateTime,unit>

Full name: Toml.pdate
val anyString : int32 -> Parser<string,'u>

Full name: FParsec.CharParsers.anyString
val ary : elem:Parser<'a,'b> -> Parser<'a list,'b>

Full name: Toml.ary
val elem : Parser<'a,'b>
val sepBy : Parser<'a,'u> -> Parser<'b,'u> -> Parser<'a list,'u>

Full name: FParsec.Primitives.sepBy
val pary : Parser<obj,unit>

Full name: Toml.pary
val pint32 : Parser<int32,'u>

Full name: FParsec.CharParsers.pint32
val pfloat : Parser<float,'u>

Full name: FParsec.CharParsers.pfloat
val value : Parser<obj,unit>

Full name: Toml.value
val kvKey : Parser<string,unit>

Full name: Toml.kvKey
val many1Chars : Parser<char,'u> -> Parser<string,'u>

Full name: FParsec.CharParsers.many1Chars
val noneOf : seq<char> -> Parser<char,'u>

Full name: FParsec.CharParsers.noneOf
val keyvalue : Parser<Token,unit>

Full name: Toml.keyvalue
union case Token.KeyValue: string * obj -> Token
val kgKey : Parser<string,unit>

Full name: Toml.kgKey
val keygroup : Parser<Token,unit>

Full name: Toml.keygroup
val document : Parser<Token list,unit>

Full name: Toml.document
val parse : text:string -> Collections.Generic.Dictionary<string,obj>

Full name: Toml.parse
val text : string
val toml : Collections.Generic.Dictionary<string,obj>
Multiple items
namespace System.Collections

--------------------
namespace Microsoft.FSharp.Collections
namespace System.Collections.Generic
Multiple items
type Dictionary<'TKey,'TValue> =
  new : unit -> Dictionary<'TKey, 'TValue> + 5 overloads
  member Add : key:'TKey * value:'TValue -> unit
  member Clear : unit -> unit
  member Comparer : IEqualityComparer<'TKey>
  member ContainsKey : key:'TKey -> bool
  member ContainsValue : value:'TValue -> bool
  member Count : int
  member GetEnumerator : unit -> Enumerator<'TKey, 'TValue>
  member GetObjectData : info:SerializationInfo * context:StreamingContext -> unit
  member Item : 'TKey -> 'TValue with get, set
  ...
  nested type Enumerator
  nested type KeyCollection
  nested type ValueCollection

Full name: System.Collections.Generic.Dictionary<_,_>

--------------------
Collections.Generic.Dictionary() : unit
Collections.Generic.Dictionary(capacity: int) : unit
Collections.Generic.Dictionary(comparer: Collections.Generic.IEqualityComparer<'TKey>) : unit
Collections.Generic.Dictionary(dictionary: Collections.Generic.IDictionary<'TKey,'TValue>) : unit
Collections.Generic.Dictionary(capacity: int, comparer: Collections.Generic.IEqualityComparer<'TKey>) : unit
Collections.Generic.Dictionary(dictionary: Collections.Generic.IDictionary<'TKey,'TValue>, comparer: Collections.Generic.IEqualityComparer<'TKey>) : unit
val currentKg : string list ref
Multiple items
val ref : value:'T -> 'T ref

Full name: Microsoft.FSharp.Core.Operators.ref

--------------------
type 'T ref = Ref<'T>

Full name: Microsoft.FSharp.Core.ref<_>
val run : Parser<'Result,unit> -> string -> ParserResult<'Result,unit>

Full name: FParsec.CharParsers.run
union case ParserResult.Success: 'Result * 'UserState * Position -> ParserResult<'Result,'UserState>
val tokens : Token list
val token : Token
val kg : string list
val key : string
val value : obj
Multiple items
type String =
  new : value:char -> string + 7 overloads
  member Chars : int -> char
  member Clone : unit -> obj
  member CompareTo : value:obj -> int + 1 overload
  member Contains : value:string -> bool
  member CopyTo : sourceIndex:int * destination:char[] * destinationIndex:int * count:int -> unit
  member EndsWith : value:string -> bool + 2 overloads
  member Equals : obj:obj -> bool + 2 overloads
  member GetEnumerator : unit -> CharEnumerator
  member GetHashCode : unit -> int
  ...

Full name: System.String

--------------------
String(value: nativeptr<char>) : unit
String(value: nativeptr<sbyte>) : unit
String(value: char []) : unit
String(c: char, count: int) : unit
String(value: nativeptr<char>, startIndex: int, length: int) : unit
String(value: nativeptr<sbyte>, startIndex: int, length: int) : unit
String(value: char [], startIndex: int, length: int) : unit
String(value: nativeptr<sbyte>, startIndex: int, length: int, enc: Text.Encoding) : unit
val concat : sep:string -> strings:seq<string> -> string

Full name: Microsoft.FSharp.Core.String.concat
Collections.Generic.Dictionary.Add(key: string, value: obj) : unit
val __ : ParserResult<Token list,unit>
val example : string

Full name: Toml.example
"""
[group1]
key = true
key2 = 1337
title = "TOML Example"

[ owner]
name = "Tom Preston-Werner"
organization = "GitHub"
bio = "GitHub Cofounder & CEO\nLikes tater tots and beer."
dob = 1979-05-27T07:32:00Z # First class dates? Why not?

[database ]
server= "192.168.1.1"
ports = [ 8001,8001 , 8002]
connection_max =5000
enabled=true

[servers]

  # You can indent as you please. Tabs or spaces. TOML don't care.
  [ servers .alpha]
  ip = "10.0.0.1"
  dc = "eqdc10"

  [servers. beta ]
  ip = "10.0.0.2"
  dc = "eqdc10"

[clients]
data = [ ["gamma","delta"], [1, 2] ] # just an update to make sure parsers support it

# Line breaks are OK when inside arrays
hosts = [
  "alpha",
  "omega"
  ]
"""
val tomlValue : Collections.Generic.KeyValuePair<string,obj>
val printfn : format:Printf.TextWriterFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.printfn
type Console =
  static member BackgroundColor : ConsoleColor with get, set
  static member Beep : unit -> unit + 1 overload
  static member BufferHeight : int with get, set
  static member BufferWidth : int with get, set
  static member CapsLock : bool
  static member Clear : unit -> unit
  static member CursorLeft : int with get, set
  static member CursorSize : int with get, set
  static member CursorTop : int with get, set
  static member CursorVisible : bool with get, set
  ...

Full name: System.Console
Console.ReadLine() : string
val ignore : value:'T -> unit

Full name: Microsoft.FSharp.Core.Operators.ignore
Raw view Test code New version

More information

Link:http://fssnip.net/jf
Posted:11 years ago
Author:nagat01
Tags: fparsec , parser , language

This web site is created using F# and Suave web server. It is hosted on Azure and the source code is on GitHub. Contributions are welcome!

The first version of fssnip.net has been created by @tomaspetricek back in 2010. This web site is a new, open-source and contribution-friendly version.