5 people like it.

Toml parser

Parser for Tom's Obvious, Minimal Language (https://github.com/mojombo/toml).

  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: 
 46: 
 47: 
 48: 
 49: 
 50: 
 51: 
 52: 
 53: 
 54: 
 55: 
 56: 
 57: 
 58: 
 59: 
 60: 
 61: 
 62: 
 63: 
 64: 
 65: 
 66: 
 67: 
 68: 
 69: 
 70: 
 71: 
 72: 
 73: 
 74: 
 75: 
 76: 
 77: 
 78: 
 79: 
 80: 
 81: 
 82: 
 83: 
 84: 
 85: 
 86: 
 87: 
 88: 
 89: 
 90: 
 91: 
 92: 
 93: 
 94: 
 95: 
 96: 
 97: 
 98: 
 99: 
100: 
101: 
102: 
103: 
104: 
105: 
106: 
107: 
108: 
109: 
110: 
111: 
112: 
113: 
114: 
115: 
116: 
117: 
118: 
119: 
120: 
121: 
122: 
123: 
124: 
125: 
126: 
127: 
128: 
129: 
130: 
131: 
132: 
133: 
134: 
135: 
136: 
137: 

// based on 
// https://github.com/mackwic/To.ml
// https://github.com/seliopou/toml

open System
open System.Globalization

[<RequireQualifiedAccess>]
type NodeArray =
  | Bools   of bool   list
  | Ints    of int    list
  | Floats  of float  list
  | Strings of string list
  | Dates   of DateTime list
  | Arrays  of NodeArray list 
  override __.ToString () =
    let inline f xs = List.map string xs |> String.concat ", "
    match __ with
    | Bools   bs -> f bs 
    | Ints    is -> f is 
    | Floats  fs -> f fs
    | Strings ss -> f ss
    | Dates   ds -> f ds
    | Arrays ars -> f ars

[<RequireQualifiedAccess>]
type TomlValue =
  | Bool   of bool
  | Int    of int
  | Float  of float
  | String of string
  | Date   of DateTime
  | Array  of NodeArray
  override __.ToString () =
    match __ with
    | Bool   b -> sprintf "TBool(%b)"   b
    | Int    i -> sprintf "TInt(%d)"    i
    | Float  f -> sprintf "TFloat(%f)"  f
    | String s -> sprintf "TString(%s)" s
    | Date   d -> sprintf "TDate(%A)" d
    | Array  a -> sprintf "[%O]" a

type Token = KeyGroup of string list | KeyValue of string * TomlValue

open FParsec

let spc = many (anyOf [' '; '\t']) |>> ignore
let lexeme p = p .>> spc
let comment = pchar '#' .>>. restOfLine false |>> ignore
let line p = p .>> lexeme newline
let blanks = lexeme (skipMany ((comment <|> spc) .>> lexeme newline))


let ls s = lexeme <| pstring s
let zee    = ls "Z"
let quote  = ls "\""
let lbrace = pstring "[" .>> spaces
let rbrace = pstring "]" .>> spaces
let comma  = pstring "," .>> spaces
let period = ls "."
let equal  = ls "="
let ptrue  = ls "true"  >>% true
let pfalse = ls "false" >>% false

let pdate' = 
    fun s -> 
      try preturn (DateTime.Parse (s, null, DateTimeStyles.RoundtripKind))               
      with _ -> fail "date format error"


let pbool  = ptrue <|> pfalse <?> "pbool"
let pstr   = between quote quote (manySatisfy ((<>)'"')) <?> "pstr"
let pint   = attempt pint32 <?> "pint"
let pfloat = attempt pfloat <?> "pfloat"
let pdate  = attempt (spc >>. anyString 20 .>> spc >>= pdate') <?> "pdate"

let parray elem = attempt (between lbrace rbrace (sepBy (elem .>> spaces) comma))
let pboolarray  = parray pbool  |>> NodeArray.Bools   <?> "pboolarray"
let pdatearray  = parray pdate  |>> NodeArray.Dates   <?> "pdatearray"
let pintarray   = parray pint   |>> NodeArray.Ints    <?> "pintarray"
let pstrarray   = parray pstr   |>> NodeArray.Strings <?> "pstrarray"
let pfloatarray = parray pfloat |>> NodeArray.Floats  <?> "pfloatarray"
let rec parrayarray = 
  parray (pboolarray <|> pdatearray <|> pintarray <|> pstrarray <|> pfloatarray) 
  |>> NodeArray.Arrays <?> "parrayarray"

let value = 
  (pbool       |>> TomlValue.Bool ) <|> 
  (pdate       |>> TomlValue.Date ) <|> 
  (pstr        |>> TomlValue.String)<|> 
  (pfloat      |>> TomlValue.Float) <|> 
  (pint        |>> TomlValue.Int  ) <|> 
  (pboolarray  |>> TomlValue.Array) <|>
  (pdatearray  |>> TomlValue.Array) <|>
  (pintarray   |>> TomlValue.Array) <|>
  (pstrarray   |>> TomlValue.Array) <|>
  (pfloatarray |>> TomlValue.Array) <|>
  (parrayarray |>> TomlValue.Array)
  
let keyvalue = 
  let key = many1Chars (noneOf " \t\n=")
  lexeme key .>>. (equal >>. value) |>> KeyValue

let keygroup = 
  let key = lexeme (many1Chars (noneOf " \t\n]."))
  blanks >>. between lbrace rbrace (sepBy key period) |>> KeyGroup

let document = blanks >>. many (keygroup <|> keyvalue .>> blanks)


let example = (...)

open System.Collections.Generic
let toml = Dictionary<string, TomlValue>()
let mutable currentKeyGroup = None

try
let result = run document example
match result with
| Success(tokens,_,_) ->
  for token in tokens do
    match token with
    | KeyGroup kg -> currentKeyGroup <- Some kg
    | KeyValue (key,value) -> 
      let key = 
        seq {
        if currentKeyGroup.IsSome then
          yield! currentKeyGroup.Value
        yield key
        } |> String.concat "."
      toml.Add(key, value)
| _ -> ()

with e -> ()

for token in toml do
  printfn "%A" token
namespace System
namespace System.Globalization
Multiple items
type RequireQualifiedAccessAttribute =
  inherit Attribute
  new : unit -> RequireQualifiedAccessAttribute

Full name: Microsoft.FSharp.Core.RequireQualifiedAccessAttribute

--------------------
new : unit -> RequireQualifiedAccessAttribute
type NodeArray =
  | Bools of bool list
  | Ints of int list
  | Floats of float list
  | Strings of string list
  | Dates of DateTime list
  | Arrays of NodeArray list
  override ToString : unit -> string

Full name: Script.NodeArray
union case NodeArray.Bools: bool list -> NodeArray
type bool = Boolean

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

Full name: Microsoft.FSharp.Collections.list<_>
union case NodeArray.Ints: int list -> NodeArray
Multiple items
val int : value:'T -> int (requires member op_Explicit)

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

--------------------
type int = int32

Full name: Microsoft.FSharp.Core.int

--------------------
type int<'Measure> = int

Full name: Microsoft.FSharp.Core.int<_>
union case NodeArray.Floats: float list -> NodeArray
Multiple items
val float : value:'T -> float (requires member op_Explicit)

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

--------------------
type float = Double

Full name: Microsoft.FSharp.Core.float

--------------------
type float<'Measure> = float

Full name: Microsoft.FSharp.Core.float<_>
union case NodeArray.Strings: string list -> NodeArray
Multiple items
val string : value:'T -> string

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

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

Full name: Microsoft.FSharp.Core.string
union case NodeArray.Dates: DateTime list -> NodeArray
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: 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: 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)
union case NodeArray.Arrays: NodeArray list -> NodeArray
override NodeArray.ToString : unit -> string

Full name: Script.NodeArray.ToString
val f : ('a list -> string)
val xs : 'a list
Multiple items
module List

from Microsoft.FSharp.Collections

--------------------
type List<'T> =
  | ( [] )
  | ( :: ) of Head: 'T * Tail: 'T list
  interface IEnumerable
  interface IEnumerable<'T>
  member Head : 'T
  member IsEmpty : bool
  member Item : index:int -> 'T with get
  member Length : int
  member Tail : 'T list
  static member Cons : head:'T * tail:'T list -> 'T list
  static member Empty : 'T list

Full name: Microsoft.FSharp.Collections.List<_>
val map : mapping:('T -> 'U) -> list:'T list -> 'U list

Full name: Microsoft.FSharp.Collections.List.map
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
val __ : NodeArray
val bs : bool list
val is : int list
val fs : float list
val ss : string list
val ds : DateTime list
val ars : NodeArray list
type TomlValue =
  | Bool of bool
  | Int of int
  | Float of float
  | String of string
  | Date of DateTime
  | Array of NodeArray
  override ToString : unit -> string

Full name: Script.TomlValue
union case TomlValue.Bool: bool -> TomlValue
union case TomlValue.Int: int -> TomlValue
union case TomlValue.Float: float -> TomlValue
Multiple items
union case TomlValue.String: string -> TomlValue

--------------------
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
union case TomlValue.Date: DateTime -> TomlValue
Multiple items
union case TomlValue.Array: NodeArray -> TomlValue

--------------------
type Array =
  member Clone : unit -> obj
  member CopyTo : array:Array * index:int -> unit + 1 overload
  member GetEnumerator : unit -> IEnumerator
  member GetLength : dimension:int -> int
  member GetLongLength : dimension:int -> int64
  member GetLowerBound : dimension:int -> int
  member GetUpperBound : dimension:int -> int
  member GetValue : [<ParamArray>] indices:int[] -> obj + 7 overloads
  member Initialize : unit -> unit
  member IsFixedSize : bool
  ...

Full name: System.Array
override TomlValue.ToString : unit -> string

Full name: Script.TomlValue.ToString
val __ : TomlValue
val b : bool
val sprintf : format:Printf.StringFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.sprintf
val i : int
val f : float
val s : string
val d : DateTime
val a : NodeArray
type Token =
  | KeyGroup of string list
  | KeyValue of string * TomlValue

Full name: Script.Token
union case Token.KeyGroup: string list -> Token
Multiple items
union case Token.KeyValue: string * TomlValue -> Token

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

Full name: Microsoft.FSharp.Core.Operators.( |KeyValue| )
namespace FParsec
val spc : Parser<unit,unit>

Full name: Script.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 ignore : value:'T -> unit

Full name: Microsoft.FSharp.Core.Operators.ignore
val lexeme : p:Parser<'a,unit> -> Parser<'a,unit>

Full name: Script.lexeme
val p : Parser<'a,unit>
val comment : Parser<unit,unit>

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

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

Full name: FParsec.CharParsers.restOfLine
val line : p:Parser<'a,unit> -> Parser<'a,unit>

Full name: Script.line
val newline<'u> : Parser<char,'u>

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

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

Full name: FParsec.Primitives.skipMany
val ls : s:string -> Parser<string,unit>

Full name: Script.ls
val pstring : string -> Parser<string,'u>

Full name: FParsec.CharParsers.pstring
val zee : Parser<string,unit>

Full name: Script.zee
val quote : Parser<string,unit>

Full name: Script.quote
val lbrace : Parser<string,unit>

Full name: Script.lbrace
val spaces : Parser<unit,'u>

Full name: FParsec.CharParsers.spaces
val rbrace : Parser<string,unit>

Full name: Script.rbrace
val comma : Parser<string,unit>

Full name: Script.comma
val period : Parser<string,unit>

Full name: Script.period
val equal : Parser<string,unit>

Full name: Script.equal
val ptrue : Parser<bool,unit>

Full name: Script.ptrue
val pfalse : Parser<bool,unit>

Full name: Script.pfalse
val pdate' : s:string -> Parser<DateTime,'a>

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

Full name: FParsec.Primitives.preturn
DateTime.Parse(s: string) : DateTime
DateTime.Parse(s: string, provider: IFormatProvider) : DateTime
DateTime.Parse(s: string, provider: IFormatProvider, styles: DateTimeStyles) : DateTime
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 DateTimeStyles.RoundtripKind = 128
val fail : string -> Parser<'a,'u>

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

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

Full name: Script.pstr
val between : Parser<'a,'u> -> Parser<'b,'u> -> Parser<'c,'u> -> Parser<'c,'u>

Full name: FParsec.Primitives.between
val manySatisfy : (char -> bool) -> Parser<string,'u>

Full name: FParsec.CharParsers.manySatisfy
val pint : Parser<int32,unit>

Full name: Script.pint
val attempt : Parser<'a,'u> -> Parser<'a,'u>

Full name: FParsec.Primitives.attempt
val pint32 : Parser<int32,'u>

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

Full name: Script.pfloat
val pdate : Parser<DateTime,unit>

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

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

Full name: Script.parray
val elem : Parser<'a,unit>
val sepBy : Parser<'a,'u> -> Parser<'b,'u> -> Parser<'a list,'u>

Full name: FParsec.Primitives.sepBy
val pboolarray : Parser<NodeArray,unit>

Full name: Script.pboolarray
val pdatearray : Parser<NodeArray,unit>

Full name: Script.pdatearray
val pintarray : Parser<NodeArray,unit>

Full name: Script.pintarray
val pstrarray : Parser<NodeArray,unit>

Full name: Script.pstrarray
val pfloatarray : Parser<NodeArray,unit>

Full name: Script.pfloatarray
val parrayarray : Parser<NodeArray,unit>

Full name: Script.parrayarray
val value : Parser<TomlValue,unit>

Full name: Script.value
union case TomlValue.String: string -> TomlValue
union case TomlValue.Array: NodeArray -> TomlValue
val keyvalue : Parser<Token,unit>

Full name: Script.keyvalue
val key : Parser<string,unit>
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
union case Token.KeyValue: string * TomlValue -> Token
val keygroup : Parser<Token,unit>

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

Full name: Script.document
val example : string

Full name: Script.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"
  ]
"""
namespace System.Collections
namespace System.Collections.Generic
val toml : Dictionary<string,TomlValue>

Full name: Script.toml
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<_,_>

--------------------
Dictionary() : unit
Dictionary(capacity: int) : unit
Dictionary(comparer: IEqualityComparer<'TKey>) : unit
Dictionary(dictionary: IDictionary<'TKey,'TValue>) : unit
Dictionary(capacity: int, comparer: IEqualityComparer<'TKey>) : unit
Dictionary(dictionary: IDictionary<'TKey,'TValue>, comparer: IEqualityComparer<'TKey>) : unit
val mutable currentKeyGroup : string list option

Full name: Script.currentKeyGroup
union case Option.None: Option<'T>
val result : ParserResult<Token list,unit>
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
union case Option.Some: Value: 'T -> Option<'T>
val key : string
val value : TomlValue
Multiple items
val seq : sequence:seq<'T> -> seq<'T>

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

--------------------
type seq<'T> = IEnumerable<'T>

Full name: Microsoft.FSharp.Collections.seq<_>
property Option.IsSome: bool
property Option.Value: string list
Dictionary.Add(key: string, value: TomlValue) : unit
val e : exn
val token : KeyValuePair<string,TomlValue>
val printfn : format:Printf.TextWriterFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.printfn
Raw view Test code New version

More information

Link:http://fssnip.net/jd
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.