Support more types in Argu

arguru.fsx

type BOOM (str) =
    override __.ToString() = str
    static member Parse str =
        match str:string with
        | "boom" | "Boom" -> BOOM str
        | "BOOM" -> BOOM "GOES THE DYNAMITE"
        | _      -> failwith "can't go BOOM"

type POW (str) =
    override __.ToString() = str
    static member Parse str =
        match str:string with
        | "pow" | "Pow" | "POW" -> POW str
        | "explode" -> POW "MUSIC MAKES YOU LOSE CONTROL"
        | _     -> failwith "got no POW"


let trickyDict = parserDict [ mkComplexParser<BOOM> (); mkComplexParser<POW> () ]

type CLIArguments =
    | Listener of host:string * port:int
    | Detach | Boom of BOOM | Pow of POW
with 
    interface IArgParserTemplate with
        member s.Usage =
            match s with
            | Listener _ -> "specify a listener (hostname : port)."
            | Detach _   -> "detach daemon from console."
            | Boom _     -> "when I say boom"
            | Pow _      -> "you say pow"

let parser  = ArgumentParser.Create<CLIArguments>(parserDict=trickyDict)
let usage   = parser.Usage() |> printfn "%A"
let results = parser.Parse([| "--detach" ; "--listener" ; "localhost" ; "8080"; "--pow";"explode";"--boom";"BOOM" |]);;

results.GetAllResults() |> List.iter (printfn "%A")
printfn "%A" <| results.Contains <@ Boom @>;;
(*
    > Listener ("localhost",8080)
    Detach
    Boom GOES THE DYNAMITE
    Pow MUSIC MAKES YOU LOSE CONTROL
    true
*)

let results' = parser.Parse([| "--detach" ; "--listener" ; "localhost" ; "8080"; "--pow";"pow";"--boom";"boom" |])
results'.GetAllResults() |> List.iter (printfn "%A");;
(*
    >
    Listener ("localhost",8080)
    Detach
    Boom boom
    Pow pow
*)

// To add this functionality I changed `preComputeArgInfo` to:

let preComputeArgInfo (parserDict:Collections.Generic.IDictionary<_,_> )(uci : UnionCaseInfo) =
// (...)
// with the code of `parsers` changes to:
    let printLabels = uci.ContainsAttr<PrintLabelsAttribute> (true)
    
    let parsers =
        let getParser (p : PropertyInfo) =
            let label = if printLabels then Some p.Name else None
            match primitiveParsers.TryFind p.PropertyType with
            | Some f -> f label
            | None -> 
                match parserDict.TryFind p.PropertyType with
                | Some f -> f label
                | None -> 
                    failwithf "Argu: template contains unsupported field of type '%O'." p.PropertyType


// implemented two helper functions to build the dictionary of additional parsers

let inline mkComplexParser< ^a when ^a:(static member Parse:string -> ^a)>() = 
    (typeof< ^a>, ParserInfo.Create< ^a> (typeof< ^a>.Name) (fun str -> 
        (^a:(static member Parse:string -> ^a) str)) string)

let parserDict (parsers:(Type*(string option -> ParserInfo)) seq) = dict parsers

// changed the implementation of Argument Parser

type ArgumentParser =
    
    static member Create<'Template when 'Template :> IArgParserTemplate>(?usageText : string, ?parserDict:IDictionary<Type,(string option -> ParserInfo)>) =
        new ArgumentParser<'Template>(?usageText = usageText, ?parsers = parserDict)

and ArgumentParser<'Template when 'Template :> IArgParserTemplate> internal (?usageText : string,?parsers:IDictionary<Type,(string option -> ParserInfo)> ) =
    do 
        if not <| FSharpType.IsUnion(typeof<'Template>, bindingFlags = allBindings) then
            invalidArg typeof<'Template>.Name "Argu: template type inaccessible or not F# DU."

    let parserDict = 
        match parsers with 
        | Some d -> d 
        | None -> Dictionary<_,_>() :> IDictionary<_,_>

    let argInfo =
        FSharpType.GetUnionCases(typeof<'Template>, bindingFlags = allBindings)
        |> Seq.map (preComputeArgInfo parserDict)
        |> Seq.sortBy (fun a -> a.UCI.Tag)
        |> Seq.toList