F# applicative CLI option parser

opt-parse.fs

let readInt (s:string) = 
  match System.Int32.TryParse s with
  | true,i -> Some i
  | _ -> None

type Opt<'a> = Opt of name:string * defaultValue:'a option * read:(string -> 'a option)
  with
    static member Name<'a> (Opt(n,_,_) : Opt<'a>) = n
    static member Read<'a> (Opt(_,_,r) : Opt<'a>) = r
    static member Default<'a> (Opt(_,d,_) : Opt<'a>) = d
    static member Map (f:'a -> 'b) (a:Opt<'a>) =
      let (Opt(n,d,r)) = a in Opt (n,Option.map f d, r >> Option.map f)


type OptAp<'a> = 
  | PureOpt of 'a
  | ApOpt of (Opt<obj -> 'a>) * OptAp<obj>  
  with

    static member Map<'a, 'b> (f:'a -> 'b) (a:OptAp<'a>) : OptAp<'b> =
      match a with
      | PureOpt a -> PureOpt (f a)
      | ApOpt (x,y) -> ApOpt (Opt.Map (fun g -> g >> f) x,y)
    
    static member Size<'a> (a:OptAp<'a>) : int =
      match a with
      | PureOpt _ -> 1
      | ApOpt (a,b) -> 1 + OptAp.Size b

    static member AllOpts<'a> (a:OptAp<'a>) : string list =
      match a with
      | PureOpt x -> []
      | ApOpt (a,b) -> [Opt.Name a] @ OptAp.AllOpts b
    
    static member Ap<'b> (fa:OptAp<'a -> 'b>) (y:OptAp<'a>) : OptAp<'b> =
      match fa with
      | PureOpt f -> OptAp.Map f y
      | ApOpt (h,x) ->
        let h : Opt<obj -> 'b> =
          Opt.Map (
            fun f o ->
              match o with
              | :? (obj * 'a) as x -> let o,a = x in f o a
              | _ -> failwith "unreachable") h
        let x = OptAp.Map (fun o a -> box (o,a)) x
        OptAp.ApOpt (h, OptAp.Ap x y)
                
    static member Merge<'a, 'b> (a:OptAp<'a>) (b:OptAp<'b>) : OptAp<'a * 'b> =
      OptAp.Ap (OptAp.Map (fun a b -> a,b) a) b

    static member Default<'a> (o:OptAp<'a>) : 'a option =
      match o with
      | PureOpt a -> Some a
      | ApOpt (a,b) -> 
        match (Opt.Default a),(OptAp.Default b) with
        | Some f, Some x -> Some (f x)
        | _ -> None

    static member MatchOpt (opt:string) (value:string) (o:OptAp<'a>) : OptAp<'a> option =
      match o with
      | PureOpt _ -> None
      | ApOpt (g,x) -> 
        if opt = "--" + Opt.Name g then Option.map (fun f -> OptAp.Map f x) (Opt.Read g value)
        else Option.map (fun f -> ApOpt(g,f)) (OptAp.MatchOpt opt value x)
      
    static member Run (p:OptAp<'a>) (args:string list) : 'a option =
      match args with
      | [] -> OptAp.Default p
      | opt::value::args -> 
        match OptAp.MatchOpt opt value p with
        | Some p' -> OptAp.Run p' args
        | None -> None
      | _ -> None
      
      

let one (o:Opt<'a>) : OptAp<'a> = 
  OptAp.ApOpt (Opt.Map (fun a _ -> a) o, PureOpt (Unchecked.defaultof<_>))


/// a type to parse
type User = User of un:string * fn:string * id:int

/// define an option parser for User
let user = 
  OptAp.Ap 
    (OptAp.Ap 
      (OptAp.Map (fun un fn id -> User(un,fn,id)) (one (Opt ("fullname", (Some ""), Some)))) 
      (one (Opt ("fullname", (Some ""), Some)))) 
    (one (Opt ("id", None, readInt)))

/// infixed
let (<@>) = OptAp.Map
let (<*>) = OptAp.Ap

let user2 =
  (fun un fn id -> User(un,fn,id))
  <@> one (Opt ("username", None, Some))
  <*> one (Opt ("fullname", (Some ""), Some))
  <*> one (Opt ("id", None, readInt))


/// would be
//let user = opt {
//  let! un = Opt("username", (Some ""), Some)
//  and fn = Opt("fullname", (Some ""), Some)
//  and id = Opt("id", None, readInt)
//  return User(un,dn,id) }

/// statically read all options
let options = OptAp.AllOpts user