Marcus Rohrmoser 2 years ago
parent
commit
c8259c300d
15 changed files with 653 additions and 6 deletions
  1. 4 0
      .gitignore
  2. 30 0
      Makefile
  3. 9 6
      README.md
  4. 5 0
      bin/dune
  5. 60 0
      bin/meta.ml
  6. 1 0
      dune-project
  7. 16 0
      lib/dune
  8. 38 0
      lib/name.ml
  9. 17 0
      lib/tag.ml
  10. 6 0
      lib/title.ml
  11. 410 0
      test/angstrom_test.ml
  12. 3 0
      test/banal_test.ml
  13. 8 0
      test/dune
  14. 12 0
      test/parse_test.ml
  15. 34 0
      test/simple_test.ml

+ 4 - 0
.gitignore

@@ -0,0 +1,4 @@
+_build/
+*.swp
+lib/version.ml
+.merlin

+ 30 - 0
Makefile

@@ -0,0 +1,30 @@
+#
+# https://github.com/ocaml/dune/tree/master/example/sample-projects/hello_world
+# via https://stackoverflow.com/a/54712669
+#
+.PHONY: all build clean test install uninstall doc examples
+
+build:
+	@echo "let git_sha = \""`git rev-parse --short HEAD`"\"" > lib/version.ml
+	dune build bin/meta.exe
+
+all: build
+
+test:
+	dune runtest
+
+examples:
+	dune build @examples
+
+install:
+	dune install
+
+uninstall:
+	dune uninstall
+
+doc:
+	dune build @doc
+
+clean:
+	rm -rf _build *.install
+

+ 9 - 6
README.md

@@ -1,11 +1,14 @@
 
-Add, delete and list tag of files stored in filenames.
+Add, delete and list tag of files stored in filenames, inspired by
+https://karl-voit.at/managing-digital-photographs/
 
 ## Synopsis
 
-  $ meta tag add <foo> [file]
-  $ meta tag lst [file]
-  $ meta tag del <foo> [file]
-  $ meta title set [file]
-  $ meta title get [file]
+```sh
+$ meta tag add <tag> [file]
+$ meta tag lst [file]
+$ meta tag del <tag> [file]
+$ meta title set <title> [file]
+$ meta title get [file]
+```
 

+ 5 - 0
bin/dune

@@ -0,0 +1,5 @@
+; https://stackoverflow.com/a/53325230/349514
+(executable
+  (name meta)
+  (libraries Lib)
+)

+ 60 - 0
bin/meta.ml

@@ -0,0 +1,60 @@
+(*
+ *)
+
+open Lib
+
+let print_version () =
+  let exe = Filename.basename Sys.executable_name in
+  let msgs = [exe; Version.git_sha] in
+  let msg = String.concat " " msgs in
+  Printf.printf "%s\n" msg;
+  0
+
+let print_help () =
+  Printf.printf "%s\n" "Todo: help";
+  0
+
+let err i msgs =
+  let msg = String.concat ": " msgs in
+  prerr_endline msg;
+  i
+
+let print_tag tag' =
+  match tag' with
+  | Error msgs -> let msg = String.concat ": " msgs in
+    prerr_endline msg
+  | Ok tag     -> begin match tag with
+    | Tag.Tag tv -> Printf.printf "%s\n" tv
+  end
+
+let do_lst files =
+  let allL = List.map (fun f -> match Name.parse f with
+      | (_, tags) -> tags
+    ) files in
+  let all = List.concat allL in
+  let allU = List.sort_uniq compare all in
+  List.iter print_tag allU;
+  0
+
+let () =
+  let status = match List.tl (Array.to_list Sys.argv) with
+  | []  -> err 2 ["get help with -h"]
+  | arg ->
+    begin match List.hd arg with
+    | "-h"        -> print_help ()
+    | "--help"    -> print_help ()
+    | "-v"        -> print_version ()
+    | "--version" -> print_version ()
+    | "tag"       -> begin match List.tl arg with
+      | []   -> err 2 ["get help with -h"]
+      | prms -> let tl = List.tl prms in
+        begin match List.hd prms with
+        | "lst" -> do_lst tl
+        | cmd   -> err 2 ["unknown command"; cmd]
+        end
+      end
+    | n           -> err 2 ["unknown noun"; n]
+    end
+  in
+  exit status;;
+

+ 1 - 0
dune-project

@@ -0,0 +1 @@
+(lang dune 1.11)

+ 16 - 0
lib/dune

@@ -0,0 +1,16 @@
+(library
+  (name Lib)
+  (libraries
+    angstrom
+  )
+)
+
+;(rule
+;   (target version.ml)
+;   (action
+;    (with-stdout-to %{target}
+;    (echo "let git_sha = \"foo")
+;     (run git rev-parse --short HEAD)
+;    (echo "bar\"")
+;   ))
+;  )

+ 38 - 0
lib/name.ml

@@ -0,0 +1,38 @@
+
+(*
+ * https://github.com/inhabitedtype/angstrom
+ *)
+open Angstrom
+
+let parens p = char '(' *> p <* char ')'
+let add = char '+' *> return (+)
+let sub = char '-' *> return (-)
+let mul = char '*' *> return ( * )
+let div = char '/' *> return (/)
+let integer =
+  take_while1 (function '0' .. '9' -> true | _ -> false) >>| int_of_string
+
+let chainl1 e op =
+  let rec go acc =
+    (lift2 (fun f x -> f acc x) op e >>= go) <|> return acc in
+  e >>= fun init -> go init
+
+let expr : int t =
+  fix (fun expr ->
+    let factor = parens expr <|> integer in
+    let term   = chainl1 factor (mul <|> div) in
+    chainl1 term (add <|> sub))
+
+let eval (str:string) : int =
+  match parse_string expr str with
+  | Ok v      -> v
+  | Error msg -> failwith msg
+
+(* https://caml.inria.fr/pub/docs/manual-ocaml/libref/Sys.html *)
+
+let parse n =
+  let ti = Title.Title n in
+  (* let tagS = List.map (fun t -> (Tag.t.Tag t)) ["foo"] in *)
+  let tags = [Tag.Tag "foo"] in
+  (Ok ti, List.map (fun t -> Ok t) tags)
+

+ 17 - 0
lib/tag.ml

@@ -0,0 +1,17 @@
+(*
+ *)
+
+type t =
+  Tag of string
+
+let lst_tags f =
+  Ok f
+
+let add _ fs =
+  fs
+
+let del _ fs =
+  fs
+
+let lst fs =
+  List.map (fun f -> lst_tags f) fs

+ 6 - 0
lib/title.ml

@@ -0,0 +1,6 @@
+(*
+ *)
+
+type t =
+  Title of string
+

+ 410 - 0
test/angstrom_test.ml

@@ -0,0 +1,410 @@
+open Angstrom
+
+module Alcotest = struct
+  include Alcotest
+
+  let bigstring =
+    Alcotest.testable
+      (fun fmt _bs -> Fmt.pf fmt "<bigstring>")
+      ( = )
+end
+
+let check ?size f p is =
+  let open Buffered in
+  let state =
+    List.fold_left (fun state chunk ->
+      feed state (`String chunk))
+    (parse ?initial_buffer_size:size p) is
+  in
+  f (state_to_result (feed state `Eof))
+
+let check_ok ?size ~msg test p is r =
+  let r = Ok r in
+  check ?size (fun result -> Alcotest.(check (result test string)) msg r result)
+    p is
+
+let check_fail ?size ~msg p is =
+  let r = Error "" in
+  check ?size (fun result -> Alcotest.(check (result reject pass)) msg r result)
+    p is
+
+let check_c   ?size ~msg p is r = check_ok ?size ~msg Alcotest.char            p is r
+let check_lc  ?size ~msg p is r = check_ok ?size ~msg Alcotest.(list char)     p is r
+let check_co  ?size ~msg p is r = check_ok ?size ~msg Alcotest.(option char)   p is r
+let check_s   ?size ~msg p is r = check_ok ?size ~msg Alcotest.string          p is r
+let check_bs  ?size ~msg p is r = check_ok ?size ~msg Alcotest.bigstring       p is r
+let check_ls  ?size ~msg p is r = check_ok ?size ~msg Alcotest.(list string)   p is r
+let check_int ?size ~msg p is r = check_ok ?size ~msg Alcotest.int             p is r
+
+let bigstring_of_string s = Bigstringaf.of_string s ~off:0 ~len:(String.length s)
+
+let basic_constructors =
+  [ "peek_char", `Quick, begin fun () ->
+      check_co ~msg:"singleton input"  peek_char ["t"]    (Some 't');
+      check_co ~msg:"longer input"     peek_char ["true"] (Some 't');
+      check_co ~msg:"empty input"      peek_char [""]     None;
+  end
+  ; "peek_char_fail", `Quick, begin fun () ->
+      check_c    ~msg:"singleton input"  peek_char_fail ["t"]    't';
+      check_c    ~msg:"longer input"     peek_char_fail ["true"] 't';
+      check_fail ~msg:"empty input"      peek_char_fail [""]
+  end
+  ; "char", `Quick, begin fun () ->
+      check_c    ~msg:"singleton 'a'" (char 'a') ["a"]     'a';
+      check_c    ~msg:"prefix 'a'"    (char 'a') ["asdf"]  'a';
+      check_fail ~msg:"'a' failure"   (char 'a') ["b"];
+      check_fail ~msg:"empty buffer"  (char 'a') [""]
+  end
+  ; "int8", `Quick, begin fun () ->
+    check_int  ~msg:"singleton 'a'" (int8 0x0061) ["a"]     0x61;
+    check_int  ~msg:"prefix 'a'"    (int8 0xff61) ["asdf"]  0x61;
+    check_fail ~msg:"'a' failure"   (int8 0xff61) ["b"];
+    check_fail ~msg:"empty buffer"  (int8 0xff61) [""];
+  end
+  ; "not_char", `Quick, begin fun () ->
+      check_c    ~msg:"not 'a' singleton" (not_char 'a') ["b"] 'b';
+      check_c    ~msg:"not 'a' prefix"    (not_char 'a') ["baba"] 'b';
+      check_fail ~msg:"not 'a' failure"   (not_char 'a') ["a"];
+      check_fail ~msg:"empty buffer"      (not_char 'a') [""]
+  end
+  ; "any_char", `Quick, begin fun () ->
+      check_c    ~msg:"non-empty buffer" any_char ["a"] 'a';
+      check_fail ~msg:"empty buffer"     any_char [""]
+  end
+  ; "any_{,u}int8", `Quick, begin fun () ->
+    check_int ~msg:"positive sign preserved" any_int8 ["\127"] 127;
+    check_int ~msg:"negative sign preserved" any_int8 ["\129"] (-127);
+    check_int ~msg:"sign invariant" any_uint8 ["\127"] 127;
+    check_int ~msg:"sign invariant" any_uint8 ["\129"] (129)
+  end
+  ; "string", `Quick, begin fun () ->
+      check_s ~msg:"empty string, non-empty buffer" (string "")     ["asdf"] "";
+      check_s ~msg:"empty string, empty buffer"     (string "")     [""]     "";
+      check_s ~msg:"exact string match"             (string "asdf") ["asdf"] "asdf";
+      check_s ~msg:"string is prefix of input"      (string "as")   ["asdf"] "as";
+
+      check_fail ~msg:"input is prefix of string"     (string "asdf") ["asd"];
+      check_fail ~msg:"non-empty string, empty input" (string "test") [""]
+  end
+  ; "string_ci", `Quick, begin fun () ->
+      check_s ~msg:"empty string, non-empty input"  (string_ci "")     ["asdf"] "";
+      check_s ~msg:"empty string, empty input"      (string_ci "")     [""]     "";
+      check_s ~msg:"exact string match"             (string_ci "asdf") ["AsDf"] "AsDf";
+      check_s ~msg:"string is prefix of input"      (string_ci "as")   ["AsDf"] "As";
+
+      check_fail ~msg:"input is prefix of string"     (string_ci "asdf") ["Asd"];
+      check_fail ~msg:"non-empty string, empty input" (string_ci "test") [""]
+  end
+  ; "take_bigstring", `Quick, begin fun () ->
+      check_bs ~msg:"empty bigstring"       (take_bigstring 0) ["asdf"] (bigstring_of_string "");
+      check_bs ~msg:"bigstring"             (take_bigstring 2) ["asdf"] (bigstring_of_string "as");
+
+      check_fail ~msg:"asking for too much" (take_bigstring 5) ["asdf"];
+  end
+  ; "take_while", `Quick, begin fun () ->
+      check_s ~msg:"true, non-empty input"  (take_while (fun _ -> true)) ["asdf"] "asdf";
+      check_s ~msg:"true, empty input"      (take_while (fun _ -> true)) [""] "";
+      check_s ~msg:"false, non-empty input" (take_while (fun _ -> false)) ["asdf"] "";
+      check_s ~msg:"false, empty input"     (take_while (fun _ -> false)) [""] "";
+  end
+  ; "take_while1", `Quick, begin fun () ->
+      check_s ~msg:"true, non-empty input"     (take_while1 (fun _ -> true)) ["asdf"] "asdf";
+      check_fail ~msg:"false, non-empty input" (take_while1 (fun _ -> false)) ["asdf"];
+      check_fail ~msg:"true, empty input"      (take_while1 (fun _ -> true)) [""];
+      check_fail ~msg:"false, empty input"     (take_while1 (fun _ -> false)) [""];
+  end
+  ; "advance", `Quick, begin fun () ->
+      check_s ~msg:"non-empty input"                (advance 3 >>= fun () -> take 1) ["asdf"] "f";
+      check_fail ~msg:"advance more than available" (advance 5) ["asdf"];
+      check_fail ~msg:"advance on empty input"      (advance 3) [""];
+  end
+  ]
+
+module type EndianBigstring = sig
+  val set_int16 : Bigstringaf.t -> int -> int -> unit
+  val set_int32 : Bigstringaf.t -> int -> int32 -> unit
+  val set_int64 : Bigstringaf.t -> int -> int64 -> unit
+
+  val set_float  : Bigstringaf.t -> int -> float -> unit
+  val set_double : Bigstringaf.t -> int -> float -> unit
+end
+
+module Endian(Es : EndianBigstring) = struct
+  type 'a endian = {
+    name : string;
+    size : int;
+    zero : 'a;
+    min : 'a;
+    max : 'a;
+    dump : Bigstringaf.t -> int -> 'a -> unit;
+    testable : 'a Alcotest.testable
+  }
+
+  let int16 = {
+    name = "int16";
+    size = 2;
+    zero = 0;
+    min = ~-32768;
+    max = 32767;
+    dump = Es.set_int16;
+    testable = Alcotest.int
+  }
+  let int32 = {
+    name = "int32";
+    size = 4;
+    zero = Int32.zero;
+    min = Int32.min_int;
+    max = Int32.max_int;
+    dump = Es.set_int32;
+    testable = Alcotest.int32
+  }
+  let int64 = {
+    name = "int64";
+    size = 8;
+    zero = Int64.zero;
+    min = Int64.min_int;
+    max = Int64.max_int;
+    dump = Es.set_int64;
+    testable = Alcotest.int64
+  }
+  let float = {
+    name = "float";
+    size = 4;
+    zero = 0.0;
+    (* XXX: Not really min/max *)
+    min = ~-.2e10;
+    max = 2e10;
+    dump = Es.set_float;
+    testable = Alcotest.float 0.0
+  }
+  let double = {
+    name = "double";
+    size = 8;
+    zero = 0.0;
+    (* XXX: Not really min/max *)
+    min = ~-.2e30;
+    max = 2e30;
+    dump = Es.set_double;
+    testable = Alcotest.float 0.0
+  }
+
+  let uint16 = { int16 with name = "uint16"; min = 0; max = 65535 }
+  let uint32 = { int32 with name = "uint32" }
+
+   let dump actual size value =
+     let buf = Bigstringaf.of_string ~off:0 ~len:size (String.make size '\xff') in
+     actual buf 0 value;
+     Bigstringaf.substring ~off:0 ~len:size buf
+
+  let make_tests e parse = e.name, `Quick, begin fun () ->
+    check_ok ~msg:"zero"     e.testable parse [dump e.dump e.size       e.zero] e.zero;
+    check_ok ~msg:"min"      e.testable parse [dump e.dump e.size       e.min ] e.min;
+    check_ok ~msg:"max"      e.testable parse [dump e.dump e.size       e.max ] e.max;
+    check_ok ~msg:"trailing" e.testable parse [dump e.dump (e.size + 1) e.zero] e.zero;
+  end
+
+  module type EndianSig = module type of LE
+
+  let tests (module E : EndianSig) = [
+    make_tests int16  E.any_int16;
+    make_tests int32  E.any_int32;
+    make_tests int64  E.any_int64;
+    make_tests uint16 E.any_uint16;
+    make_tests float  E.any_float;
+    make_tests double E.any_double;
+  ]
+end
+let little_endian =
+  let module E = Endian(struct
+    let set_int16  = Bigstringaf.unsafe_set_int16_le
+    let set_int32  = Bigstringaf.unsafe_set_int32_le
+    let set_int64  = Bigstringaf.unsafe_set_int64_le
+
+    let set_float  bs off f = Bigstringaf.unsafe_set_int32_le bs off (Int32.bits_of_float f)
+    let set_double bs off d = Bigstringaf.unsafe_set_int64_le bs off (Int64.bits_of_float d)
+  end) in
+  E.tests (module LE)
+
+let big_endian =
+  let module E = Endian(struct
+    let set_int16  = Bigstringaf.unsafe_set_int16_be
+    let set_int32  = Bigstringaf.unsafe_set_int32_be
+    let set_int64  = Bigstringaf.unsafe_set_int64_be
+
+    let set_float  bs off f = Bigstringaf.unsafe_set_int32_be bs off (Int32.bits_of_float f)
+    let set_double bs off d = Bigstringaf.unsafe_set_int64_be bs off (Int64.bits_of_float d)
+  end) in
+  E.tests (module BE)
+
+let monadic =
+  [ "fail", `Quick, begin fun () ->
+    check_fail ~msg:"non-empty input" (fail "<msg>") ["asdf"];
+    check_fail ~msg:"empty input"     (fail "<msg>") [""]
+  end
+  ; "return", `Quick, begin fun () ->
+    check_s ~msg:"non-empty input" (return "test") ["asdf"] "test";
+    check_s ~msg:"empty input"     (return "test") [""]     "test";
+  end
+  ; "bind", `Quick, begin fun () ->
+    check_s ~msg:"data dependency" (take 2 >>= fun s -> string s) ["asas"] "as";
+  end
+  ]
+
+let applicative =
+  [ "applicative", `Quick, begin fun () ->
+    check_s ~msg:"`foo *> bar` returns bar" (string "foo" *> string "bar") ["foobar"] "bar";
+    check_s ~msg:"`foo <* bar` returns bar" (string "foo" <* string "bar") ["foobar"] "foo";
+  end
+  ]
+
+let alternative =
+  [ "alternative", `Quick, begin fun () ->
+      check_c ~msg:"char a | char b" (char 'a' <|> char 'b') ["a"] 'a';
+      check_c ~msg:"char b | char a" (char 'b' <|> char 'a') ["a"] 'a';
+      check_s ~msg:"string 'a' | string 'b'" (string "a" <|> string "b") ["a"] "a";
+      check_s ~msg:"string 'b' | string 'a'" (string "b" <|> string "a") ["a"] "a";
+  end ]
+
+let combinators =
+  [ "many", `Quick, begin fun () ->
+      check_lc ~msg:"empty input"   (many (char 'a')) [""]  [];
+      check_lc ~msg:"single char"   (many (char 'a')) ["a"] ['a'];
+      check_lc ~msg:"two chars"     (many (char 'a')) ["aa"] ['a'; 'a'];
+    end
+  ; "many_till", `Quick, begin fun () ->
+      check_lc ~msg:"not greedy" (many_till any_char (char '-')) ["ab-ab-"] ['a'; 'b'];
+    end
+  ; "sep_by1", `Quick, begin fun () ->
+      let parser = sep_by1 (char ',') (char 'a') in
+      check_lc ~msg:"single char"     parser ["a"]    ['a'];
+      check_lc ~msg:"many chars"      parser ["a,a"]  ['a'; 'a'];
+      check_lc ~msg:"no trailing sep"  parser ["a,"]   ['a'];
+    end
+  ; "count", `Quick, begin fun () ->
+      check_lc ~msg:"empty input" (count 0 (char 'a')) [""] [];
+      check_lc ~msg:"exact input" (count 1 (char 'a')) ["a"] ['a'];
+      check_lc ~msg:"additonal input" (count 2 (char 'a')) ["aaa"] ['a'; 'a'];
+      check_fail ~msg:"bad input" (count 2 (char 'a')) ["abb"];
+    end
+  ; "scan_state", `Quick, begin fun () ->
+      check_s ~msg:"scan_state" (scan_state "" (fun s -> function
+          | 'a' -> Some s
+          | '.' -> None
+          | c -> Some ((String.make 1 c) ^ s)
+        )) ["abaacba."] "bcb";
+      let p =
+        count 2 (scan_state "" (fun s -> function
+            | '.' -> None
+            | c -> Some (s ^ String.make 1 c)
+          ))
+        >>| String.concat "" in
+      check_s ~msg:"state reset between runs" p ["bcd."] "bcd";
+    end
+  ]
+
+let incremental =
+  [ "within chunk boundary", `Quick, begin fun () ->
+      check_s ~msg:"string on each side of 2 inputs"
+        (string "this" *> string "that") ["this"; "that"] "that";
+      check_s ~msg:"string on each side of 3 inputs"
+        (string "thi" *> string "st" *> string "hat") ["thi"; "st"; "hat"] "hat";
+      check_s ~msg:"string straddling 2 inputs"
+        (string "thisthat") ["this"; "that"] "thisthat";
+      check_s ~msg:"string straddling 3 inputs"
+        (string "thisthat") ["thi"; "st"; "hat"] "thisthat";
+      end
+  ; "peek_char and empty chunks", `Quick, begin fun () ->
+      let decoder len =
+        let open Angstrom in
+
+        let buf = Buffer.create len in
+
+        fix @@ fun m ->
+        available >>= function
+        | 0 -> peek_char >>= (function
+            | Some _ -> commit *> m
+            | None ->
+              let ret = Buffer.contents buf in
+              Buffer.clear buf;
+              commit *> return ret)
+        | n -> take n >>= fun chunk -> Buffer.add_string buf chunk; commit *> m
+      in
+
+      check_s ~msg:"empty input multiple times and peek_char"
+        (decoder 0xFF) [ "Whole Lotta Love"; ""; ""; "" ] "Whole Lotta Love"
+    end
+  ; "across chunk boundary", `Quick, begin fun () ->
+      check_s ~size:4 ~msg:"string on each side of 2 chunks"
+        (string "this" *> string "that") ["this"; "that"] "that";
+      check_s ~size:3 ~msg:"string on each side of 3 chunks"
+        (string "thi" *> string "st" *> string "hat") ["thi"; "st"; "hat"] "hat";
+      check_s ~size:4 ~msg:"string straddling 2 chunks"
+        (string "thisthat") ["this"; "that"] "thisthat";
+      check_s ~size:3 ~msg:"string straddling 3 chunks"
+        (string "thisthat") ["thi"; "st"; "hat"] "thisthat";
+    end
+  ; "across chunk boundary with commit", `Quick, begin fun () ->
+      check_s ~size:4 ~msg:"string on each side of 2 chunks"
+        (string "this" *> commit *> string "that") ["this"; "that"] "that";
+      check_s ~size:3 ~msg:"string on each side of 3 chunks"
+        (string "thi" *> string "st" *> commit *> string "hat") ["thi"; "st"; "hat"] "hat";
+    end ]
+
+let count_while_regression =
+  [ "proper position set after count_while", `Quick, begin fun () ->
+    check_s ~msg:"take_while then eof"
+      (take_while (fun _ -> true) <* end_of_input) ["asdf"; ""] "asdf";
+    check_s ~msg:"take_while1 then eof"
+      (take_while1 (fun _ -> true) <* end_of_input) ["asdf"; ""] "asdf";
+  end ]
+
+let choice_commit = 
+  [ "", `Quick, begin fun () ->
+    let p = 
+      choice  [ string "@@" *> commit *> char '*'
+              ; string "@"  *> commit *> char '!' ]
+    in
+    Alcotest.(check (result reject string))
+      "commit to branch"
+      (Error ": char '*'")
+      (parse_string p "@@^");
+  end ]
+
+let input = 
+  let test p input ~off ~len expect =
+    match Angstrom.Unbuffered.parse p with
+    | Done _ | Fail _ -> assert false
+    | Partial { continue; committed } ->
+      Alcotest.(check int) "committed is zero" 0 committed;
+      let bs = Bigstringaf.of_string input ~off:0 ~len:(String.length input) in
+      let state = continue bs ~off ~len Complete in
+      Alcotest.(check (result string string))
+        "offset and length respected"
+        (Ok expect)
+        (Angstrom.Unbuffered.state_to_result state);
+  in
+
+  [ "offset and length respected", `Quick, begin fun () ->
+    let open Angstrom in
+    let take_all = take_while (fun _ -> true) in
+    test take_all             "abcd"    ~off:1 ~len:2 "bc";
+    test (take 4 *> take_all) "abcdefg" ~off:0 ~len:7 "efg";
+  end ]
+;;
+
+
+
+let () =
+  Alcotest.run "test suite"
+    [ "basic constructors"    , basic_constructors
+    ; "little endian"         , little_endian
+    ; "big endian"            , big_endian
+    ; "monadic interface"     , monadic
+    ; "applicative interface" , applicative
+    ; "alternative"           , alternative
+    ; "combinators"           , combinators
+    ; "incremental input"     , incremental 
+    ; "count_while regression", count_while_regression
+    ; "choice and commit"     , choice_commit
+    ; "input"                 , input
+  ]

+ 3 - 0
test/banal_test.ml

@@ -0,0 +1,3 @@
+
+let () = assert (1 = 1)
+let () = assert (1 + 1 = 2)

+ 8 - 0
test/dune

@@ -0,0 +1,8 @@
+; http://cumulus.github.io/Syndic/syndic/Syndic__/Syndic_atom/
+(tests
+ (names
+  parse_test
+  banal_test
+  simple_test
+  angstrom_test)
+ (libraries Lib alcotest))

+ 12 - 0
test/parse_test.ml

@@ -0,0 +1,12 @@
+
+open Lib
+
+let () = 
+  let f = "2020-01-26-202853-Huhu_--_tag0_tag1.txt" in
+  match Name.parse f with
+  (_, ta') -> 
+    assert ((Ok (Tag.Tag "foo")) = List.hd ta')
+
+(*  (Ok ti', _) -> begin match ti' with
+    Title.Title ti -> assert ("Huhu" = ti)
+  end *)

+ 34 - 0
test/simple_test.ml

@@ -0,0 +1,34 @@
+(* Build with `ocamlbuild -pkg alcotest simple.byte` *)
+
+(* A module with functions to test *)
+module To_test = struct
+  let lowercase = String.lowercase_ascii
+  let capitalize = String.capitalize_ascii
+  let str_concat = String.concat ""
+  let list_concat = List.append
+end
+
+(* The tests *)
+let test_lowercase () =
+  Alcotest.(check string) "same string" "hello!" (To_test.lowercase "hELLO!")
+
+let test_capitalize () =
+  Alcotest.(check string) "same string" "World." (To_test.capitalize "world.")
+
+let test_str_concat () =
+  Alcotest.(check string) "same string" "foobar" (To_test.str_concat ["foo"; "bar"])
+
+let test_list_concat () =
+  Alcotest.(check (list int)) "same lists" [1; 2; 3] (To_test.list_concat [1] [2; 3])
+
+(* Run it *)
+let () =
+  let open Alcotest in
+  run "Utils" [
+      "string-case", [
+          test_case "Lower case"     `Quick test_lowercase;
+          test_case "Capitalization" `Quick test_capitalize;
+        ];
+      "string-concat", [ test_case "String mashing" `Quick test_str_concat  ];
+      "list-concat",   [ test_case "List mashing"   `Slow  test_list_concat ];
+    ]