{-# LANGUAGE ScopedTypeVariables, BangPatterns #-}modulePCD.Internal.StorableFieldType(parseBinaryPoints,pokeBinaryPoints)whereimportControl.ApplicativeimportControl.Lens((^.))importControl.Monad(void)importqualifiedData.VectorasBimportqualifiedData.Vector.MutableasBMimportPCD.HeaderimportForeign.Marshal.Alloc(allocaBytes)importForeign.Ptr(Ptr,castPtr,plusPtr)importForeign.Storable(Storable,peek,poke,sizeOf)importSystem.IO(Handle,hGetBuf)-- Strict tuple used during parsing.dataPa=P!FieldType{-# UNPACK #-}!(Ptra)-- |'peek' a 'Storable' and advance the source pointer past this-- datum.peekStep::forallab.Storablea=>(a->FieldType)->Ptrb->IO(Pb)peekStepmkptr=P.mk<$>peek(castPtrptr)<*>pure(plusPtrptr(sizeOf(undefined::a)))parseBinaryField::DimType->Int->Ptra->IO(Pa)parseBinaryFieldI1=peekStepTCharparseBinaryFieldI2=peekStepTShortparseBinaryFieldI4=peekStepTIntparseBinaryFieldU1=peekStepTUcharparseBinaryFieldU2=peekStepTUshortparseBinaryFieldU4=peekStepTUintparseBinaryFieldF4=peekStepTFloatparseBinaryFieldF8=peekStepTDoubleparseBinaryFieldts=error("Unknown field type: "++showt++" "++shows)parseBinaryPoints::Header->Handle->IO(B.Vector(B.VectorFieldType))parseBinaryPointspcdhh=B.unsafeFreeze=<<dov<-BM.newnletgo!i!ptr|i==n=returnv|otherwise=do(pt,ptr')<-pointParserBinptrBM.writeviptgo(i+1)ptr'allocaBytesnumBytes$\ptr->hGetBufhptrnumBytes>>go0ptrwheren=fromIntegral$pcdh^.pointsnumBytes=n*sum(zipWith(*)(pcdh^.counts)(pcdh^.sizes))pointParserBin=parseBinaryFieldspcdh-- Parse all fields of a single point. A point is represented as a-- 'B.Vector' of its fields. The returned 'Ptr' is just after the-- parsed point.parseBinaryFields::Header->Ptra->IO(B.VectorFieldType,Ptra)parseBinaryFieldsh=auxwherenumFields=sum(h^.counts)auxptr0=(\(v,ptr)->(,)<$>B.unsafeFreezev<*>pureptr)=<<dov<-BM.newnumFieldsletwrite=BM.writevgo!i!ptrsstscs|i==numFields=return(v,ptr)|otherwise=doPxptr'<-parseBinaryField(headts)(headss)ptrwriteixlet(c:cs')=csifc==1thengo(i+1)ptr'(tailss)(tailts)cs'elsego(i+1)ptr'ssts(c-1:cs')go0ptr0(h^.sizes)(h^.dimTypes)(h^.counts)pokeStep::forallab.Storablea=>a->Ptrb->IO(Ptrb)pokeStepxptr=poke(castPtrptr)x>>return(plusPtrptr(sizeOf(undefined::a)))pokeBinaryField::FieldType->Ptra->IO(Ptra)pokeBinaryField(TUcharx)=pokeStepxpokeBinaryField(TCharx)=pokeStepxpokeBinaryField(TUshortx)=pokeStepxpokeBinaryField(TShortx)=pokeStepxpokeBinaryField(TUintx)=pokeStepxpokeBinaryField(TIntx)=pokeStepxpokeBinaryField(TFloatx)=pokeStepxpokeBinaryField(TDoublex)=pokeStepxpokeBinaryFields::Ptra->B.VectorFieldType->IO(Ptra)pokeBinaryFields=B.foldM'auxwhereauxptrx=pokeBinaryFieldxptrpokeBinaryPoints::Ptra->B.Vector(B.VectorFieldType)->IO()pokeBinaryPoints=(void.).B.foldM'pokeBinaryFields