From ef1719c280513070456e54f75a2460e06e20e2fa Mon Sep 17 00:00:00 2001
From: Rhiannon Morris <rhi@rhiannon.website>
Date: Sun, 6 Dec 2020 09:11:35 +0100
Subject: [PATCH] move chunking stuff out of day4

---
 bracket.ml  |  4 +++
 bracket.mli |  3 +++
 day4.ml     | 31 +-----------------------
 seq.ml      | 70 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 seq.mli     | 17 +++++++++++++
 5 files changed, 95 insertions(+), 30 deletions(-)
 create mode 100644 seq.ml
 create mode 100644 seq.mli

diff --git a/bracket.ml b/bracket.ml
index 2a05e82..6dcca24 100644
--- a/bracket.ml
+++ b/bracket.ml
@@ -12,3 +12,7 @@ let infile_lines ~line:f ~of_seq name =
   infile name ~act
 
 let infile_iter_lines ~line ~iter = infile_lines ~of_seq:(Seq.iter iter) ~line
+
+let infile_chunks ~chunk ~of_seq input =
+  let of_seq seq = Seq.line_chunks seq |> Seq.map chunk |> of_seq in
+  infile_lines input ~line:Fun.id ~of_seq
diff --git a/bracket.mli b/bracket.mli
index 7aaa40a..40ae1c1 100644
--- a/bracket.mli
+++ b/bracket.mli
@@ -6,3 +6,6 @@ val infile_lines: line:(string -> 'a) -> of_seq:('a Seq.t -> 'b) -> string -> 'b
 
 val infile_iter_lines:
   line:(string -> 'a) -> iter:('a -> unit) -> string -> unit
+
+val infile_chunks:
+  chunk:(string -> 'a) -> of_seq:('a Seq.t -> 'b) -> string -> 'b
diff --git a/day4.ml b/day4.ml
index 33b885b..5449f0f 100644
--- a/day4.ml
+++ b/day4.ml
@@ -1,32 +1,3 @@
-
-type acc = {cur: string list; all: string list}
-
-let chunks seq =
-  let make strs all =
-    match strs with
-    | [] -> all
-    | _::_ -> String.concat " " (List.rev strs) :: all in
-  let next acc str =
-    if str = "" then
-      {cur = []; all = make acc.cur acc.all}
-    else
-      {acc with cur = str :: acc.cur} in
-  let res' = Seq.fold_left next {cur = []; all = []} seq in
-  List.rev (make res'.cur res'.all)
-
-let%test_module _ = (module struct
-  let chunks' lst = chunks (List.to_seq lst)
-
-  let%test "ε" = chunks' [] = []
-  let%test "a b c" = chunks' ["a"; "b"; "c"] = ["a b c"]
-  let%test "a b | c" = chunks' ["a"; "b"; ""; "c"] = ["a b"; "c"]
-  let%test "a b || c" = chunks' ["a"; "b"; ""; ""; "c"] = ["a b"; "c"]
-  let%test "a b | c |" = chunks' ["a"; "b"; ""; "c"; ""] = ["a b"; "c"]
-end)
-
-let chunk_input = Bracket.infile_lines ~line:Fun.id ~of_seq:chunks
-
-
 type field = string * string
 
 let fields0 str =
@@ -80,7 +51,7 @@ end)
 
 
 let main' make valid file =
-  let items = chunk_input file |> List.map make in
+  let items = Bracket.infile_chunks file ~chunk:make ~of_seq:List.of_seq in
   let len_all = List.length items in
   let len_valid = List.(length (filter valid items)) in
   Printf.printf "%d valid out of %d\n" len_valid len_all
diff --git a/seq.ml b/seq.ml
new file mode 100644
index 0000000..76f1e47
--- /dev/null
+++ b/seq.ml
@@ -0,0 +1,70 @@
+include Stdlib.Seq
+
+type 'a span = Empty_seq | Span of 'a list * 'a t
+
+let span' p seq =
+  let rec go acc = function
+    | Nil -> begin
+        match acc with
+        | []   -> Empty_seq
+        | _::_ -> Span (List.rev acc, empty)
+      end
+    | Cons (x, xs) ->
+        if p x then
+          go (x :: acc) (xs ())
+        else
+          Span (List.rev acc, cons x xs) in
+  go [] (seq ())
+
+let%test_module _ = (module struct
+  let (@=) sp (l2, s2) =
+    match sp with
+    | Span (l1, s1) -> l1 = l2 && List.of_seq s1 = s2
+    | Empty_seq     -> false
+
+  let%test _ =
+    span' (fun x -> x < 4) (List.to_seq [1;2;3;4;5;6;7]) @=
+      ([1;2;3], [4;5;6;7])
+
+  let%test _ =
+    span' (fun _ -> true) (List.to_seq []) = Empty_seq
+
+  let%test _ =
+    span' (fun x -> x < 0) (List.to_seq [1;2;3;4;5;6;7]) @=
+      ([], [1;2;3;4;5;6;7])
+end)
+
+let break' p = span' (Fun.negate p)
+
+let from_span = function
+  | Empty_seq       -> [], empty
+  | Span (lst, seq) -> lst, seq
+
+let span p seq = from_span (span' p seq)
+let break p seq = from_span (break' p seq)
+
+
+let rec drop_while p seq =
+  match seq () with
+  | Nil -> empty
+  | Cons (x, xs) ->
+      if p x then drop_while p xs else cons x xs
+
+let chunks p =
+  unfold (fun seq ->
+    match break' p seq with
+    | Empty_seq -> None
+    | Span (lst, seq) -> Some (lst, drop_while p seq))
+
+let line_chunks' = chunks (fun s -> s = "")
+let line_chunks seq = map (String.concat " ") (line_chunks' seq)
+
+let%test_module _ = (module struct
+  let lc lst = List.(of_seq (line_chunks (to_seq lst)))
+
+  let%test "ε"         = lc [] = []
+  let%test "a b c"     = lc ["a"; "b"; "c"] = ["a b c"]
+  let%test "a b | c"   = lc ["a"; "b"; ""; "c"] = ["a b"; "c"]
+  let%test "a b || c"  = lc ["a"; "b"; ""; ""; "c"] = ["a b"; "c"]
+  let%test "a b | c |" = lc ["a"; "b"; ""; "c"; ""] = ["a b"; "c"]
+end)
diff --git a/seq.mli b/seq.mli
new file mode 100644
index 0000000..736120e
--- /dev/null
+++ b/seq.mli
@@ -0,0 +1,17 @@
+include module type of Stdlib.Seq
+
+type 'a span = Empty_seq | Span of 'a list * 'a t
+
+val span': ('a -> bool) -> 'a t -> 'a span
+val break': ('a -> bool) -> 'a t -> 'a span
+
+val span: ('a -> bool) -> 'a t -> 'a list * 'a t
+val break: ('a -> bool) -> 'a t -> 'a list * 'a t
+
+val drop_while: ('a -> bool) -> 'a t -> 'a t
+
+
+val chunks: ('a -> bool) -> 'a t -> 'a list t
+
+val line_chunks': string t -> string list t
+val line_chunks: string t -> string t