-- | Miscellaneous general functions and Show, Eq, and Ord instances for PortID{-# LANGUAGE FlexibleInstances, UndecidableInstances, StandaloneDeriving #-}{-# LANGUAGE CPP #-}-- PortID instances{-# OPTIONS_GHC -fno-warn-orphans #-}moduleDatabase.MongoDB.Internal.UtilwhereimportControl.Applicative(Applicative(..),(<$>))importControl.Arrow(left)importControl.Exception(assert)importControl.Monad(liftM,liftM2)importData.Bits(Bits,(.|.))importData.Word(Word8)importNetwork(PortID(..))importNumeric(showHex)importSystem.IO(Handle)importSystem.IO.Error(mkIOError,eofErrorType)importSystem.Random(newStdGen)importSystem.Random.Shuffle(shuffle')importqualifiedData.ByteString.LazyasLimportqualifiedData.ByteStringasSimportControl.Monad.Error(MonadError(..),ErrorT(..),Error(..))importControl.Monad.Trans(MonadIO,liftIO)importData.BsonimportData.Text(Text)importqualifiedData.TextasT#if !MIN_VERSION_network(2, 4, 1)derivinginstanceShowPortIDderivinginstanceEqPortID#endifderivinginstanceOrdPortID-- | MonadIO with extra Applicative and Functor superclassesclass(MonadIOm,Applicativem,Functorm)=>MonadIO'minstance(MonadIOm,Applicativem,Functorm)=>MonadIO'm-- | A monadic sort implementation derived from the non-monadic one in ghc's PreludemergesortM::Monadm=>(a->a->mOrdering)->[a]->m[a]mergesortMcmp=mergesortM'cmp.mapwrapmergesortM'::Monadm=>(a->a->mOrdering)->[[a]]->m[a]mergesortM'_[]=return[]mergesortM'_[xs]=returnxsmergesortM'cmpxss=mergesortM'cmp=<<(merge_pairsMcmpxss)merge_pairsM::Monadm=>(a->a->mOrdering)->[[a]]->m[[a]]merge_pairsM_[]=return[]merge_pairsM_[xs]=return[xs]merge_pairsMcmp(xs:ys:xss)=liftM2(:)(mergeMcmpxsys)(merge_pairsMcmpxss)mergeM::Monadm=>(a->a->mOrdering)->[a]->[a]->m[a]mergeM_[]ys=returnysmergeM_xs[]=returnxsmergeMcmp(x:xs)(y:ys)=doc<-x`cmp`ycasecofGT->liftM(y:)(mergeMcmp(x:xs)ys)_->liftM(x:)(mergeMcmpxs(y:ys))wrap::a->[a]wrapx=[x]shuffle::[a]->IO[a]-- ^ Randomly shuffle items in listshufflelist=shuffle'list(lengthlist)<$>newStdGenloop::(Functorm,Monadm)=>m(Maybea)->m[a]-- ^ Repeatedy execute action, collecting results, until it returns Nothingloopact=act>>=maybe(return[])(\a->(a:)<$>loopact)untilSuccess::(MonadErrorem,Errore)=>(a->mb)->[a]->mb-- ^ Apply action to elements one at a time until one succeeds. Throw last error if all fail. Throw 'strMsg' error if list is empty.untilSuccess=untilSuccess'(strMsg"empty untilSuccess")untilSuccess'::(MonadErrorem)=>e->(a->mb)->[a]->mb-- ^ Apply action to elements one at a time until one succeeds. Throw last error if all fail. Throw given error if list is emptyuntilSuccess'e_[]=throwErroreuntilSuccess'_f(x:xs)=catchError(fx)(\e->untilSuccess'efxs)whenJust::(Monadm)=>Maybea->(a->m())->m()whenJustmValact=maybe(return())actmValliftIOE::(MonadIOm)=>(e->e')->ErrorTeIOa->ErrorTe'ma-- ^ lift IOE monad to ErrorT monad over some MonadIO mliftIOEf=ErrorT.liftIO.fmap(leftf).runErrorTrunIOE::ErrorTIOErrorIOa->IOa-- ^ Run action while catching explicit error and rethrowing in IO monadrunIOE(ErrorTaction)=action>>=eitherioErrorreturnupdateAssocs::(Eqk)=>k->v->[(k,v)]->[(k,v)]-- ^ Change or insert value of key in association listupdateAssocskeyvaluassocs=casebackof[]->(key,valu):front;_:back'->front++(key,valu):back'where(front,back)=break((key==).fst)assocsbitOr::(Numa,Bitsa)=>[a]->a-- ^ bit-or all numbers togetherbitOr=foldl(.|.)0(<.>)::Text->Text->Text-- ^ Concat first and second together with period in between. Eg. @\"hello\" \<.\> \"world\" = \"hello.world\"@a<.>b=T.appenda(T.cons'.'b)true1::Label->Document->Bool-- ^ Is field's value a 1 or True (MongoDB use both Int and Bools for truth values). Error if field not in document or field not a Num or Bool.true1kdoc=casevalueAtkdocofBoolb->bFloatn->n==1Int32n->n==1Int64n->n==1_->error$"expected "++showk++" to be Num or Bool in "++showdochGetN::Handle->Int->IOL.ByteString-- ^ Read N bytes from hande, blocking until all N bytes are read. If EOF is reached before N bytes then raise EOF exception.hGetNhn=assert(n>=0)$dobytes<-L.hGethnletx=fromEnum$L.lengthbytesifx>=nthenreturnbyteselseifx==0thenioError(mkIOErroreofErrorType"hGetN"(Justh)Nothing)elseL.appendbytes<$>hGetNh(n-x)byteStringHex::S.ByteString->String-- ^ Hexadecimal string representation of a byte string. Each byte yields two hexadecimal characters.byteStringHex=concatMapbyteHex.S.unpackbyteHex::Word8->String-- ^ Two char hexadecimal representation of bytebyteHexb=(ifb<16then('0':)elseid)(showHexb"")