moduleDatabase.Redis.Internal(RedisReply(..),ByteString,request,crlf,toUTF8,unwrapReply)whereimportData.ByteString.UTF8(ByteString)importqualifiedData.ByteString.UTF8asUimportqualifiedData.ByteStringasBimportSystem.IOdataRedisReply=RedisSingleByteString|RedisErrorByteString|RedisIntegerInt|RedisBulk[MaybeRedisReply]deriving(Eq,Show)------------------------------------------------------------------------------send::Handle->ByteString-- ^ the request->IO(MaybeRedisReply)sendhreq=B.hPuthreq>>B.hPuth(toUTF8crlf)>>hFlushh>>processReplyh-------------------------------------------------------------------------------- | Formats and sends the requestrequest::Handle->[ByteString]->IO(MaybeRedisReply)request_[]=return$Just(RedisInteger0)requesthcommandList=sendh$B.concat[bulkLengthcommandList,toUTF8crlf,sendCommandscommandList]wheresendCommands[]=toUTF8" "sendCommands(c:cs)=B.append(B.concat[argLengthc,toUTF8crlf,c,toUTF8crlf])(sendCommandscs)bulkLengthcmds=toUTF8$'*':(show$lengthcmds)argLengtharg=toUTF8$'$':(show$B.lengtharg)------------------------------------------------------------------------------processReply::Handle->IO(MaybeRedisReply)processReplyh=doreply<-fmaptrim$B.hGetLinehcaseU.unconsreplyofJust('+',rest)->return$Just(RedisSinglerest)Just('-',rest)->return$Just(RedisErrorrest)Just(':',rest)->integerReplyrestJust('$',rest)->bulkReplyrestJust('*',rest)->multiBulkReplyrestJust(_,_)->return$NothingNothing->return$Nothingwheretrim=B.takeWhile(\c->c/=13&&c/=10)integerReplyb=return$Just$RedisInteger$toIntbbulkReplyb=dobody<-bulkBody$toIntbreturn$casebodyofJustx->Just(RedisBulk[Just$RedisSinglex])_->NothingbulkBody(-1)=return$NothingbulkBodysize=dobody<-B.hGeth(size+2)letreply=B.takesizebodyreturn$JustreplymultiBulkReplyb=dobulks<-multiBulkReplies$toIntbreturn$Just$RedisBulkbulksmultiBulkReplies(-1)=return$[Nothing]multiBulkReplies0=return$[Nothing]multiBulkRepliesn=dothis<-processReplyhrest<-multiBulkReplies(n-1)return$(this:rest)------------------------------------------------------------------------------crlf::Stringcrlf="\r\n"------------------------------------------------------------------------------toUTF8::String->ByteStringtoUTF8=U.fromString------------------------------------------------------------------------------toInt::ByteString->InttoIntb=read(U.toStringb)::Int-------------------------------------------------------------------------------- FIXME: this needs to deal with the rest of the patterns, but this way is-- awkward.unwrapReply::MaybeRedisReply->StringunwrapReplyreply=casereplyofJust(RedisBulk[Just(RedisSinglex)])->U.toStringxJust(RedisSinglex)->U.toStringxJust(RedisErrorx)->U.toStringxJust(RedisIntegerx)->showxNothing->"Nada"_->"Not yet Supported"