123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139open!BasemoduleIn_channel=Stdio.In_channelmoduleU=Utilstypet=In_channel.tletpeek_charchan=matchIn_channel.input_charchanwith|None->None|Somec->letpos=In_channel.poschaninlet()=assert(Int64.(pos>of_int0))inlet()=In_channel.seekchanInt64.(pos-of_int1)inSomecletrewind?(pos=Int64.of_int0)chan=In_channel.seekchanposletequalc1c2=In_channel.equalc1c2exceptionExnofstring[@@derivingsexp]letclean_sequences=String.filters~f:(func->Char.(c<>' '))letof_in_channelchan=chanletto_in_channelchan=chanletcreate_exnfname=In_channel.createfnameletcreatefname=U.try1create_exnfnameletclose_exnchan=In_channel.closechanletclosechan=U.try1close_exnchanletstdin_exn()=In_channel.stdinletstdin()=U.try0stdin_exnletinput_record_exnchan=letreclooprecord=match(peek_charchan,record)with|None,None->None|None,Somerecord'->Somerecord'|Some'>',None->letline=In_channel.input_line_exn~fix_win_eol:truechaninloop(Some(Fasta_record.of_header_exnline))|Some'>',Somerecord'->Somerecord'|Some_,None->raise(Exn"Not at a header line, but not currently in a sequence")|Some_,Somerecord'->letline=In_channel.input_line_exn~fix_win_eol:truechaninletseq_part=clean_sequencelineinletnew_seq=Fasta_record.seqrecord'^seq_partinloop(Some(Fasta_record.with_seqnew_seqrecord'))inloopNoneletinput_recordchan=U.try1input_record_exnchanletfold_records_exnchan~init~f=letrecloopaccrecord=matchrecordwith|None->acc|Somerecord'->loop(faccrecord')(input_record_exnchan)inloopinit(input_record_exnchan)letfold_recordschan~init~f=U.try_foldfold_records_exnchan~init~fletrecords_exnchan=List.rev(fold_records_exnchan~init:[]~f:(funrecordsrecord->record::records))letrecordschan=U.try1records_exnchanletfoldi_records_exnchan~init~f=snd(fold_records_exnchan~init:(0,init)~f:(fun(i,acc)record->(i+1,fiaccrecord)))letfoldi_recordschan~init~f=U.try_foldfoldi_records_exnchan~init~fletiter_records_exnchan~f=fold_records_exnchan~init:()~f:(fun()record->frecord)letiter_recordschan~f=fold_recordschan~init:()~f:(fun()record->frecord)letiteri_records_exnchan~f=foldi_records_exnchan~init:()~f:(funi()record->firecord)letiteri_recordschan~f=U.try_mapiteri_records_exnchan~fletwith_file_exnfname~f=In_channel.with_filefname~fletwith_filefname~f=U.try_mapwith_file_exnfname~f(* These are the with file versions of the above. *)letwith_file_records_exnfname=with_file_exnfname~f:records_exnletwith_file_recordsfname=U.try1with_file_records_exnfnameletwith_file_fold_records_exnfname~init~f=with_file_exnfname~f:(funchan->fold_records_exnchan~init~f)letwith_file_fold_recordsfname~init~f=U.try_foldwith_file_fold_records_exnfname~init~fletwith_file_foldi_records_exnfname~init~f=with_file_exnfname~f:(funchan->foldi_records_exnchan~init~f)letwith_file_foldi_recordsfname~init~f=U.try_foldwith_file_foldi_records_exnfname~init~fletwith_file_iter_records_exnfname~f=with_file_exnfname~f:(funchan->iter_records_exnchan~f)letwith_file_iter_recordsfname~f=U.try_mapwith_file_iter_records_exnfname~fletwith_file_iteri_records_exnfname~f=with_file_exnfname~f:(funchan->iteri_records_exnchan~f)letwith_file_iteri_recordsfname~f=U.try_mapwith_file_iteri_records_exnfname~f(* Sequence generating functions are a little bit different. *)letrecord_sequence_exnchan=Sequence.unfold~init:chan~f:(funch->Option.map(input_record_exnch)~f:(funrecord->(record,ch)))letrecord_sequencechan=Sequence.unfold~init:(Somechan)~f:(funchan'->matchchan'with(* None means the sequence is over. *)|None->None|Somechan''->(matchinput_recordchan''with(* Some Error seems weird, but we need to yield an Error so the caller
can handle it, then we need to trigger one more yield iteration to
end the sequence next time with the None channel. *)|Errorerr->Some(Errorerr,None)|Okrecord->(matchrecordwith(* None needed here to end the Sequence. *)|None->None|Somerecord'->Some(Or_error.returnrecord',Somechan''))))