moduleData.PropertyList.Binary.GetwhereimportControl.ApplicativeimportControl.MonadimportControl.Monad.Trans.Error({- instance Monad (Either a) -})importData.BitsimportqualifiedData.ByteString.Char8asBSC8importqualifiedData.ByteString.LazyasBLimportData.PropertyList.Binary.FloatimportData.PropertyList.Binary.TypesimportData.Serialize.GetimportqualifiedData.SequenceasSeqimportqualifiedData.TextasTextimportqualifiedData.Text.EncodingasTextimportData.TimeimportqualifiedData.Vector.UnboxedasVimportData.WordimportGHC.FloatrawBPListbs=doletheaderBS=BL.take8bsheader@(BPListHeaderversion)<-runGetLazybplistHeaderheaderBSwhen(version.&.0xff00/=0x3000)$Left"Unsupported bplist version"lettrailerBS=BL.drop(BL.lengthbs-bplistTrailerBytes)bstrailer<-runGetLazybplistTrailertrailerBS--TODO: sanity checksletnOffsets::Numa=>anOffsets=fromIntegral(numObjectstrailer)bytesPerOffset=fromIntegral(offsetIntSizetrailer)offsetsBS=BL.take(nOffsets*fromIntegralbytesPerOffset).BL.drop(fromIntegral(offsetTableOffsettrailer))$bsoffsets<-runGetLazy(replicateMnOffsets(sizedIntbytesPerOffset))offsetsBSreturn(RawBPListbsheader(V.fromListoffsets)trailer)readBPListRecords::BL.ByteString->EitherString(BPListRecordsAbs)readBPListRecordsbs=doraw<-rawBPListbslettlr=rawTrailerrawct=numObjectstlrroot=topObjecttlrrecs<-mapM(getBPListRecordraw)[0..ct-1]return(BPListRecordsroot(Seq.fromListrecs))getBPListRecord(RawBPListbs_hdroffsetstlr)objNum|objNum>=0&&fromIntegralobjNum<V.lengthoffsets=runGetLazy(bplistRecordobjRef)(BL.drop(fromIntegral(offsetsV.!fromIntegralobjNum))bs)|otherwise=Left"getBPListRecord: index out of range"whereobjRef=sizedInt(fromIntegral(objectRefSizetlr))asciiStringstr=doletbs=BSC8.packstrbs'<-getByteString(BSC8.lengthbs)if(bs==bs')thenreturn()elsefail("Expecting "++showstr)bplistHeaderBytes=8bplistHeader=doasciiString"bplist"BPListHeader<$>getWord16bebplistTrailerBytes=32bplistTrailer=constBPListTrailer<$>skip5-- _unused<*>getWord8-- sortVersion<*>getWord8-- offsetIntSize<*>getWord8-- objectRefSize<*>getWord64be-- numObjects<*>getWord64be-- topObject<*>getWord64be-- offsetTableOffsetbplistRecordref=msum[constBPLNull<$>bplNull,BPLBool<$>bplTrue,BPLBool<$>bplFalse,constBPLFill<$>bplFill,BPLInt<$>bplInt,BPLReal<$>bplFloat32,BPLReal<$>bplFloat64,BPLDate<$>bplDate,BPLData<$>bplData,BPLString<$>bplASCII,BPLString<$>bplUTF16,BPLUID<$>bplUID,BPLArray<$>bplArrayref,BPLSet<$>bplSetref,uncurryBPLDict<$>bplDictref]word8b=dob'<-getWord8ifb==b'thenreturnbelsefail("expecting "++showb)bplNull=word80x00bplTrue=word80x08>>returnFalsebplFalse=word80x09>>returnTruebplFill=word80x0fbplInt=dosz<-shiftL1.fromIntegral<$>halfByte0x1i<-sizedIntszreturn(interpretBPLIntszi)bplFloat32=doword80x22float2Double<$>getFloat32bebplFloat64=doword80x23getFloat64bebplDate=doword80x33interpretBPLDate.word64ToDouble<$>getWord64bebplData=dosz<-markerAndSize0x4getByteStringszbplASCII=dosz<-markerAndSize0x5BSC8.unpack<$>getByteStringszbplUTF16=dosz<-markerAndSize0x6Text.unpack.Text.decodeUtf16BE<$>getByteString(2*sz)bplUID=dosz<-fmap(1+)(halfByte0x8)sizedInt(fromIntegralsz)bplArrayref=dosz<-markerAndSize0xAreplicateMszrefbplSetref=dosz<-markerAndSize0xCreplicateMszrefbplDictref=dosz<-markerAndSize0xDks<-replicateMszrefvs<-replicateMszrefreturn(ks,vs)halfBytex=domarker<-getWord8ifmarker`shiftR`4==xthenreturn(marker.&.0x0f)elsefail("expecting marker "++showx)markerAndSizex=domarker<-halfBytexcasemarkerof0xf->dointSz<-shiftL1.fromIntegral<$>halfByte0x1sizedIntintSz_->return(fromIntegralmarker)sizedInt::(Integrali,Bitsi)=>Word->GetisizedInt0=return0sizedInt1=fromIntegral<$>getWord8sizedInt2=fromIntegral<$>getWord16besizedInt4=fromIntegral<$>getWord32besizedInt8=fromIntegral<$>getWord64besizedIntn|n<0=fail("sizedInt: negative size: "++shown)|otherwise=doleta=n`shiftR`1;b=n-ax<-sizedIntay<-sizedIntbreturn((x`shiftL`(fromIntegralb*8)).|.y)-- CFBinaryPList.c says:{-
// in format version '00', 1, 2, and 4-byte integers have to be interpreted as unsigned,
// whereas 8-byte integers are signed (and 16-byte when available)
// negative 1, 2, 4-byte integers are always emitted as 8 bytes in format '00'
// integers are not required to be in the most compact possible representation, but only the last 64 bits are significant currently
-}interpretBPLInt::Word->Integer->IntegerinterpretBPLIntszi|isSigned&&testBitisignBit=i-bitnBits|otherwise=iwhereisSigned=sz>=8nBits=fromIntegralsz*8signBit=nBits-1-- http://developer.apple.com/library/mac/#documentation/CoreFoundation/Reference/CFDateRef/Reference/reference.html-- says:{-
Absolute time is measured in seconds relative to the absolute reference
date of Jan 1 2001 00:00:00 GMT. A positive value represents a date
after the reference date, a negative value represents a date before it.
For example, the absolute time -32940326 is equivalent to December 16th,
1999 at 17:54:34.
-}interpretBPLDate::Double->UTCTimeinterpretBPLDatesec=addUTCTime(realToFracsec)epochwhereepoch=UTCTime(fromGregorian200111)0getFloat32be::GetFloatgetFloat32be=dod<-getWord32bereturn$!word32ToFloatdgetFloat64be::GetDoublegetFloat64be=dod<-getWord64bereturn$!word64ToDoubled