diff options
-rw-r--r-- | .gitignore | 2 | ||||
-rw-r--r-- | dune-project | 1 | ||||
-rw-r--r-- | flake.lock | 41 | ||||
-rw-r--r-- | flake.nix | 27 | ||||
-rw-r--r-- | grump.opam | 0 | ||||
-rw-r--r-- | src/chart.ml | 135 | ||||
-rw-r--r-- | src/dune | 3 | ||||
-rw-r--r-- | src/grump.ml | 1 |
8 files changed, 210 insertions, 0 deletions
diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..06c9926 --- /dev/null +++ b/.gitignore | |||
@@ -0,0 +1,2 @@ | |||
1 | _build | ||
2 | result | ||
diff --git a/dune-project b/dune-project new file mode 100644 index 0000000..c994249 --- /dev/null +++ b/dune-project | |||
@@ -0,0 +1 @@ | |||
(lang dune 2.9) | |||
diff --git a/flake.lock b/flake.lock new file mode 100644 index 0000000..08aa38a --- /dev/null +++ b/flake.lock | |||
@@ -0,0 +1,41 @@ | |||
1 | { | ||
2 | "nodes": { | ||
3 | "nixpkgs": { | ||
4 | "locked": { | ||
5 | "lastModified": 1626855004, | ||
6 | "narHash": "sha256-wm0wLIZkbr92iu10N7hHttrLIX58tQxIUCeQxPxA10o=", | ||
7 | "owner": "NixOS", | ||
8 | "repo": "nixpkgs", | ||
9 | "rev": "621afb9980bc06ed695b0e3d62109a7dbd00e3da", | ||
10 | "type": "github" | ||
11 | }, | ||
12 | "original": { | ||
13 | "id": "nixpkgs", | ||
14 | "type": "indirect" | ||
15 | } | ||
16 | }, | ||
17 | "root": { | ||
18 | "inputs": { | ||
19 | "nixpkgs": "nixpkgs", | ||
20 | "utils": "utils" | ||
21 | } | ||
22 | }, | ||
23 | "utils": { | ||
24 | "locked": { | ||
25 | "lastModified": 1623875721, | ||
26 | "narHash": "sha256-A8BU7bjS5GirpAUv4QA+QnJ4CceLHkcXdRp4xITDB0s=", | ||
27 | "owner": "numtide", | ||
28 | "repo": "flake-utils", | ||
29 | "rev": "f7e004a55b120c02ecb6219596820fcd32ca8772", | ||
30 | "type": "github" | ||
31 | }, | ||
32 | "original": { | ||
33 | "owner": "numtide", | ||
34 | "repo": "flake-utils", | ||
35 | "type": "github" | ||
36 | } | ||
37 | } | ||
38 | }, | ||
39 | "root": "root", | ||
40 | "version": 7 | ||
41 | } | ||
diff --git a/flake.nix b/flake.nix new file mode 100644 index 0000000..4c483e6 --- /dev/null +++ b/flake.nix | |||
@@ -0,0 +1,27 @@ | |||
1 | { | ||
2 | inputs = { | ||
3 | utils.url = "github:numtide/flake-utils"; | ||
4 | }; | ||
5 | |||
6 | outputs = { self, nixpkgs, utils, ... }: | ||
7 | utils.lib.eachDefaultSystem (system: | ||
8 | let | ||
9 | pname = "grump"; | ||
10 | version = "0.0.0"; | ||
11 | pkgs = nixpkgs.legacyPackages."${system}"; | ||
12 | |||
13 | buildInputs = with pkgs.ocamlPackages; [ | ||
14 | utop | ||
15 | pkgs.nixUnstable | ||
16 | ]; | ||
17 | |||
18 | in | ||
19 | with pkgs; | ||
20 | rec { | ||
21 | defaultPackage = ocamlPackages.buildDunePackage rec { | ||
22 | inherit pname version buildInputs; | ||
23 | useDune2 = true; | ||
24 | src = ./.; | ||
25 | }; | ||
26 | }); | ||
27 | } | ||
diff --git a/grump.opam b/grump.opam new file mode 100644 index 0000000..e69de29 --- /dev/null +++ b/grump.opam | |||
diff --git a/src/chart.ml b/src/chart.ml new file mode 100644 index 0000000..0aee05d --- /dev/null +++ b/src/chart.ml | |||
@@ -0,0 +1,135 @@ | |||
1 | exception Empty_list | ||
2 | let fold fn = function | ||
3 | | [] -> raise Empty_list | ||
4 | | head :: tail -> List.fold_left fn head tail | ||
5 | |||
6 | let list_min ls = fold Stdlib.min ls | ||
7 | let list_max ls = fold Stdlib.max ls | ||
8 | |||
9 | let rec repeat n a = | ||
10 | if n <= 0 | ||
11 | then [] | ||
12 | else a :: repeat (n - 1) a | ||
13 | |||
14 | let empty ls = (ls = []) | ||
15 | |||
16 | let rec zip l1 l2 = | ||
17 | match (l1, l2) with | ||
18 | | ([], _) -> [] | ||
19 | | (_, []) -> [] | ||
20 | | (h1 :: t1, h2 :: t2) -> (h1, h2) :: zip t1 t2 | ||
21 | |||
22 | let rec transpose = function | ||
23 | | [] :: _ -> [] | ||
24 | | ls -> List.(map hd ls) :: transpose List.(map tl ls) | ||
25 | |||
26 | let flip f a b = f b a | ||
27 | |||
28 | let rot_right ls = List.(rev ls |> transpose) | ||
29 | let rot_left ls = List.(transpose ls |> rev) | ||
30 | |||
31 | let to_string c = String.make 1 c | ||
32 | let space = to_string ' ' | ||
33 | |||
34 | let saturating_sub b a = | ||
35 | if a < b then 0 | ||
36 | else a - b | ||
37 | |||
38 | module type Marker = sig | ||
39 | type t | ||
40 | val of_string : string -> t | ||
41 | val to_string : t -> string | ||
42 | end | ||
43 | |||
44 | module Marker = struct | ||
45 | type t = Point | ||
46 | | Pixel | ||
47 | | Circle | ||
48 | | TriangleDown | ||
49 | | TriangleUp | ||
50 | | TriangleLeft | ||
51 | | TriangleRight | ||
52 | | Custom of string | ||
53 | |||
54 | exception Invalid_marker_length | ||
55 | let of_string s = | ||
56 | if String.length s <> 1 | ||
57 | then raise Invalid_marker_length | ||
58 | else Custom(s) | ||
59 | |||
60 | let to_string = function | ||
61 | | Point -> "." | ||
62 | | Pixel -> "," | ||
63 | | Circle -> "o" | ||
64 | | TriangleDown -> "v" | ||
65 | | TriangleUp -> "^" | ||
66 | | TriangleLeft -> ">" | ||
67 | | TriangleRight -> "<" | ||
68 | | Custom(s) -> s | ||
69 | end | ||
70 | |||
71 | module type ChartOptions = sig | ||
72 | type t | ||
73 | val default : t | ||
74 | val with_height : int -> t -> t | ||
75 | val with_marker : string -> t -> t | ||
76 | end | ||
77 | |||
78 | module ChartOptions = struct | ||
79 | type t = { height: int; ascii: bool; marker: Marker.t} | ||
80 | let default = | ||
81 | { height = 14 | ||
82 | ; ascii = false | ||
83 | ; marker = Marker.Point | ||
84 | } | ||
85 | let with_height v c = {c with height = v; } | ||
86 | let with_marker v c = {c with marker = v; } | ||
87 | end | ||
88 | |||
89 | module Chart = struct | ||
90 | let draw vals (opts: ChartOptions.t) = | ||
91 | let height = opts.height in | ||
92 | (* let width = List.length vals in *) | ||
93 | let min_val = list_min vals in | ||
94 | let max_val = list_max vals in | ||
95 | (*let range = max_val - min_val in*) | ||
96 | |||
97 | (* rescale from min-max to 0-height *) | ||
98 | let scale v = ((v - min_val) * height) / max_val in | ||
99 | let new_vals = List.map scale vals in | ||
100 | let rec pad left right s = | ||
101 | if left = 0 | ||
102 | then s :: repeat right space | ||
103 | else space :: pad (left - 1) right s | ||
104 | in | ||
105 | let new_vals' = zip new_vals (List.tl new_vals) in | ||
106 | let make_connector s e = | ||
107 | match Stdlib.compare s e with | ||
108 | | 0 -> pad s (height - s - 1) "-" | ||
109 | | x -> | ||
110 | let (ltr_chr, rtl_chr) = | ||
111 | match x with | ||
112 | | 1 -> ("└", "┐") | ||
113 | | _ -> ("┘", "┌") | ||
114 | in | ||
115 | let (st, en) = Stdlib.((min s e, max s e)) in | ||
116 | let l = en - st |> saturating_sub 1 in | ||
117 | let (left, right) = (repeat st space, repeat (height - l - st - 1) space) | ||
118 | in | ||
119 | List.flatten [left; [ltr_chr]; repeat l "│"; [rtl_chr]; right] | ||
120 | in | ||
121 | let m = Marker.to_string opts.marker in | ||
122 | let rec make_graph = function | ||
123 | | [] -> [] | ||
124 | | (s, e) :: [] -> | ||
125 | pad s (height - s - 1) m | ||
126 | :: make_connector s e | ||
127 | :: pad e (height - e - 1) m | ||
128 | :: [] | ||
129 | | (s, e) :: tl -> | ||
130 | pad s (height - s - 1) m | ||
131 | :: make_connector s e | ||
132 | :: make_graph tl | ||
133 | in | ||
134 | make_graph new_vals' |> rot_left | ||
135 | end | ||
diff --git a/src/dune b/src/dune new file mode 100644 index 0000000..6b1e6d9 --- /dev/null +++ b/src/dune | |||
@@ -0,0 +1,3 @@ | |||
1 | (library | ||
2 | (name grump) | ||
3 | (public_name grump)) | ||
diff --git a/src/grump.ml b/src/grump.ml new file mode 100644 index 0000000..b4b1288 --- /dev/null +++ b/src/grump.ml | |||
@@ -0,0 +1 @@ | |||
print_endline "hello world!" | |||