ocamlspot / utils.ml

(***********************************************************************)
(*                                                                     *)
(*                            OCamlSpotter                             *)
(*                                                                     *)
(*                             Jun FURUSE                              *)
(*                                                                     *)
(*   Copyright 2008, 2009 Jun Furuse. All rights reserved.             *)
(*   This file is distributed under the terms of the GNU Library       *)
(*   General Public License, with the special exception on linking     *)
(*   described in file LICENSE.                                        *)
(*                                                                     *)
(***********************************************************************)

open Format

module List = struct
  include List

  let rec find_map_opt f = function
    | [] -> None
    | x::xs ->
        match f x with
        | Some v -> Some v
        | None -> find_map_opt f xs

  let filter_map f lst =
    List.rev (List.fold_left (fun st x ->
      match f x with
      | Some v -> v :: st
      | None -> st) [] lst)

  (** concatMap of Haskell *)
  let concat_map f l = List.concat (List.map f l)
end

module Debug = struct
  let on = ref false

  let format fmt = 
    if !on then eprintf fmt
    else Format.ifprintf Format.err_formatter fmt
end

module Lazy = struct
  include Lazy

  module Open = struct
    let (!!) = Lazy.force 
    let eager = Lazy.lazy_from_val
  end

  open Open

  let peek v = if lazy_is_val v then Some (!!v) else None
      
  let apply f v = 
    if lazy_is_val v then eager (f !!v)
    else lazy (f !!v)

  let is_val = lazy_is_val
end

include Lazy.Open

module Filename = struct
  include Filename
      
  let split_extension s = 
    try
      let body = chop_extension s in
      body, 
      String.sub s 
	(String.length body) 
	(String.length s - String.length body)
    with
    | Invalid_argument _ -> s, ""

  module Open = struct
    let (^/) p1 p2 =
      if Filename.is_relative p2 then Filename.concat p1 p2 else p2
  end
end

include Filename.Open

module Format = struct
  include Format
  let rec list (sep : (unit, formatter, unit) format)  f ppf = function
    | [] -> ()
    | [x] -> f ppf x
    | x::xs -> 
        fprintf ppf "@[%a@]%t%a" 
	  f x
	  (fun ppf -> fprintf ppf sep)
	  (list sep f) xs

  let option f ppf = function
    | None -> fprintf ppf "None"
    | Some v -> fprintf ppf "Some(%a)" f v 

  let lazy_ p ppf v =
    if Lazy.is_val v then p ppf (Lazy.Open.(!!) v)
    else fprintf ppf "lazy"
end

module Option = struct
  let map ~f = function
    | None -> None
    | Some v -> Some (f v)

  let bind v f = match v with
    | None -> None
    | Some v -> f v

  let iter ~f = function
    | None -> ()
    | Some v -> f v

  let default dv = function
    | None -> dv
    | Some v -> v
end

exception Finally of exn * exn
;;

let protect ~f x ~(finally : 'a -> unit) =
  let res =
    try f x with exn ->
      (try finally x with final_exn -> raise (Finally (exn, final_exn)));
    raise exn
  in
  finally x;
  res
;;

module Unix = struct
  include Unix

  (* run [f] on files in [path] *)
  let folddir ~f ~init path =
    let dh = opendir path in
    protect ~f:(fun () ->
      let rec loop st =
	try
	  let st' = f st (readdir dh) in
	  loop st'
	with
	| End_of_file -> st
      in
      loop init)
      ~finally:(fun () -> closedir dh) ()
  ;;

  module Inodes = Set.Make(struct
    type t = int
    let compare : int -> int -> int = fun x y -> compare x y
  end)
  ;;
  
  type path = 
      { dir : string;
	base : string;
	path : string; (* dir / name *)
	stat : [ `Ok of stats | `Error of exn ];
	depth : int;
      }

  let path ~depth ~dir base =
    let path = match Filename.concat dir base with
      | "./." -> "."
      | s -> s
    in
    { dir = dir;
      base = base;
      path = path;
      depth = depth; 
      stat = try `Ok (stat path) with e -> `Error e;
    }
  ;;

  let kind path =
    match path.stat with
    | `Error _exn -> None
    | `Ok stat -> Some stat.st_kind
  ;;

  let is_dir path = kind path = Some S_DIR

  let inode path = 
    match path.stat with
    | `Ok stat -> Some stat.st_ino
    | `Error _ -> None
  ;;

  exception Prune

  let prune () = raise Prune

  let find ~f fnames =

    (* visited cache *)
    let visited = ref Inodes.empty in
    let if_not_visited_then path ~f = match inode path with
      | None -> ()
      | Some inode ->
	  if Inodes.mem inode !visited then ()
	  else begin
	    visited := Inodes.add inode !visited;
	    f path
	  end
    in

    let rec find_dir pth =
      try 
	f pth;
	let subdirs =
	  folddir pth.path ~init:[] ~f:(fun dirs -> function
	    | "." | ".." -> dirs
	    | name -> 
		let pth = path ~depth:(pth.depth + 1) ~dir:pth.path name in
		if try is_dir pth with _ -> false then pth::dirs
		else begin find_non_dir pth; dirs end)
	in
	List.iter (if_not_visited_then ~f:find_dir) subdirs
      with
      | Prune -> ()

    and find_non_dir path = try f path with Prune -> ()
    in

    List.iter (fun fname ->
      let path = 
	path ~depth: 0 ~dir:(Filename.dirname fname) (Filename.basename fname)
      in
      if is_dir path then find_dir path
      else find_non_dir path) fnames
  ;;
end

module Hashtbl = struct
  include Hashtbl
  let of_list size kvs =
    let tbl = Hashtbl.create size in
    List.iter (fun (k,v) ->
      Hashtbl.replace tbl k v) kvs;
    tbl
end
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.