Index: rosshil.ml ================================================================== --- rosshil.ml +++ rosshil.ml @@ -14,27 +14,45 @@ type timespan = int (* earth seconds are current tick unit *) type timepoint = int type quantity = int type proportion = float -type runopt = NoOpt | NoANSI | ASCII | Debug | OutOnly +type runopt = NoOpt | NoANSI | NoColor | ASCII | Debug | OutOnly let optstrs = [ NoANSI, "-plain"; + NoANSI, "-noansi"; NoANSI, "p"; + + NoColor, "-mono"; + NoColor, "-nocolor"; + NoColor, "-bw"; + NoColor, "m"; ASCII, "-ascii"; ASCII, "a"; Debug, "-verbose"; + Debug, "-debug"; Debug, "v"; OutOnly, "-out"; OutOnly, "o"; ] + let is_opt str = List.exists (fun (_,s) -> ("-"^s) = str) optstrs let opt_of_str str = let (opt,_) = List.find - (fun (_,s) -> ("-"^s) = str) optstrs in opt; + (fun (_,s) -> ("-"^s) = str) optstrs in opt +let in_opt_list opts o = List.exists (fun a -> a = o) opts + +type outfmt = { + options: runopt list; + ansi : string -> string -> string; + ul : string -> string; + hl : string -> string; + italic : string -> string; + arrow : string; +} type name = { short: string; long: string; } let nmpair short long = { short = short; long = long }; type timeunit = { @@ -300,63 +318,66 @@ }; }; ] -let usage arrow ansi hl bin = +let usage (o: outfmt) bin = let caltext = ( let heading = "calendars: " in let desc (cal: funcrow) : string =( let name = List.hd cal.names in let aliases = List.tl cal.names in let append a b = if a = "" then b else (a^", "^b) in let fmt = cal.fmt in - (ansi fmt (hl name)) ^ - (ansi fmt (" [" ^ (List.fold_left append "" aliases) ^"]") ^"\n")) + (o.ansi fmt (o.hl name)) ^ + (o.ansi fmt (" [" ^ (List.fold_left append "" aliases) ^"]") ^"\n")) in let spacing = String.make (String.length heading) ' ' in let space s = spacing ^ (desc s) in - let fst = (hl heading) ^ (desc (List.hd funcs)) in + let fst = (o.hl heading) ^ (desc (List.hd funcs)) in let rst = List.map space (List.tl funcs) in (List.fold_left (^) fst rst) ) in let heading = "usage: " in - let opts = " [options] " in + let opts = " ["^(o.ul "options")^"] " in + let param x = (if in_opt_list o.options NoANSI then "<"^x^">" + else (o.hl (o.ul x))) in let syntax = [ - " [year ] [day ] to ", + (param "calendar") ^ " [year "^(param "year")^"] [day "^(param "day")^"] to "^(param "calendar"), "convert a calendar date"; - " (days | years [ days]) to ", - "convert a span of time"; - " ticks years days", + (param "number") ^" "^ (param "calendar") ^ " (days | years ["^(param "days")^" days]) to "^(param "calendar"), + "convert a span of time"; + (param "calendar")^" ticks "^(param "years")^" years "^(param "days")^" days", "count temporal ticks corresponding to a timespan"; - " epoch day ", + (param "calendar")^" epoch "^(param "year")^" day "^(param "day"), "get the Spirals epoch for a particular date"; - "epoch to ", - "convert a Spirals epoch to a calendar date"; - " ticks to ", + "epoch "^(param "number")^" to "^(param "calendar"), + "convert a Spirals epoch "^(param "number")^" to a calendar date"; + (param "number")^" ticks to "^(param "calendar"), "convert a tick count to a span of time in a given calendar"; ] in let spacing = String.make (String.length heading) ' ' in - let mkrow (s,d) = bin ^ opts ^ (ansi "94" s) ^"\n" ^ - spacing ^ ((ansi "3;95" (" "^arrow^" " ^ d))^"\n") in + let mkrow (s,d) = bin ^ opts ^ (o.ansi "34" s) ^"\n" ^ + spacing ^ ((o.ansi "95" (o.italic (" "^o.arrow^" " ^ d)))^"\n") in let space s = spacing ^ (mkrow s) in let opt_heading = "options: " in let optdesc = [ "o","out", "only print what the date is converted into"; "p","plain", "do not format output with ansi escape codes"; + "m","mono", "emit monochrome output"; "v","verbose", "output extra debugging information"; "a","ascii", "use only ASCII in output (instead of UTF-8)"; ] in let opt_spacing = String.make (String.length opt_heading) ' ' in - let mkopt (s,l,d) = "-"^s^" "^(ansi "94" ("(--"^l^")"))^": "^(ansi "95" d)^"\n" in + let mkopt (s,l,d) = "-"^s^" "^(o.ansi "94" ("(--"^l^")"))^": "^(o.ansi "95" d)^"\n" in let spaceopt s = opt_spacing ^ (mkopt s) in - let fst_opt = (hl opt_heading) ^ (mkopt (List.hd optdesc)) in + let fst_opt = (o.hl opt_heading) ^ (mkopt (List.hd optdesc)) in let rst_opt = List.map spaceopt (List.tl optdesc) in let opt_body = List.fold_left (^) fst_opt rst_opt in - let fst = (hl heading) ^ (mkrow (List.hd syntax)) in + let fst = (o.hl heading) ^ (mkrow (List.hd syntax)) in let rst = List.map space (List.tl syntax) in (List.fold_left (^) fst rst) ^"\n"^ opt_body ^"\n" ^ caltext;; let contains ar v : bool = List.exists (fun a -> a = v) ar @@ -382,24 +403,32 @@ let outstr = to_sys.fmt outdate in (from_funcs.fmt, instr, to_funcs.fmt, outstr, time) let rec parse (opts: runopt list) (args: string list) (bin: string) = let - has_opt o = List.exists (fun a -> a = o) opts in + has_opt = in_opt_list opts in let switch o a b = if has_opt o then a else b in - let ansi (fmt: string) (str: string) = switch NoANSI str - ("\x1b["^fmt^"m"^str^"\x1b[m") in - let hl txt = switch NoANSI txt - ("\x1b[1m" ^ txt ^ "\x1b[21m") in - let arrow = (switch ASCII "->" "→") in - let dbg msg : unit = (if has_opt Debug then print_string - (ansi "35;3" ((hl " -- ") ^ msg ^ "\n")) else ()) in - let op msg o = dbg msg; o in + let o = { + options = opts; + ansi = (fun fmt str -> if has_opt NoANSI || has_opt NoColor then str else + ("\x1b["^fmt^"m"^str^"\x1b[m")); + italic = (fun txt -> switch NoANSI txt + ("\x1b[3m" ^ txt ^ "\x1b[23m")); + ul = (fun txt -> switch NoANSI txt + ("\x1b[4m" ^ txt ^ "\x1b[24m")); + hl = (fun txt -> switch NoANSI txt + ("\x1b[1m" ^ txt ^ "\x1b[21m")); + arrow = (switch ASCII "->" "→"); + } in + let dbg msg : unit = (if has_opt Debug then print_string + (o.ansi "35" (o.italic ((o. hl " -- ") ^ msg)) ^ "\n") else ()) in + let op msg o = dbg msg; o in + let res_fmt (inf,ind,outf,outd,_) = - (switch OutOnly "" ((ansi inf ind) ^" "^ arrow ^" "))^ (ansi outf (hl outd)) in + (switch OutOnly "" ((o.ansi inf ind) ^" "^ o.arrow ^" "))^ (o.ansi outf (o.hl outd)) in let epoch (_,_,_,_,time) = time in match args with | opt :: rst when is_opt opt -> let o = opt_of_str opt in (op ("saw flag " ^opt^ ", adding to option set and restarting parse") @@ -448,10 +477,10 @@ (res_fmt (conv Timespan from system 0 (int_of_string count)))^"\n" | [years; from; "years"; days; "days"; "to"; system] -> (res_fmt (conv Timespan from system (int_of_string years) (int_of_string days)))^"\n" - | _ -> (usage arrow ansi hl bin);; + | _ -> (usage o bin);; let () = print_string (match (Array.to_list Sys.argv) with | bin :: rst -> parse [] rst bin | _ -> "buddy ya fucked up BAD");;