Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source
Source file async_find.ml
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307openCoreopenAsyncmoduleStats=Unix.Statstypefile_info=string*Unix.Stats.tmoduleWhich_file=structtypet={dev:int;ino:int;}[@@derivingfields,compare]letof_stats{Stats.dev;ino;_}={dev;ino;}endtypepath=stringlisttypecontext={depth:int;dir_name:path;seen:Which_file.tlist;}letpath_appendpathx=x::pathletpath_to_string?basepath=match(base,path)with|None,[]->"."|Somebase,[]->base|None,_->String.concat~sep:"/"(List.revpath)|Somebase,_->base^/String.concat~sep:"/"(List.revpath)moduleOptions=structtypeerror_handler=|Ignore|Print|Raise|Handle_withof(string->unitDeferred.t)typet={min_depth:int;max_depth:intoption;follow_links:bool;on_open_errors:error_handler;on_stat_errors:error_handler;filter:(file_info->boolDeferred.t)option;skip_dir:(file_info->boolDeferred.t)option;relative_paths:bool;}letdefault={min_depth=1;max_depth=None;follow_links=false;on_open_errors=Raise;on_stat_errors=Raise;filter=None;skip_dir=None;relative_paths=false;}letignore_errors={defaultwithon_open_errors=Ignore;on_stat_errors=Ignore}endmoduleO=Optionstypet={base:string;options:Options.t;mutablecurrent_context:context;mutableto_visit:contextlist;mutablecurrent_handle:[`Just_created|`Starting|`HandleofUnix.dir_handle];mutableclosed:bool;}letfull_path_nametpath=path_to_string~base:t.basepathletoutput_path_nametpath=path_to_string?base:(ift.options.O.relative_pathsthenNoneelseSomet.base)pathletopen_next_dirt=leti=Ivar.create()inletrecloopt=matcht.to_visitwith|[]->Ivar.filliNone|context::rest->upon(Monitor.try_with~rest:`Raise(fun()->t.to_visit<-rest;Unix.opendir(full_path_nametcontext.dir_name)>>|(funhandle->t.current_handle<-`Handlehandle;t.current_context<-context;Some())))(function|Okr->Ivar.fillir|Errore->lete=Monitor.extract_exneinmatcht.options.O.on_open_errorswith|O.Ignore->loopt|O.Raise->raisee|O.Handle_withf->upon(f(output_path_nametcontext.dir_name))(fun()->loopt)|O.Print->Print.eprintf"unable to open %s - %s\n"(output_path_nametcontext.dir_name)(Exn.to_stringe);loopt)inloopt;Ivar.readi;;letclosedirt=matcht.current_handlewith|`Just_created|`Starting->return()|`Handlecurrent_handle->Deferred.ignore_m(Monitor.try_with~rest:`Raise(fun()->Unix.closedircurrent_handle):(unit,exn)Result.tDeferred.t);;letcloset=ifnott.closedthenbegint.closed<-true;closedirt>>|fun()->t.to_visit<-[];endelseDeferred.unit;;letseen_before(context:Which_file.tlist)stats=List.exists~f:([%compare.equal:Which_file.t](Which_file.of_statsstats))contextletstattseenpath=letfull_fn=full_path_nametpathinletoutput_fn=output_path_nametpathinMonitor.try_with~rest:`Raise(fun()->Unix.lstatfull_fn>>=function|{kind=`Link;_}aslstatwhent.options.O.follow_links->(* Symlink. Try following it. *)Unix.statfull_fn>>|(function(* When a symlink points to its ancestor directory, report only the symlink. *)|({kind=`Directory;_}asstat)whenseen_beforeseenstat->lstat|stat->stat)|stat->returnstat)>>=(function|Okstat->return(Some(output_fn,path,stat))|Errore->lete=Monitor.extract_exneinmatcht.options.O.on_stat_errorswith|O.Ignore->returnNone|O.Raise->raisee|O.Handle_withf->foutput_fn>>|(fun()->None)|O.Print->Print.eprintf"unable to stat %s - %s\n"output_fn(Exn.to_stringe);returnNone);;lethandle_dirst(output_fn,path,stats)=letinfo=output_fn,statsinletvisit()=t.to_visit<-{dir_name=path;seen=Which_file.of_statsstats::t.current_context.seen;depth=t.current_context.depth+1;}::t.to_visit;return(Someinfo)inletmaybe_visit()=matcht.options.O.skip_dirwith|None->visit()|Somef->finfo>>=funskip->ifskipthenreturnNoneelsevisit()inletmaybe_return_info()=matcht.options.O.skip_dirwith|None->return(Someinfo)|Somef->finfo>>=funskip->ifskipthenreturnNoneelsereturn(Someinfo)inmatchstats.Stats.kindwith|`Directory->beginmatcht.options.O.max_depthwith|None->maybe_visit()|Somemax_depth->ift.current_context.depth<max_depththenmaybe_visit()elsemaybe_return_info()end|_->return(Someinfo);;letfiltertfile=matchfilewith|None->returnNone|Somefile->ift.current_context.depth<t.options.O.min_depththenreturnNoneelsematcht.options.O.filterwith|None->return(Somefile)|Somef->ffile>>|(funkeep->ifkeepthenSomefileelseNone);;exceptionAttempt_to_use_closed_findof[`Most_recent_dirofstring][@@derivingsexp];;letensure_not_closedt=ift.closedthenraise(Attempt_to_use_closed_find(`Most_recent_dir(output_path_namett.current_context.dir_name)));;(* returns the next file from the conceptual stream and updates the state of t - this
is the only way that t should ever be updated *)letnextt=ensure_not_closedt;leti=Ivar.create()inlethandle_childpath=(* each function in this bind returns None if the file should be skipped, and
Some f i if it thinks it's ok to emit - possibly updating the state or
transforming f along the way *)let(>>>=):typevw.voptionDeferred.t->(v->woptionDeferred.t)->woptionDeferred.t=funvf->v>>=function|None->returnNone|Somev->fvinstattt.current_context.seenpath>>>=handle_dirst>>=filtertinletwith_next_dirk=upon(open_next_dirt)(function|None->upon(closet)(fun()->Ivar.filliNone)|Some()->k())inletrecloop()=lethandle_child_or_looppath=handle_childpath>>>function|None->loop()|r->Ivar.fillirinmatcht.current_handlewith|`Just_created->beginmatcht.options.O.max_depthwith|Somedwhend<0->upon(closet)(fun()->Ivar.filliNone)|None|Some_->t.current_handle<-`Starting;handle_child_or_loopt.current_context.dir_nameend|`Starting->with_next_dirloop|`Handlecurrent_handle->upon(Monitor.try_with~rest:`Raise(fun()->Unix.readdir_optcurrent_handle))(function|Ok(Some("."|".."))->loop()|Ok(Somebasename)->handle_child_or_loop(path_appendt.current_context.dir_namebasename)|OkNone->upon(closedirt)(fun()->with_next_dirloop)|Errore->upon(closedirt)(fun()->raisee))inloop();Ivar.readi;;letcreate?(options=Options.default)dir={base=dir;options=options;to_visit=[];current_context={dir_name=[];seen=[];depth=0;};current_handle=`Just_created;closed=false;};;letfoldt~init~f=Deferred.create(funi->letrecloopacc=upon(nextt)(function|None->Ivar.filliacc|Somefile->upon(faccfile)loop)inloopinit);;letitert~f=foldt~init:()~f:(fun()file->ffile)letto_listt=(foldt~init:[]~f:(funaccfile->return(file::acc)))>>|List.rev;;letfind_all?optionsdir=to_list(create?optionsdir);;