Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- (* type declarations *)
- type argspec =
- | Literal of string
- | Arg of string
- | IntArg of string
- type argvalue =
- | ParsedLiteral
- | ParsedArg of string
- | ParsedIntArg of int
- type parsed_command = { args: (string * argvalue) list ; remainder: string list }
- type command = { argspecs: argspec list ; func: (parsed_command -> unit) }
- (* record related utilities *)
- let get_arg pc name = List.assoc name pc.args
- let argspec_to_string value =
- match value with
- | Literal l -> Printf.sprintf "%s " l
- | Arg a -> Printf.sprintf "<%s> " a
- | IntArg a -> Printf.sprintf "<%s:int> " a
- (* help printer *)
- let print_help (commands:command list) =
- Printf.printf("available commands:\n\n");
- let print_command command =
- Printf.printf(" - ");
- List.iter (fun x -> x |> argspec_to_string |> (Printf.printf "%s")) command.argspecs; (* I wish we had . operator from Haskell? *)
- Printf.printf("\n") in
- List.iter print_command commands
- (* parse a single arg against spec *)
- let parse_token spec arg =
- match spec with
- | Literal name -> if String.equal name arg then Some (name, ParsedLiteral) else None (* raw string equality doesn't seem to work?>? *)
- | Arg name -> Some (name, ParsedArg arg)
- | IntArg name -> (
- match int_of_string_opt arg with
- | Some value -> Some (name, ParsedIntArg value)
- | None -> None)
- (* parse a list of tokens against a command definition. Returns None if fails *)
- let parse_command cmd args =
- (* mutually recursive functions ooh *)
- let rec parse specs args = match specs, args with
- | (shd :: stl), (ahd :: atl) -> parse_step shd stl ahd atl
- | [], _ -> Some { args = []; remainder = args }
- | _, _ -> None
- and parse_step shd stl ahd atl = match parse_token shd ahd with
- | None -> None
- | Some _p -> match parse stl atl with
- | Some {args; remainder} -> Some {args = (_p :: args); remainder = remainder}
- | None -> None in
- match parse cmd.argspecs args with
- | Some parsed -> Some (cmd, parsed)
- | None -> None (* lots of None -> None s hanging around.. is that fixable? *)
- (* find the matching function and execute it *)
- let handle (commands:command list) args =
- let rec first_some f lst = match lst with (* helper function *)
- | [] -> None
- | hd :: tl -> match f hd with
- | Some r -> Some r
- | None -> first_some f tl in
- let first_match = first_some (fun cmd -> parse_command cmd args) commands in
- match first_match with
- | Some (cmd, parsed) -> cmd.func parsed
- | None -> print_help commands
- (* finally, some command definitions - looks a bit ugly *)
- let commands = [
- {
- argspecs = [ Literal "hello" ] ;
- func = (fun _ -> Printf.printf("hello received\n"))
- } ;
- {
- argspecs = [ Literal "max_orders+=" ; IntArg "n" ] ;
- func = (fun _ -> Printf.printf("max_order+= received\n"))
- } ;
- {
- argspecs = [ Literal "set_user" ; Arg "name"; IntArg "age" ] ;
- func = (
- fun pc ->
- match (get_arg pc "name"), (get_arg pc "age") with (* the validation was already done for us, any better API than this? hmm *)
- | ParsedArg name, ParsedIntArg age -> Printf.printf "set user name=%s age=%d\n" name age
- | _, _ -> Printf.printf("wtf?\n");
- )
- } ;
- ]
- let () =
- let rec to_list arr i = if i == Array.length arr then [] else arr.(i) :: (to_list arr (i+1)) in
- handle commands (to_list Sys.argv 1)
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement