ocamldoc/odoc_search.ml

   1 (***********************************************************************)
   2 (*                             OCamldoc                                *)
   3 (*                                                                     *)
   4 (*            Maxence Guesdon, projet Cristal, INRIA Rocquencourt      *)
   5 (*                                                                     *)
   6 (*  Copyright 2001 Institut National de Recherche en Informatique et   *)
   7 (*  en Automatique.  All rights reserved.  This file is distributed    *)
   8 (*  under the terms of the Q Public License version 1.0.               *)
   9 (*                                                                     *)
  10 (***********************************************************************)
  11
  12 (* $Id$ *)
  13
  14 (** Research of elements through modules. *)
  15
  16 module Name = Odoc_name
  17 open Odoc_parameter
  18 open Odoc_value
  19 open Odoc_type
  20 open Odoc_exception
  21 open Odoc_class
  22 open Odoc_module
  23
  24 type result_element =
  25     Res_module of t_module
  26   | Res_module_type of t_module_type
  27   | Res_class of t_class
  28   | Res_class_type of t_class_type
  29   | Res_value of t_value
  30   | Res_type of t_type
  31   | Res_exception of t_exception
  32   | Res_attribute of t_attribute
  33   | Res_method of t_method
  34   | Res_section of string * Odoc_types.text
  35
  36 type result = result_element list
  37
  38 module type Predicates =
  39   sig
  40     type t
  41     val p_module : t_module -> t -> bool * bool
  42     val p_module_type : t_module_type -> t -> bool * bool
  43     val p_class : t_class -> t -> bool * bool
  44     val p_class_type : t_class_type -> t -> bool * bool
  45     val p_value : t_value -> t -> bool
  46     val p_type : t_type -> t -> bool
  47     val p_exception : t_exception -> t -> bool
  48     val p_attribute : t_attribute -> t -> bool
  49     val p_method : t_method -> t -> bool
  50     val p_section : string -> t -> bool
  51   end
  52
  53 module Search =
  54   functor (P : Predicates) ->
  55   struct
  56     let search_section t s v = if P.p_section s v then [Res_section (s,t)] else []
  57
  58     let rec search_text root t v =
  59       List.flatten (List.map (fun e -> search_text_ele root e v) t)
  60
  61     and search_text_ele root e v =
  62       let module T = Odoc_types in
  63       match e with
  64       | T.Raw _
  65       | T.Code _
  66       | T.CodePre _
  67       | T.Latex _
  68       | T.Verbatim _
  69       | T.Ref (_, _) -> []
  70       | T.Bold t
  71       | T.Italic t
  72       | T.Center t
  73       | T.Left t
  74       | T.Right t
  75       | T.Emphasize t
  76       | T.Block t
  77       | T.Superscript t
  78       | T.Subscript t
  79       | T.Custom (_,t)
  80       | T.Link (_, t) -> search_text root t v
  81       | T.List l
  82       | T.Enum l -> List.flatten (List.map (fun t -> search_text root t v) l)
  83       | T.Newline
  84       | T.Module_list _
  85       | T.Index_list -> []
  86       | T.Title (n, l_opt, t) ->
  87           (match l_opt with
  88             None -> []
  89           | Some s -> search_section t (Name.concat root s) v) @
  90           (search_text root t v)
  91
  92     let search_value va v = if P.p_value va v then [Res_value va] else []
  93
  94     let search_type t v = if P.p_type t v then [Res_type t] else []
  95
  96     let search_exception e v = if P.p_exception e v then [Res_exception e] else []
  97
  98     let search_attribute a v = if P.p_attribute a v then [Res_attribute a] else []
  99
 100     let search_method m v = if P.p_method m v then [Res_method m] else []
 101
 102     let search_class c v =
 103       let (go_deeper, ok) = P.p_class c v in
 104       let l =
 105         if go_deeper then
 106           let res_att =
 107             List.fold_left
 108               (fun acc -> fun att -> acc @ (search_attribute att v))
 109               []
 110               (Odoc_class.class_attributes c)
 111           in
 112           let res_met =
 113             List.fold_left
 114               (fun acc -> fun m -> acc @ (search_method m v))
 115               []
 116               (Odoc_class.class_methods c)
 117           in
 118           let res_sec =
 119             List.fold_left
 120               (fun acc -> fun t -> acc @ (search_text c.cl_name t v))
 121               []
 122               (Odoc_class.class_comments c)
 123           in
 124           let l = res_att @ res_met @ res_sec in
 125           l
 126         else
 127           []
 128       in
 129       if ok then
 130         (Res_class c) :: l
 131       else
 132         l
 133
 134     let search_class_type ct v =
 135       let (go_deeper, ok) = P.p_class_type ct v in
 136       let l =
 137         if go_deeper then
 138           let res_att =
 139             List.fold_left
 140               (fun acc -> fun att -> acc @ (search_attribute att v))
 141               []
 142               (Odoc_class.class_type_attributes ct)
 143           in
 144           let res_met =
 145             List.fold_left
 146               (fun acc -> fun m -> acc @ (search_method m v))
 147               []
 148               (Odoc_class.class_type_methods ct)
 149           in
 150           let res_sec =
 151             List.fold_left
 152               (fun acc -> fun t -> acc @ (search_text ct.clt_name t v))
 153               []
 154               (Odoc_class.class_type_comments ct)
 155           in
 156           let l = res_att @ res_met @ res_sec in
 157           l
 158         else
 159           []
 160       in
 161       if ok then
 162         (Res_class_type ct) :: l
 163       else
 164         l
 165
 166     let rec search_module_type mt v =
 167       let (go_deeper, ok) =  P.p_module_type mt v in
 168       let l =
 169         if go_deeper then
 170           let res_val =
 171             List.fold_left
 172               (fun acc -> fun va -> acc @ (search_value va v))
 173               []
 174               (Odoc_module.module_type_values mt)
 175           in
 176           let res_typ =
 177             List.fold_left
 178               (fun acc -> fun t -> acc @ (search_type t v))
 179               []
 180               (Odoc_module.module_type_types mt)
 181           in
 182           let res_exc =
 183             List.fold_left
 184               (fun acc -> fun e -> acc @ (search_exception e v))
 185               []
 186               (Odoc_module.module_type_exceptions mt)
 187           in
 188           let res_mod = search (Odoc_module.module_type_modules mt) v in
 189           let res_modtyp =
 190             List.fold_left
 191               (fun acc -> fun mt -> acc @ (search_module_type mt v))
 192               []
 193               (Odoc_module.module_type_module_types mt)
 194           in
 195           let res_cl =
 196             List.fold_left
 197               (fun acc -> fun cl -> acc @ (search_class cl v))
 198               []
 199               (Odoc_module.module_type_classes mt)
 200           in
 201           let res_cltyp =
 202             List.fold_left
 203               (fun acc -> fun clt -> acc @ (search_class_type clt v))
 204               []
 205               (Odoc_module.module_type_class_types mt)
 206           in
 207           let res_sec =
 208             List.fold_left
 209               (fun acc -> fun t -> acc @ (search_text mt.mt_name t v))
 210               []
 211               (Odoc_module.module_type_comments mt)
 212           in
 213           let l = res_val @ res_typ @ res_exc @ res_mod @
 214             res_modtyp @ res_cl @ res_cltyp @ res_sec
 215           in
 216           l
 217         else
 218           []
 219       in
 220       if ok then
 221         (Res_module_type mt) :: l
 222       else
 223         l
 224
 225     and search_module m v =
 226       let (go_deeper, ok) =  P.p_module m v in
 227       let l =
 228         if go_deeper then
 229           let res_val =
 230             List.fold_left
 231               (fun acc -> fun va -> acc @ (search_value va v))
 232               []
 233               (Odoc_module.module_values m)
 234           in
 235           let res_typ =
 236             List.fold_left
 237               (fun acc -> fun t -> acc @ (search_type t v))
 238               []
 239               (Odoc_module.module_types m)
 240           in
 241           let res_exc =
 242             List.fold_left
 243               (fun acc -> fun e -> acc @ (search_exception e v))
 244               []
 245               (Odoc_module.module_exceptions m)
 246           in
 247           let res_mod = search (Odoc_module.module_modules m) v in
 248           let res_modtyp =
 249             List.fold_left
 250               (fun acc -> fun mt -> acc @ (search_module_type mt v))
 251               []
 252               (Odoc_module.module_module_types m)
 253           in
 254           let res_cl =
 255             List.fold_left
 256               (fun acc -> fun cl -> acc @ (search_class cl v))
 257               []
 258               (Odoc_module.module_classes m)
 259           in
 260           let res_cltyp =
 261             List.fold_left
 262               (fun acc -> fun clt -> acc @ (search_class_type clt v))
 263               []
 264               (Odoc_module.module_class_types m)
 265           in
 266           let res_sec =
 267             List.fold_left
 268               (fun acc -> fun t -> acc @ (search_text m.m_name t v))
 269               []
 270               (Odoc_module.module_comments m)
 271           in
 272           let l = res_val @ res_typ @ res_exc @ res_mod @
 273             res_modtyp @ res_cl @ res_cltyp @ res_sec
 274           in
 275           l
 276         else
 277           []
 278       in
 279       if ok then
 280         (Res_module m) :: l
 281       else
 282         l
 283
 284     and search module_list v =
 285       List.fold_left
 286         (fun acc -> fun m ->
 287           List.fold_left
 288             (fun acc2 -> fun ele ->
 289               if List.mem ele acc2 then acc2 else acc2 @ [ele]
 290             )
 291             acc
 292             (search_module m v)
 293         )
 294         []
 295         module_list
 296   end
 297
 298 module P_name =
 299   struct
 300     type t = Str.regexp
 301     let (=~) name regexp = Str.string_match regexp name 0
 302     let p_module m r = (true, m.m_name =~ r)
 303     let p_module_type mt r = (true, mt.mt_name =~ r)
 304     let p_class c r = (true, c.cl_name =~ r)
 305     let p_class_type ct r = (true, ct.clt_name =~ r)
 306     let p_value v r = v.val_name =~ r
 307     let p_type t r = t.ty_name =~ r
 308     let p_exception e r = e.ex_name =~ r
 309     let p_attribute a r = a.att_value.val_name =~ r
 310     let p_method m r = m.met_value.val_name =~ r
 311     let p_section s r = s =~ r
 312   end
 313
 314 module Search_by_name = Search ( P_name )
 315
 316 module P_values =
 317   struct
 318     type t = unit
 319     let p_module _ _ = (true, false)
 320     let p_module_type _ _ = (true, false)
 321     let p_class _ _ = (false, false)
 322     let p_class_type _ _ = (false, false)
 323     let p_value _ _ = true
 324     let p_type _ _ = false
 325     let p_exception _ _ = false
 326     let p_attribute _ _ = false
 327     let p_method _ _ = false
 328     let p_section _ _ = false
 329   end
 330 module Search_values = Search ( P_values )
 331 let values l =
 332   let l_ele = Search_values.search l () in
 333   let p v1 v2 = v1.val_name = v2.val_name in
 334   let rec iter acc = function
 335       (Res_value v) :: q -> if List.exists (p v) acc then iter acc q else iter (v :: acc) q
 336     | _ :: q -> iter acc q
 337     | [] -> acc
 338   in
 339   iter [] l_ele
 340
 341 module P_exceptions =
 342   struct
 343     type t = unit
 344     let p_module _ _ = (true, false)
 345     let p_module_type _ _ = (true, false)
 346     let p_class _ _ = (false, false)
 347     let p_class_type _ _ = (false, false)
 348     let p_value _ _ = false
 349     let p_type _ _ = false
 350     let p_exception _ _ = true
 351     let p_attribute _ _ = false
 352     let p_method _ _ = false
 353     let p_section _ _ = false
 354   end
 355 module Search_exceptions = Search ( P_exceptions )
 356 let exceptions l =
 357   let l_ele = Search_exceptions.search l () in
 358   let p e1 e2 = e1.ex_name = e2.ex_name in
 359   let rec iter acc = function
 360       (Res_exception t) :: q -> if List.exists (p t) acc then iter acc q else iter (t :: acc) q
 361     | _ :: q -> iter acc q
 362     | [] -> acc
 363   in
 364   iter [] l_ele
 365
 366 module P_types =
 367   struct
 368     type t = unit
 369     let p_module _ _ = (true, false)
 370     let p_module_type _ _ = (true, false)
 371     let p_class _ _ = (false, false)
 372     let p_class_type _ _ = (false, false)
 373     let p_value _ _ = false
 374     let p_type _ _ = true
 375     let p_exception _ _ = false
 376     let p_attribute _ _ = false
 377     let p_method _ _ = false
 378     let p_section _ _ = false
 379   end
 380 module Search_types = Search ( P_types )
 381 let types l =
 382   let l_ele = Search_types.search l () in
 383   let p t1 t2 = t1.ty_name = t2.ty_name in
 384   let rec iter acc = function
 385       (Res_type t) :: q -> if List.exists (p t) acc then iter acc q else iter (t :: acc) q
 386     | _ :: q -> iter acc q
 387     | [] -> acc
 388   in
 389   iter [] l_ele
 390
 391 module P_attributes =
 392   struct
 393     type t = unit
 394     let p_module _ _ = (true, false)
 395     let p_module_type _ _ = (true, false)
 396     let p_class _ _ = (true, false)
 397     let p_class_type _ _ = (true, false)
 398     let p_value _ _ = false
 399     let p_type _ _ = false
 400     let p_exception _ _ = false
 401     let p_attribute _ _ = true
 402     let p_method _ _ = false
 403     let p_section _ _ = false
 404   end
 405 module Search_attributes = Search ( P_attributes )
 406 let attributes l =
 407   let l_ele = Search_attributes.search l () in
 408   let p a1 a2 = a1.att_value.val_name = a2.att_value.val_name in
 409   let rec iter acc = function
 410       (Res_attribute t) :: q -> if List.exists (p t) acc then iter acc q else iter (t :: acc) q
 411     | _ :: q -> iter acc q
 412     | [] -> acc
 413   in
 414   iter [] l_ele
 415
 416 module P_methods =
 417   struct
 418     type t = unit
 419     let p_module _ _ = (true, false)
 420     let p_module_type _ _ = (true, false)
 421     let p_class _ _ = (true, false)
 422     let p_class_type _ _ = (true, false)
 423     let p_value _ _ = false
 424     let p_type _ _ = false
 425     let p_exception _ _ = false
 426     let p_attribute _ _ = false
 427     let p_method _ _ = true
 428     let p_section _ _ = true
 429   end
 430 module Search_methods = Search ( P_methods )
 431 let methods l =
 432   let l_ele = Search_methods.search l () in
 433   let p m1 m2 = m1.met_value.val_name = m2.met_value.val_name in
 434   let rec iter acc = function
 435       (Res_method t) :: q -> if List.exists (p t) acc then iter acc q else iter (t :: acc) q
 436     | _ :: q -> iter acc q
 437     | [] -> acc
 438   in
 439   iter [] l_ele
 440
 441 module P_classes =
 442   struct
 443     type t = unit
 444     let p_module _ _ = (true, false)
 445     let p_module_type _ _ = (true, false)
 446     let p_class _ _ = (false, true)
 447     let p_class_type _ _ = (false, false)
 448     let p_value _ _ = false
 449     let p_type _ _ = false
 450     let p_exception _ _ = false
 451     let p_attribute _ _ = false
 452     let p_method _ _ = false
 453     let p_section _ _ = false
 454   end
 455 module Search_classes = Search ( P_classes )
 456 let classes l =
 457   let l_ele = Search_classes.search l () in
 458   let p c1 c2 = c1.cl_name = c2.cl_name in
 459   let rec iter acc = function
 460       (Res_class c) :: q -> if List.exists (p c) acc then iter acc q else iter (c :: acc) q
 461     | _ :: q -> iter acc q
 462     | [] -> acc
 463   in
 464   iter [] l_ele
 465
 466 module P_class_types =
 467   struct
 468     type t = unit
 469     let p_module _ _ = (true, false)
 470     let p_module_type _ _ = (true, false)
 471     let p_class _ _ = (false, false)
 472     let p_class_type _ _ = (false, true)
 473     let p_value _ _ = false
 474     let p_type _ _ = false
 475     let p_exception _ _ = false
 476     let p_attribute _ _ = false
 477     let p_method _ _ = false
 478     let p_section _ _ = false
 479   end
 480 module Search_class_types = Search ( P_class_types )
 481 let class_types l =
 482   let l_ele = Search_class_types.search l () in
 483   let p c1 c2 = c1.clt_name = c2.clt_name in
 484   let rec iter acc = function
 485       (Res_class_type c) :: q -> if List.exists (p c) acc then iter acc q else iter (c :: acc) q
 486     | _ :: q -> iter acc q
 487     | [] -> acc
 488   in
 489   iter [] l_ele
 490
 491 module P_modules =
 492   struct
 493     type t = unit
 494     let p_module _ _ = (true, true)
 495     let p_module_type _ _ = (true, false)
 496     let p_class _ _ = (false, false)
 497     let p_class_type _ _ = (false, false)
 498     let p_value _ _ = false
 499     let p_type _ _ = false
 500     let p_exception _ _ = false
 501     let p_attribute _ _ = false
 502     let p_method _ _ = false
 503     let p_section _ _ = false
 504   end
 505 module Search_modules = Search ( P_modules )
 506 let modules l =
 507   let l_ele = Search_modules.search l () in
 508   let p m1 m2 = m1.m_name = m2.m_name in
 509   let rec iter acc = function
 510       (Res_module m) :: q -> if List.exists (p m) acc then iter acc q else iter (m :: acc) q
 511     | _ :: q -> iter acc q
 512     | [] -> acc
 513   in
 514   iter [] l_ele
 515
 516 module P_module_types =
 517   struct
 518     type t = unit
 519     let p_module _ _ = (true, false)
 520     let p_module_type _ _ = (true, true)
 521     let p_class _ _ = (false, false)
 522     let p_class_type _ _ = (false, false)
 523     let p_value _ _ = false
 524     let p_type _ _ = false
 525     let p_exception _ _ = false
 526     let p_attribute _ _ = false
 527     let p_method _ _ = false
 528     let p_section _ _ = false
 529   end
 530 module Search_module_types = Search ( P_module_types )
 531 let module_types l =
 532   let l_ele = Search_module_types.search l () in
 533   let p m1 m2 = m1.mt_name = m2.mt_name in
 534   let rec iter acc = function
 535       (Res_module_type m) :: q -> if List.exists (p m) acc then iter acc q else iter (m :: acc) q
 536     | _ :: q -> iter acc q
 537     | [] -> acc
 538   in
 539   iter [] l_ele
 540
 541 let type_exists mods regexp =
 542   let l = Search_by_name.search mods regexp in
 543   List.exists
 544     (function
 545         Res_type _ -> true
 546       | _ -> false
 547     )
 548     l
 549
 550 let value_exists mods regexp =
 551   let l = Search_by_name.search mods regexp in
 552   List.exists
 553     (function
 554         Res_value _ -> true
 555       | _ -> false
 556     )
 557     l
 558
 559 let class_exists mods regexp =
 560   let l = Search_by_name.search mods regexp in
 561   List.exists
 562     (function
 563         Res_class _ -> true
 564       | _ -> false
 565     )
 566     l
 567
 568 let class_type_exists mods regexp =
 569   let l = Search_by_name.search mods regexp in
 570   List.exists
 571     (function
 572         Res_class_type _ -> true
 573       | _ -> false
 574     )
 575     l
 576
 577 let module_exists mods regexp =
 578   let l = Search_by_name.search mods regexp in
 579   List.exists
 580     (function
 581         Res_module _ -> true
 582       | _ -> false
 583     )
 584     l
 585
 586 let module_type_exists mods regexp =
 587   let l = Search_by_name.search mods regexp in
 588   List.exists
 589     (function
 590         Res_module_type _ -> true
 591       | _ -> false
 592     )
 593     l
 594
 595 let exception_exists mods regexp =
 596   let l = Search_by_name.search mods regexp in
 597   List.exists
 598     (function
 599         Res_exception _ -> true
 600       | _ -> false
 601     )
 602     l
 603
 604 let attribute_exists mods regexp =
 605   let l = Search_by_name.search mods regexp in
 606   List.exists
 607     (function
 608         Res_attribute _ -> true
 609       | _ -> false
 610     )
 611     l
 612
 613 let method_exists mods regexp =
 614   let l = Search_by_name.search mods regexp in
 615   List.exists
 616     (function
 617         Res_method _ -> true
 618       | _ -> false
 619     )
 620     l
 621
 622 let find_section mods regexp =
 623   let l = Search_by_name.search mods regexp in
 624   match
 625     List.find
 626       (function
 627           Res_section _ -> true
 628         | _ -> false
 629       )
 630       l
 631   with
 632     Res_section (_,t) -> t
 633   | _ -> assert false
 634
 635 (* eof $Id$ *)