11 people like it.

Declarative argument parsing

A proof of concept on how one could build an argument parsing scheme simply by declaring a discriminated union.

 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: 

open System
open Microsoft.FSharp.Reflection


let createArgParser<'T> =
    let primParsers =
        dict [
            typeof<int>, fun x -> Int32.Parse x :> obj
            typeof<string>, fun x -> x :> obj
            typeof<bool>, fun x -> Boolean.Parse x :> obj
        ]

    let preComputeCaseInfo (uci : UnionCaseInfo) =
        let name = "--" + uci.Name.ToLower().Replace('_', '-')
        let fieldParsers = 
            uci.GetFields() 
            |> Array.map (
                fun f ->
                    if primParsers.ContainsKey f.PropertyType then primParsers.[f.PropertyType] 
                    else failwith "unsupported field." )

        name, (uci, fieldParsers)

    let idx = FSharpType.GetUnionCases typeof<'T> |> Seq.map preComputeCaseInfo |> Map.ofSeq

    let parseArg (pos : int ref, args : string []) =
        match idx.TryFind (args.[!pos]) with
        | None -> failwithf "invalid argument %s" args.[!pos]
        | Some (uci, fieldParsers) ->
            incr pos
            let fields = 
                [| 
                    for fp in fieldParsers do
                        yield fp args.[!pos]
                        incr pos
                |]

            FSharpValue.MakeUnion(uci, fields) :?> 'T

    let parse (args : string []) =
        let pos = ref 0
        [
            while !pos < args.Length do
                yield parseArg (pos, args)
        ]

    parse

// sample template

type CLArgs =
    | Host of string
    | Port of int
    | Working_Directory of string
    | Detach


let argP = createArgParser<CLArgs>

let dummy = [| "--port" ; "12" ; "--working-directory" ; "C:/temp" ; "--host" ; "localhost" ; "--port" ; "13" ; "--detach" |]

argP dummy
namespace System
namespace Microsoft
namespace Microsoft.FSharp
namespace Microsoft.FSharp.Reflection
val createArgParser<'T> : (string [] -> 'T list)

Full name: Script.createArgParser
val primParsers : Collections.Generic.IDictionary<Type,(string -> obj)>
val dict : keyValuePairs:seq<'Key * 'Value> -> Collections.Generic.IDictionary<'Key,'Value> (requires equality)

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.dict
val typeof<'T> : Type

Full name: Microsoft.FSharp.Core.Operators.typeof
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<_>
val x : string
type Int32 =
  struct
    member CompareTo : value:obj -> int + 1 overload
    member Equals : obj:obj -> bool + 1 overload
    member GetHashCode : unit -> int
    member GetTypeCode : unit -> TypeCode
    member ToString : unit -> string + 3 overloads
    static val MaxValue : int
    static val MinValue : int
    static member Parse : s:string -> int + 3 overloads
    static member TryParse : s:string * result:int -> bool + 1 overload
  end

Full name: System.Int32
Int32.Parse(s: string) : int
Int32.Parse(s: string, provider: IFormatProvider) : int
Int32.Parse(s: string, style: Globalization.NumberStyles) : int
Int32.Parse(s: string, style: Globalization.NumberStyles, provider: IFormatProvider) : int
type obj = Object

Full name: Microsoft.FSharp.Core.obj
Multiple items
val string : value:'T -> string

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

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

Full name: Microsoft.FSharp.Core.string
type bool = Boolean

Full name: Microsoft.FSharp.Core.bool
type Boolean =
  struct
    member CompareTo : obj:obj -> int + 1 overload
    member Equals : obj:obj -> bool + 1 overload
    member GetHashCode : unit -> int
    member GetTypeCode : unit -> TypeCode
    member ToString : unit -> string + 1 overload
    static val TrueString : string
    static val FalseString : string
    static member Parse : value:string -> bool
    static member TryParse : value:string * result:bool -> bool
  end

Full name: System.Boolean
Boolean.Parse(value: string) : bool
val preComputeCaseInfo : (UnionCaseInfo -> string * (UnionCaseInfo * (string -> obj) []))
val uci : UnionCaseInfo
type UnionCaseInfo
member GetCustomAttributes : unit -> obj []
member GetCustomAttributes : attributeType:Type -> obj []
member GetCustomAttributesData : unit -> IList<CustomAttributeData>
member GetFields : unit -> PropertyInfo []
member DeclaringType : Type
member Name : string
member Tag : int

Full name: Microsoft.FSharp.Reflection.UnionCaseInfo
val name : string
property UnionCaseInfo.Name: string
String.ToLower() : string
String.ToLower(culture: Globalization.CultureInfo) : string
val fieldParsers : (string -> obj) []
member UnionCaseInfo.GetFields : unit -> Reflection.PropertyInfo []
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
val map : mapping:('T -> 'U) -> array:'T [] -> 'U []

Full name: Microsoft.FSharp.Collections.Array.map
val f : Reflection.PropertyInfo
Collections.Generic.IDictionary.ContainsKey(key: Type) : bool
property Reflection.PropertyInfo.PropertyType: Type
val failwith : message:string -> 'T

Full name: Microsoft.FSharp.Core.Operators.failwith
val idx : Map<string,(UnionCaseInfo * (string -> obj) [])>
type FSharpType =
  static member GetExceptionFields : exceptionType:Type * ?bindingFlags:BindingFlags -> PropertyInfo []
  static member GetFunctionElements : functionType:Type -> Type * Type
  static member GetRecordFields : recordType:Type * ?bindingFlags:BindingFlags -> PropertyInfo []
  static member GetTupleElements : tupleType:Type -> Type []
  static member GetUnionCases : unionType:Type * ?bindingFlags:BindingFlags -> UnionCaseInfo []
  static member IsExceptionRepresentation : exceptionType:Type * ?bindingFlags:BindingFlags -> bool
  static member IsFunction : typ:Type -> bool
  static member IsModule : typ:Type -> bool
  static member IsRecord : typ:Type * ?bindingFlags:BindingFlags -> bool
  static member IsTuple : typ:Type -> bool
  ...

Full name: Microsoft.FSharp.Reflection.FSharpType
static member FSharpType.GetUnionCases : unionType:Type * ?allowAccessToPrivateRepresentation:bool -> UnionCaseInfo []
static member FSharpType.GetUnionCases : unionType:Type * ?bindingFlags:Reflection.BindingFlags -> UnionCaseInfo []
module Seq

from Microsoft.FSharp.Collections
val map : mapping:('T -> 'U) -> source:seq<'T> -> seq<'U>

Full name: Microsoft.FSharp.Collections.Seq.map
Multiple items
module Map

from Microsoft.FSharp.Collections

--------------------
type Map<'Key,'Value (requires comparison)> =
  interface IEnumerable
  interface IComparable
  interface IEnumerable<KeyValuePair<'Key,'Value>>
  interface ICollection<KeyValuePair<'Key,'Value>>
  interface IDictionary<'Key,'Value>
  new : elements:seq<'Key * 'Value> -> Map<'Key,'Value>
  member Add : key:'Key * value:'Value -> Map<'Key,'Value>
  member ContainsKey : key:'Key -> bool
  override Equals : obj -> bool
  member Remove : key:'Key -> Map<'Key,'Value>
  ...

Full name: Microsoft.FSharp.Collections.Map<_,_>

--------------------
new : elements:seq<'Key * 'Value> -> Map<'Key,'Value>
val ofSeq : elements:seq<'Key * 'T> -> Map<'Key,'T> (requires comparison)

Full name: Microsoft.FSharp.Collections.Map.ofSeq
val parseArg : (int ref * string [] -> 'T)
val pos : int 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 args : string []
member Map.TryFind : key:'Key -> 'Value option
union case Option.None: Option<'T>
val failwithf : format:Printf.StringFormat<'T,'Result> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.failwithf
union case Option.Some: Value: 'T -> Option<'T>
val incr : cell:int ref -> unit

Full name: Microsoft.FSharp.Core.Operators.incr
val fields : obj []
val fp : (string -> obj)
type FSharpValue =
  static member GetExceptionFields : exn:obj * ?bindingFlags:BindingFlags -> obj []
  static member GetRecordField : record:obj * info:PropertyInfo -> obj
  static member GetRecordFields : record:obj * ?bindingFlags:BindingFlags -> obj []
  static member GetTupleField : tuple:obj * index:int -> obj
  static member GetTupleFields : tuple:obj -> obj []
  static member GetUnionFields : value:obj * unionType:Type * ?bindingFlags:BindingFlags -> UnionCaseInfo * obj []
  static member MakeFunction : functionType:Type * implementation:(obj -> obj) -> obj
  static member MakeRecord : recordType:Type * values:obj [] * ?bindingFlags:BindingFlags -> obj
  static member MakeTuple : tupleElements:obj [] * tupleType:Type -> obj
  static member MakeUnion : unionCase:UnionCaseInfo * args:obj [] * ?bindingFlags:BindingFlags -> obj
  ...

Full name: Microsoft.FSharp.Reflection.FSharpValue
static member FSharpValue.MakeUnion : unionCase:UnionCaseInfo * args:obj [] * ?allowAccessToPrivateRepresentation:bool -> obj
static member FSharpValue.MakeUnion : unionCase:UnionCaseInfo * args:obj [] * ?bindingFlags:Reflection.BindingFlags -> obj
val parse : (string [] -> 'T list)
property Array.Length: int
type CLArgs =
  | Host of string
  | Port of int
  | Working_Directory of string
  | Detach

Full name: Script.CLArgs
union case CLArgs.Host: string -> CLArgs
union case CLArgs.Port: int -> CLArgs
union case CLArgs.Working_Directory: string -> CLArgs
union case CLArgs.Detach: CLArgs
val argP : (string [] -> CLArgs list)

Full name: Script.argP
val dummy : string []

Full name: Script.dummy
Raw view Test code New version

More information

Link:http://fssnip.net/gT
Posted:11 years ago
Author:Eirik Tsarpalis
Tags: argument parsing

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.