add size options and size tests

.vscode/settings.json

@@ -0,0 +1,6 @@
+{
+    "ocaml.sandbox": {
+        "kind": "opam",
+        "switch": "sherlodoc"
+    }
+}

bin/JSherlodoc/main.ml

@@ -27,7 +27,7 @@ let search message =
   Jv.(apply (get global "postMessage"))
     [| Jv.of_list
          (fun Db.Elt.{ json_display; _ } ->
-          json_display |> Jstr.of_string |> Brr.Json.decode |> Result.get_ok)
+           json_display |> Jstr.of_string |> Brr.Json.decode |> Result.get_ok)
          results
     |]
 

bin/index/index.ml

@@ -1,25 +1,48 @@
-let main files db_filename db_format =
+let main files index_docstring index_name type_search empty_payload db_filename
+    db_format =
   let index = files |> List.map Fpath.of_string |> List.map Result.get_ok in
   let optimize, storage =
     match db_format with
     | `ancient -> true, (module Storage_ancient : Db.Storage.S)
     | `marshal -> false, (module Storage_marshal : Db.Storage.S)
     | `js -> false, (module Storage_js : Db.Storage.S)
   in
-  let add_entries li e = (Odoc_search.Entry.entries_of_item e) @ li in
+  let add_entries li e = Odoc_search.Entry.entries_of_item e @ li in
   let index =
-  index |>
-    List.fold_left (fun li file ->
-        file
-        |> Odoc_odoc.Indexing.handle_file
-             ~page:(Odoc_model.Fold.page ~f:add_entries li)
-             ~unit:(Odoc_model.Fold.unit ~f:add_entries li)
-        |> Result.get_ok |> Option.value ~default:[]) [] 
+    index
+    |> List.fold_left
+         (fun li file ->
+           file
+           |> Odoc_odoc.Indexing.handle_file
+                ~page:(Odoc_model.Fold.page ~f:add_entries li)
+                ~unit:(Odoc_model.Fold.unit ~f:add_entries li)
+           |> Result.get_ok |> Option.value ~default:[])
+         []
   in
-  Index_lib.main ~index ~db_filename ~optimize storage
+  Index_lib.main ~index_docstring ~index_name ~type_search ~empty_payload ~index
+    ~db_filename ~optimize storage
 
 open Cmdliner
 
+let index_docstring =
+  let doc = "Use the docstring to index the results." in
+  Arg.(value & opt bool true & info ~doc [ "index-docstring" ])
+
+let index_name =
+  let doc = "Use the name to index the results." in
+  Arg.(value & opt bool true & info ~doc [ "index-name" ])
+
+let type_search =
+  let doc = "Enable type based search" in
+  Arg.(value & opt bool true & info ~doc [ "type-search" ])
+
+let empty_payload =
+  let doc =
+    "Dont put anything in the payloads. For testing purposes, will break the \
+     UI."
+  in
+  Arg.(value & flag & info ~doc [ "empty-payload" ])
+
 let db_format =
   let doc = "Database format" in
   let kind = Arg.enum [ "ancient", `ancient; "marshal", `marshal; "js", `js ] in
@@ -34,7 +57,10 @@ let odoc_files =
   let doc = "Path to a binary odoc index" in
   Arg.(non_empty & (pos_all file [] @@ info ~doc ~docv:"ODOC_FILE" []))
 
-let index = Term.(const main $ odoc_files $ db_filename $ db_format)
+let index =
+  Term.(
+    const main $ odoc_files $ index_docstring $ index_name $ type_search
+    $ empty_payload $ db_filename $ db_format)
 
 let cmd =
   let doc = "Index odocl files" in

bin/www/ui.ml

@@ -15,11 +15,7 @@ let render_elt elt =
   let link = render_link elt in
   match elt.kind with
   | Val { type_; _ } ->
-      [ txt "val "
-      ; a ~a:link [ em [ txt elt.name ] ]
-      ; txt " : "
-      ; txt type_
-      ]
+      [ txt "val "; a ~a:link [ em [ txt elt.name ] ]; txt " : "; txt type_ ]
   | Doc -> [ txt "comment "; a ~a:link [ em [ txt elt.name ] ] ]
   | TypeDecl { type_decl } ->
       [ txt "type "
@@ -44,11 +40,7 @@ let render_elt elt =
       ; txt type_
       ]
   | Field { type_; _ } ->
-      [ txt "field "
-      ; a ~a:link [ em [ txt elt.name ] ]
-      ; txt " : "
-      ; txt type_
-      ]
+      [ txt "field "; a ~a:link [ em [ txt elt.name ] ]; txt " : "; txt type_ ]
 
 let render_pkg elt =
   let open Db.Elt in

lib/db/db.ml

@@ -134,7 +134,7 @@ module Make (Storage : Storage.S) : S with type writer = Storage.writer = struct
     let ho = Hocc.create 16 in
     let hs = Hset.create 16 in
     List.iter
-      (fun (path, count) -> store ~ho ~hs ~count path elt)
+      (fun (path, count) -> store ~ho ~hs ~count (Cache_list.memo path) elt)
       (regroup_chars paths)
 
   let store_chars name elt =

lib/db/elt.ml

@@ -56,7 +56,7 @@ module T = struct
   type t =
     { name : string
     ; kind : kind
-    ; has_doc: bool
+    ; has_doc : bool
     ; pkg : package option
     ; json_display : string
     }

lib/index_lib/index_lib.ml

@@ -1,6 +1,7 @@
 module Storage = Db.Storage
 
-let main ~index ~db_filename ~optimize storage =
+let main ~index_docstring ~index_name ~type_search ~empty_payload ~index
+    ~db_filename ~optimize storage =
   let module Storage = (val storage : Storage.S) in
   let module Load_doc = Load_doc.Make (Storage) in
   let module Db = Load_doc.Db in
@@ -10,6 +11,6 @@ let main ~index ~db_filename ~optimize storage =
     Load_doc.clear () ;
     Db.export h
   in
-  Load_doc.run ~index ;
+  Load_doc.run ~index_docstring ~index_name ~type_search ~empty_payload ~index ;
   flush () ;
   Storage.close_out h

lib/index_lib/index_lib.mli

@@ -1,5 +1,9 @@
 val main :
-     index:Odoc_search.Entry.t list
+     index_docstring:bool
+  -> index_name:bool
+  -> type_search:bool
+  -> empty_payload:bool
+  -> index:Odoc_search.Entry.t list
   -> db_filename:string
   -> optimize:bool
   -> (module Db.Storage.S)

lib/index_lib/load_doc.ml

@@ -216,40 +216,39 @@ module Make (Storage : Db.Storage.S) = struct
            Cache_list.memo xs)
          type_paths)
 
-  let register_kind elt (kind : Odoc_search.Entry.extra) =
+  let register_kind ~type_search elt (kind : Odoc_search.Entry.extra) =
     let open Odoc_search.Entry in
     let open Odoc_model.Lang in
-    match kind with
-    | TypeDecl _ -> ()
-    | Module -> ()
-    | Value { value = _; type_ } -> register_type_expr elt type_
-    | Doc _ -> ()
-    | Exception _ -> ()
-    | Class_type _ -> ()
-    | Method _ -> ()
-    | Class _ -> ()
-    | TypeExtension _ -> ()
-    | ExtensionConstructor _ -> ()
-    | ModuleType -> ()
-    | Constructor { args; res } ->
-        let type_ = searchable_type_of_constructor args res in
-        register_type_expr elt type_
-    | Field { mutable_ = _; parent_type; type_ } ->
-        let type_ = TypeExpr.Arrow (None, parent_type, type_) in
-        register_type_expr elt type_
-
+    if type_search
+    then
+      match kind with
+      | TypeDecl _ -> ()
+      | Module -> ()
+      | Value { value = _; type_ } -> register_type_expr elt type_
+      | Doc _ -> ()
+      | Exception _ -> ()
+      | Class_type _ -> ()
+      | Method _ -> ()
+      | Class _ -> ()
+      | TypeExtension _ -> ()
+      | ExtensionConstructor _ -> ()
+      | ModuleType -> ()
+      | Constructor { args; res } ->
+          let type_ = searchable_type_of_constructor args res in
+          register_type_expr elt type_
+      | Field { mutable_ = _; parent_type; type_ } ->
+          let type_ = TypeExpr.Arrow (None, parent_type, type_) in
+          register_type_expr elt type_
 
-  let register_entry
+  let register_entry ~empty_payload ~index_name ~type_search ~index_docstring
       (Odoc_search.Entry.
-        { id : Odoc_model.Paths.Identifier.Any.t
-        ; doc : Odoc_model.Comment.docs
-        ; extra : extra
-        } as entry) =
+         { id : Odoc_model.Paths.Identifier.Any.t
+         ; doc : Odoc_model.Comment.docs
+         ; extra : extra
+         } as entry) =
     let open Odoc_search in
     let open Odoc_search.Entry in
-    let full_name =
-      id |> Pretty.fullname |> String.concat "."
-    in
+    let full_name = id |> Pretty.fullname |> String.concat "." in
     let doc =
       let html = doc |> Render.html_of_doc |> string_of_html
       and txt = Render.text_of_doc doc in
@@ -268,17 +267,25 @@ module Make (Storage : Db.Storage.S) = struct
       | Doc _ -> Pretty.prefixname id
       | _ -> full_name
     in
-    let json_display = entry |> Json_display.of_entry |> Odoc_html.Json.to_string in
+    let json_display =
+      if empty_payload
+      then ""
+      else entry |> Json_display.of_entry |> Odoc_html.Json.to_string
+    in
     let has_doc = doc.txt <> "" in
-    let elt = Elt.{ name; kind = kind'; pkg = None ; json_display ; has_doc} in
-
-    register_doc elt doc.txt ;
-    (match extra with
-    | Doc _ -> ()
-    | _ -> register_full_name full_name elt) ;
-    register_kind elt extra
+    let elt = Elt.{ name; kind = kind'; pkg = None; json_display; has_doc } in
+    if index_docstring then register_doc elt doc.txt ;
+    (if index_name
+     then
+       match extra with
+       | Doc _ -> ()
+       | _ -> register_full_name full_name elt) ;
+    register_kind ~type_search elt extra
 
   module Resolver = Odoc_odoc.Resolver
 
-  let run ~index = List.iter register_entry index
+  let run ~index_docstring ~index_name ~type_search ~empty_payload ~index =
+    List.iter
+      (register_entry ~index_docstring ~index_name ~type_search ~empty_payload)
+      index
 end

lib/index_lib/load_doc.mli

@@ -2,5 +2,12 @@ module Make (Storage : Db.Storage.S) : sig
   module Db : Db.S with type writer = Storage.writer
 
   val clear : unit -> unit
-  val run : index:Odoc_search.Entry.t list -> unit
+
+  val run :
+       index_docstring:bool
+    -> index_name:bool
+    -> type_search:bool
+    -> empty_payload:bool
+    -> index:Odoc_search.Entry.t list
+    -> unit
 end

lib/index_lib/pretty.ml

@@ -104,9 +104,11 @@ let rec full_name_aux : Paths.Identifier.t -> string list =
 let fullname : [< Paths.Identifier.t_pv ] Paths.Identifier.id -> string list =
  fun n -> List.rev @@ full_name_aux (n :> Paths.Identifier.t)
 
- let prefixname : [< Paths.Identifier.t_pv ] Paths.Identifier.id -> string =
-  fun n ->
-   match full_name_aux (n :> Paths.Identifier.t) with [] -> "" | _ :: q -> String.concat "." q
+let prefixname : [< Paths.Identifier.t_pv ] Paths.Identifier.id -> string =
+ fun n ->
+  match full_name_aux (n :> Paths.Identifier.t) with
+  | [] -> ""
+  | _ :: q -> String.concat "." q
 
 let show_type_name_verbose h : Paths.Path.Type.t -> _ = function
   | `Resolved t ->

test/cram/base.t/run.t

@@ -0,0 +1,28 @@
+  $ cd base
+  $ cd ..
+  $ cat $(find . -name '*.odocl') > megaodocl
+  $ du -sh megaodocl
+  5.1M	megaodocl
+  $ sherlodoc_index --format=js  --db=db.js $(find . -name '*.odocl') 2> /dev/null
+  $ sherlodoc_index --format=js --empty-payload --db=db_empty_payload.js $(find . -name '*.odocl') 2> /dev/null
+  $ sherlodoc_index --format=js --index-docstring=false --db=db_no_docstring.js $(find . -name '*.odocl') 2> /dev/null
+  $ sherlodoc_index --format=js --index-name=false --db=db_no_name.js $(find . -name '*.odocl') 2> /dev/null
+  $ sherlodoc_index --format=js --type-search=false --db=db_no_type.js $(find . -name '*.odocl') 2> /dev/null
+  $ sherlodoc_index --format=js --type-search=false --empty-payload --index-docstring=false  --db=db_only_names.js $(find . -name '*.odocl') 2> /dev/null
+
+  $ du -sh *.js
+  20M	db.js
+  16M	db_empty_payload.js
+  17M	db_no_docstring.js
+  15M	db_no_name.js
+  13M	db_no_type.js
+  6.4M	db_only_names.js
+  $ for f in $(find . -name '*.odocl'); do
+  >  odoc html-generate --with-search --output-dir html $f 2> /dev/null
+  > done
+  $ odoc support-files -o html
+  $ cat db.js  ../../../bin/JSherlodoc/main.bc.js > html/index.js
+  $ du -sh html/index.js
+  23M	html/index.js
+  $ cp -r html /tmp
+  $ firefox /tmp/html/index.html