redis-resp (empty) → 0.2
raw patch · 6 files changed
+1795/−0 lines, 6 filesdep +attoparsecdep +basedep +bytestringsetup-changed
Dependencies added: attoparsec, base, bytestring, bytestring-conversion, containers, dlist, double-conversion, operational, semigroups, split, transformers
Files
- LICENSE +373/−0
- Setup.hs +2/−0
- redis-resp.cabal +50/−0
- src/Data/Redis.hs +14/−0
- src/Data/Redis/Command.hs +1261/−0
- src/Data/Redis/Resp.hs +95/−0
+ LICENSE view
@@ -0,0 +1,373 @@+Mozilla Public License Version 2.0+==================================++1. Definitions+--------------++1.1. "Contributor"+ means each individual or legal entity that creates, contributes to+ the creation of, or owns Covered Software.++1.2. "Contributor Version"+ means the combination of the Contributions of others (if any) used+ by a Contributor and that particular Contributor's Contribution.++1.3. "Contribution"+ means Covered Software of a particular Contributor.++1.4. "Covered Software"+ means Source Code Form to which the initial Contributor has attached+ the notice in Exhibit A, the Executable Form of such Source Code+ Form, and Modifications of such Source Code Form, in each case+ including portions thereof.++1.5. "Incompatible With Secondary Licenses"+ means++ (a) that the initial Contributor has attached the notice described+ in Exhibit B to the Covered Software; or++ (b) that the Covered Software was made available under the terms of+ version 1.1 or earlier of the License, but not also under the+ terms of a Secondary License.++1.6. "Executable Form"+ means any form of the work other than Source Code Form.++1.7. "Larger Work"+ means a work that combines Covered Software with other material, in+ a separate file or files, that is not Covered Software.++1.8. "License"+ means this document.++1.9. "Licensable"+ means having the right to grant, to the maximum extent possible,+ whether at the time of the initial grant or subsequently, any and+ all of the rights conveyed by this License.++1.10. "Modifications"+ means any of the following:++ (a) any file in Source Code Form that results from an addition to,+ deletion from, or modification of the contents of Covered+ Software; or++ (b) any new file in Source Code Form that contains any Covered+ Software.++1.11. "Patent Claims" of a Contributor+ means any patent claim(s), including without limitation, method,+ process, and apparatus claims, in any patent Licensable by such+ Contributor that would be infringed, but for the grant of the+ License, by the making, using, selling, offering for sale, having+ made, import, or transfer of either its Contributions or its+ Contributor Version.++1.12. "Secondary License"+ means either the GNU General Public License, Version 2.0, the GNU+ Lesser General Public License, Version 2.1, the GNU Affero General+ Public License, Version 3.0, or any later versions of those+ licenses.++1.13. "Source Code Form"+ means the form of the work preferred for making modifications.++1.14. "You" (or "Your")+ means an individual or a legal entity exercising rights under this+ License. For legal entities, "You" includes any entity that+ controls, is controlled by, or is under common control with You. For+ purposes of this definition, "control" means (a) the power, direct+ or indirect, to cause the direction or management of such entity,+ whether by contract or otherwise, or (b) ownership of more than+ fifty percent (50%) of the outstanding shares or beneficial+ ownership of such entity.++2. License Grants and Conditions+--------------------------------++2.1. Grants++Each Contributor hereby grants You a world-wide, royalty-free,+non-exclusive license:++(a) under intellectual property rights (other than patent or trademark)+ Licensable by such Contributor to use, reproduce, make available,+ modify, display, perform, distribute, and otherwise exploit its+ Contributions, either on an unmodified basis, with Modifications, or+ as part of a Larger Work; and++(b) under Patent Claims of such Contributor to make, use, sell, offer+ for sale, have made, import, and otherwise transfer either its+ Contributions or its Contributor Version.++2.2. Effective Date++The licenses granted in Section 2.1 with respect to any Contribution+become effective for each Contribution on the date the Contributor first+distributes such Contribution.++2.3. Limitations on Grant Scope++The licenses granted in this Section 2 are the only rights granted under+this License. No additional rights or licenses will be implied from the+distribution or licensing of Covered Software under this License.+Notwithstanding Section 2.1(b) above, no patent license is granted by a+Contributor:++(a) for any code that a Contributor has removed from Covered Software;+ or++(b) for infringements caused by: (i) Your and any other third party's+ modifications of Covered Software, or (ii) the combination of its+ Contributions with other software (except as part of its Contributor+ Version); or++(c) under Patent Claims infringed by Covered Software in the absence of+ its Contributions.++This License does not grant any rights in the trademarks, service marks,+or logos of any Contributor (except as may be necessary to comply with+the notice requirements in Section 3.4).++2.4. Subsequent Licenses++No Contributor makes additional grants as a result of Your choice to+distribute the Covered Software under a subsequent version of this+License (see Section 10.2) or under the terms of a Secondary License (if+permitted under the terms of Section 3.3).++2.5. Representation++Each Contributor represents that the Contributor believes its+Contributions are its original creation(s) or it has sufficient rights+to grant the rights to its Contributions conveyed by this License.++2.6. Fair Use++This License is not intended to limit any rights You have under+applicable copyright doctrines of fair use, fair dealing, or other+equivalents.++2.7. Conditions++Sections 3.1, 3.2, 3.3, and 3.4 are conditions of the licenses granted+in Section 2.1.++3. Responsibilities+-------------------++3.1. Distribution of Source Form++All distribution of Covered Software in Source Code Form, including any+Modifications that You create or to which You contribute, must be under+the terms of this License. You must inform recipients that the Source+Code Form of the Covered Software is governed by the terms of this+License, and how they can obtain a copy of this License. You may not+attempt to alter or restrict the recipients' rights in the Source Code+Form.++3.2. Distribution of Executable Form++If You distribute Covered Software in Executable Form then:++(a) such Covered Software must also be made available in Source Code+ Form, as described in Section 3.1, and You must inform recipients of+ the Executable Form how they can obtain a copy of such Source Code+ Form by reasonable means in a timely manner, at a charge no more+ than the cost of distribution to the recipient; and++(b) You may distribute such Executable Form under the terms of this+ License, or sublicense it under different terms, provided that the+ license for the Executable Form does not attempt to limit or alter+ the recipients' rights in the Source Code Form under this License.++3.3. Distribution of a Larger Work++You may create and distribute a Larger Work under terms of Your choice,+provided that You also comply with the requirements of this License for+the Covered Software. If the Larger Work is a combination of Covered+Software with a work governed by one or more Secondary Licenses, and the+Covered Software is not Incompatible With Secondary Licenses, this+License permits You to additionally distribute such Covered Software+under the terms of such Secondary License(s), so that the recipient of+the Larger Work may, at their option, further distribute the Covered+Software under the terms of either this License or such Secondary+License(s).++3.4. Notices++You may not remove or alter the substance of any license notices+(including copyright notices, patent notices, disclaimers of warranty,+or limitations of liability) contained within the Source Code Form of+the Covered Software, except that You may alter any license notices to+the extent required to remedy known factual inaccuracies.++3.5. Application of Additional Terms++You may choose to offer, and to charge a fee for, warranty, support,+indemnity or liability obligations to one or more recipients of Covered+Software. However, You may do so only on Your own behalf, and not on+behalf of any Contributor. You must make it absolutely clear that any+such warranty, support, indemnity, or liability obligation is offered by+You alone, and You hereby agree to indemnify every Contributor for any+liability incurred by such Contributor as a result of warranty, support,+indemnity or liability terms You offer. You may include additional+disclaimers of warranty and limitations of liability specific to any+jurisdiction.++4. Inability to Comply Due to Statute or Regulation+---------------------------------------------------++If it is impossible for You to comply with any of the terms of this+License with respect to some or all of the Covered Software due to+statute, judicial order, or regulation then You must: (a) comply with+the terms of this License to the maximum extent possible; and (b)+describe the limitations and the code they affect. Such description must+be placed in a text file included with all distributions of the Covered+Software under this License. Except to the extent prohibited by statute+or regulation, such description must be sufficiently detailed for a+recipient of ordinary skill to be able to understand it.++5. Termination+--------------++5.1. The rights granted under this License will terminate automatically+if You fail to comply with any of its terms. However, if You become+compliant, then the rights granted under this License from a particular+Contributor are reinstated (a) provisionally, unless and until such+Contributor explicitly and finally terminates Your grants, and (b) on an+ongoing basis, if such Contributor fails to notify You of the+non-compliance by some reasonable means prior to 60 days after You have+come back into compliance. Moreover, Your grants from a particular+Contributor are reinstated on an ongoing basis if such Contributor+notifies You of the non-compliance by some reasonable means, this is the+first time You have received notice of non-compliance with this License+from such Contributor, and You become compliant prior to 30 days after+Your receipt of the notice.++5.2. If You initiate litigation against any entity by asserting a patent+infringement claim (excluding declaratory judgment actions,+counter-claims, and cross-claims) alleging that a Contributor Version+directly or indirectly infringes any patent, then the rights granted to+You by any and all Contributors for the Covered Software under Section+2.1 of this License shall terminate.++5.3. In the event of termination under Sections 5.1 or 5.2 above, all+end user license agreements (excluding distributors and resellers) which+have been validly granted by You or Your distributors under this License+prior to termination shall survive termination.++************************************************************************+* *+* 6. Disclaimer of Warranty *+* ------------------------- *+* *+* Covered Software is provided under this License on an "as is" *+* basis, without warranty of any kind, either expressed, implied, or *+* statutory, including, without limitation, warranties that the *+* Covered Software is free of defects, merchantable, fit for a *+* particular purpose or non-infringing. The entire risk as to the *+* quality and performance of the Covered Software is with You. *+* Should any Covered Software prove defective in any respect, You *+* (not any Contributor) assume the cost of any necessary servicing, *+* repair, or correction. This disclaimer of warranty constitutes an *+* essential part of this License. No use of any Covered Software is *+* authorized under this License except under this disclaimer. *+* *+************************************************************************++************************************************************************+* *+* 7. Limitation of Liability *+* -------------------------- *+* *+* Under no circumstances and under no legal theory, whether tort *+* (including negligence), contract, or otherwise, shall any *+* Contributor, or anyone who distributes Covered Software as *+* permitted above, be liable to You for any direct, indirect, *+* special, incidental, or consequential damages of any character *+* including, without limitation, damages for lost profits, loss of *+* goodwill, work stoppage, computer failure or malfunction, or any *+* and all other commercial damages or losses, even if such party *+* shall have been informed of the possibility of such damages. This *+* limitation of liability shall not apply to liability for death or *+* personal injury resulting from such party's negligence to the *+* extent applicable law prohibits such limitation. Some *+* jurisdictions do not allow the exclusion or limitation of *+* incidental or consequential damages, so this exclusion and *+* limitation may not apply to You. *+* *+************************************************************************++8. Litigation+-------------++Any litigation relating to this License may be brought only in the+courts of a jurisdiction where the defendant maintains its principal+place of business and such litigation shall be governed by laws of that+jurisdiction, without reference to its conflict-of-law provisions.+Nothing in this Section shall prevent a party's ability to bring+cross-claims or counter-claims.++9. Miscellaneous+----------------++This License represents the complete agreement concerning the subject+matter hereof. If any provision of this License is held to be+unenforceable, such provision shall be reformed only to the extent+necessary to make it enforceable. Any law or regulation which provides+that the language of a contract shall be construed against the drafter+shall not be used to construe this License against a Contributor.++10. Versions of the License+---------------------------++10.1. New Versions++Mozilla Foundation is the license steward. Except as provided in Section+10.3, no one other than the license steward has the right to modify or+publish new versions of this License. Each version will be given a+distinguishing version number.++10.2. Effect of New Versions++You may distribute the Covered Software under the terms of the version+of the License under which You originally received the Covered Software,+or under the terms of any subsequent version published by the license+steward.++10.3. Modified Versions++If you create software not governed by this License, and you want to+create a new license for such software, you may create and use a+modified version of this License if you rename the license and remove+any references to the name of the license steward (except to note that+such modified license differs from this License).++10.4. Distributing Source Code Form that is Incompatible With Secondary+Licenses++If You choose to distribute Source Code Form that is Incompatible With+Secondary Licenses under the terms of this version of the License, the+notice described in Exhibit B of this License must be attached.++Exhibit A - Source Code Form License Notice+-------------------------------------------++ This Source Code Form is subject to the terms of the Mozilla Public+ License, v. 2.0. If a copy of the MPL was not distributed with this+ file, You can obtain one at http://mozilla.org/MPL/2.0/.++If it is not possible or desirable to put the notice in a particular+file, then You may include the notice in a location (such as a LICENSE+file in a relevant directory) where a recipient would be likely to look+for such a notice.++You may add additional accurate notices of copyright ownership.++Exhibit B - "Incompatible With Secondary Licenses" Notice+---------------------------------------------------------++ This Source Code Form is "Incompatible With Secondary Licenses", as+ defined by the Mozilla Public License, v. 2.0.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ redis-resp.cabal view
@@ -0,0 +1,50 @@+name: redis-resp+version: 0.2+synopsis: REdis Serialization Protocol (RESP) implementation.+license: OtherLicense+license-file: LICENSE+author: Toralf Wittner+maintainer: Toralf Wittner <tw@dtex.org>+copyright: (c) 2014 Toralf Wittner+homepage: https://github.com/twittner/redis-resp/+bug-reports: https://github.com/twittner/redis-resp/issues+stability: experimental+category: Data+build-type: Simple+cabal-version: >= 1.10++description:+ REdis Serialization Protocol (RESP) implementation as specified+ in <http://redis.io/topics/protocol>.+ .+ Additionally most Redis commands are declared as an GADT which+ enables different interpretations such as+ <http://hackage.haskell.org/package/redis-io redis-io>.++source-repository head+ type: git+ location: git://github.com/twittner/redis-resp.git++library+ default-language: Haskell2010+ hs-source-dirs: src+ ghc-options: -Wall -O2 -fwarn-tabs -funbox-strict-fields+ ghc-prof-options: -prof -auto-all++ exposed-modules:+ Data.Redis+ Data.Redis.Resp+ Data.Redis.Command++ build-depends:+ attoparsec >= 0.11 && < 0.13+ , base >= 4.5 && < 5.0+ , bytestring >= 0.10.4 && < 0.11+ , bytestring-conversion == 0.2.*+ , containers >= 0.5 && < 0.6+ , double-conversion == 2.0.*+ , dlist == 0.7.*+ , operational == 0.2.*+ , semigroups == 0.15.*+ , split == 0.2.*+ , transformers >= 0.3 && < 0.5
+ src/Data/Redis.hs view
@@ -0,0 +1,14 @@+-- This Source Code Form is subject to the terms of the Mozilla Public+-- License, v. 2.0. If a copy of the MPL was not distributed with this+-- file, You can obtain one at http://mozilla.org/MPL/2.0/.++module Data.Redis+ ( module C+ , Resp (..)+ , resp+ , decode+ , encode+ ) where++import Data.Redis.Resp+import Data.Redis.Command as C
+ src/Data/Redis/Command.hs view
@@ -0,0 +1,1261 @@+-- This Source Code Form is subject to the terms of the Mozilla Public+-- License, v. 2.0. If a copy of the MPL was not distributed with this+-- file, You can obtain one at http://mozilla.org/MPL/2.0/.++{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}++module Data.Redis.Command+ ( -- * Types+ Redis+ , PubSub+ , Command (..)+ , PubSubCommand (..)+ , PushMessage (..)+ , Result+ , RedisError (..)+ , RedisType (..)+ , TTL (..)+ , Side (..)+ , Choose (..)+ , Aggregate (..)+ , Min (..)+ , Max (..)+ , ScoreList (..)+ , Seconds (..)+ , Timestamp (..)+ , Field+ , Index+ , Key (..)++ -- ** Cursor+ , Cursor+ , zero++ -- ** Non-empty lists+ , one++ -- ** Options+ , Opts+ , none++ -- ** Bit+ , BitStart+ , BitEnd+ , start+ , end++ -- * Commands+ -- ** Connection+ , auth+ , echo+ , ping+ , quit+ , select++ -- ** Server+ , bgrewriteaof+ , bgsave+ , dbsize+ , flushall+ , flushdb+ , lastsave+ , save++ -- ** Transactions+ , discard+ , exec+ , execRaw+ , multi+ , unwatch+ , watch++ -- ** Keys+ , del+ , dump+ , exists+ , expire+ , expireat+ , keys+ , persist+ , randomkey+ , rename+ , renamenx+ , ttl+ , typeof++ -- ** Strings+ , append+ , decr+ , decrby+ , get+ , getrange+ , getset+ , incr+ , incrby+ , incrbyfloat+ , mget+ , mset+ , msetnx+ , set, ex, px, xx, nx+ , setrange+ , strlen++ -- ** Bits+ , bitand+ , bitcount, range+ , bitnot+ , bitor+ , bitpos+ , bitxor+ , getbit+ , setbit++ -- ** Hashes+ , hdel+ , hexists+ , hget+ , hgetall+ , hincrby+ , hincrbyfloat+ , hkeys+ , hlen+ , hmget+ , hmset+ , hset+ , hsetnx+ , hvals++ -- ** Lists+ , blpop+ , brpop+ , brpoplpush+ , lindex+ , linsert+ , llen+ , lpop+ , lpush+ , lpushx+ , lrange+ , lrem+ , lset+ , ltrim+ , rpop+ , rpoplpush+ , rpush+ , rpushx++ -- ** Sets+ , sadd+ , scard+ , sdiff+ , sdiffstore+ , sinter+ , sinterstore+ , sismember+ , smembers+ , smove+ , spop+ , srandmember+ , srem+ , sunion+ , sunionstore++ -- ** Sorted Sets+ , zadd+ , zcard+ , zcount+ , zincrby+ , zinterstore+ , zlexcount+ , zrange+ , zrangebylex+ , zrangebyscore+ , zrank+ , zrem+ , zremrangebylex+ , zremrangebyrank+ , zremrangebyscore+ , zrevrangebyscore+ , zrevrange+ , zrevrank+ , zscore+ , zunionstore++ -- ** HyperLogLog+ , pfadd+ , pfcount+ , pfmerge++ -- ** Scan+ , scan, match, count+ , hscan+ , sscan+ , zscan++ -- ** Sort+ , sort, by, limit, getkey, asc, desc, alpha, store++ -- ** Pub/Sub+ , publish+ , subscribe+ , psubscribe+ , unsubscribe+ , punsubscribe++ -- * Response Reading+ , readInt+ , readInt'Null+ , readBool+ , readTTL+ , readBulk'Null+ , readBulk+ , readListOfMaybes+ , readList+ , readScoreList+ , readFields+ , readKeyValue+ , readBulk'Array+ , readScan+ , matchStr+ , readType+ , fromSet+ , anyStr+ , readPushMessage++ -- * Re-exports+ , NonEmpty (..)+ , NE.nonEmpty+ ) where++import Control.Applicative+import Control.Exception (Exception)+import Control.Monad.Operational+import Data.ByteString.Builder (int64Dec)+import Data.ByteString.Builder.Extra+import Data.ByteString.Conversion+import Data.ByteString.Lazy (ByteString, fromStrict)+import Data.DList (DList, cons)+import Data.Double.Conversion.ByteString (toShortest)+import Data.Foldable (toList, foldr)+import Data.Int+import Data.List.NonEmpty (NonEmpty (..), (<|))+import Data.List.Split (chunksOf)+import Data.Maybe (maybeToList)+import Data.Monoid hiding (Sum)+import Data.Redis.Resp+import Data.String+import Data.Typeable+import GHC.TypeLits+import Prelude hiding (foldr, readList)++import qualified Data.ByteString.Lazy as Lazy+import qualified Data.DList as DL+import qualified Data.List.NonEmpty as NE++-- | Redis error type.+data RedisError+ = RedisError !ByteString+ -- ^ General error case.+ | InvalidResponse !String+ -- ^ The received response is invalid or unexpected (e.g. a bulk+ -- string instead of an integer).+ | InvalidConversion !String+ -- ^ ByteString conversion using 'FromByteString' failed.+ deriving (Eq, Ord, Show, Typeable)++instance Exception RedisError++type Redis = ProgramT Command+type PubSub = ProgramT PubSubCommand+type Result = Either RedisError++-- | Redis commands.+data Command :: * -> * where+ -- Connection+ Ping :: Resp -> Command ()+ Echo :: FromByteString a => Resp -> Command a+ Auth :: Resp -> Command ()+ Quit :: Resp -> Command ()+ Select :: Resp -> Command ()++ -- Server+ BgRewriteAOF :: Resp -> Command ()+ BgSave :: Resp -> Command ()+ Save :: Resp -> Command ()+ DbSize :: Resp -> Command Int64+ FlushAll :: Resp -> Command ()+ FlushDb :: Resp -> Command ()+ LastSave :: Resp -> Command Int64++ -- Transactions+ Multi :: Resp -> Command ()+ Watch :: Resp -> Command ()+ Unwatch :: Resp -> Command ()+ Discard :: Resp -> Command ()+ Exec :: FromByteString a => Resp -> Command [a]+ ExecRaw :: Resp -> Command Resp++ -- Keys+ Del :: Resp -> Command Int64+ Dump :: Resp -> Command (Maybe ByteString)+ Exists :: Resp -> Command Bool+ Expire :: Resp -> Command Bool+ ExpireAt :: Resp -> Command Bool+ Persist :: Resp -> Command Bool+ Keys :: Resp -> Command [Key]+ RandomKey :: Resp -> Command (Maybe Key)+ Rename :: Resp -> Command ()+ RenameNx :: Resp -> Command Bool+ Sort :: FromByteString a => Resp -> Command [a]+ Ttl :: Resp -> Command (Maybe TTL)+ Type :: Resp -> Command (Maybe RedisType)+ Scan :: FromByteString a => Resp -> Command (Cursor, [a])++ -- Strings+ Append :: Resp -> Command Int64+ Get :: FromByteString a => Resp -> Command (Maybe a)+ GetRange :: FromByteString a => Resp -> Command a+ GetSet :: FromByteString a => Resp -> Command (Maybe a)+ MGet :: FromByteString a => Resp -> Command [Maybe a]+ MSet :: Resp -> Command ()+ MSetNx :: Resp -> Command Bool+ Set :: Resp -> Command Bool+ SetRange :: Resp -> Command Int64+ StrLen :: Resp -> Command Int64++ -- Bits+ BitAnd :: Resp -> Command Int64+ BitCount :: Resp -> Command Int64+ BitNot :: Resp -> Command Int64+ BitOr :: Resp -> Command Int64+ BitPos :: Resp -> Command Int64+ BitXOr :: Resp -> Command Int64+ GetBit :: Resp -> Command Int64+ SetBit :: Resp -> Command Int64++ -- Numeric+ Decr :: Resp -> Command Int64+ DecrBy :: Resp -> Command Int64+ Incr :: Resp -> Command Int64+ IncrBy :: Resp -> Command Int64+ IncrByFloat :: Resp -> Command Double++ -- Hashes+ HDel :: Resp -> Command Int64+ HExists :: Resp -> Command Bool+ HGet :: FromByteString a => Resp -> Command (Maybe a)+ HGetAll :: FromByteString a => Resp -> Command [(Field, a)]+ HIncrBy :: Resp -> Command Int64+ HIncrByFloat :: Resp -> Command Double+ HKeys :: Resp -> Command [Field]+ HLen :: Resp -> Command Int64+ HMGet :: FromByteString a => Resp -> Command [Maybe a]+ HMSet :: Resp -> Command ()+ HSet :: Resp -> Command Bool+ HSetNx :: Resp -> Command Bool+ HVals :: FromByteString a => Resp -> Command [a]+ HScan :: FromByteString a => Resp -> Command (Cursor, [a])++ -- Lists+ BLPop :: FromByteString a => Int64 -> Resp -> Command (Maybe (Key, a))+ BRPop :: FromByteString a => Int64 -> Resp -> Command (Maybe (Key, a))+ BRPopLPush :: FromByteString a => Int64 -> Resp -> Command (Maybe a)+ LIndex :: FromByteString a => Resp -> Command (Maybe a)+ LInsert :: Resp -> Command Int64+ LLen :: Resp -> Command Int64+ LPop :: FromByteString a => Resp -> Command (Maybe a)+ LPush :: Resp -> Command Int64+ LPushX :: Resp -> Command Int64+ LRange :: FromByteString a => Resp -> Command [a]+ LRem :: Resp -> Command Int64+ LSet :: Resp -> Command ()+ LTrim :: Resp -> Command ()+ RPop :: FromByteString a => Resp -> Command (Maybe a)+ RPopLPush :: FromByteString a => Resp -> Command (Maybe a)+ RPush :: Resp -> Command Int64+ RPushX :: Resp -> Command Int64++ -- Sets+ SAdd :: Resp -> Command Int64+ SCard :: Resp -> Command Int64+ SDiff :: FromByteString a => Resp -> Command [a]+ SDiffStore :: Resp -> Command Int64+ SInter :: FromByteString a => Resp -> Command [a]+ SInterStore :: Resp -> Command Int64+ SIsMember :: Resp -> Command Bool+ SMembers :: FromByteString a => Resp -> Command [a]+ SMove :: Resp -> Command Bool+ SPop :: FromByteString a => Resp -> Command (Maybe a)+ SRandMember :: FromByteString a => Choose -> Resp -> Command [a]+ SRem :: Resp -> Command Int64+ SScan :: FromByteString a => Resp -> Command (Cursor, [a])+ SUnion :: FromByteString a => Resp -> Command [a]+ SUnionStore :: Resp -> Command Int64++ -- Sorted Sets+ ZAdd :: Resp -> Command Int64+ ZCard :: Resp -> Command Int64+ ZCount :: Resp -> Command Int64+ ZIncrBy :: Resp -> Command Double+ ZInterStore :: Resp -> Command Int64+ ZLexCount :: Resp -> Command Int64+ ZRange :: FromByteString a => Bool -> Resp -> Command (ScoreList a)+ ZRangeByLex :: FromByteString a => Resp -> Command [a]+ ZRangeByScore :: FromByteString a => Bool -> Resp -> Command (ScoreList a)+ ZRank :: Resp -> Command (Maybe Int64)+ ZRem :: Resp -> Command Int64+ ZRemRangeByLex :: Resp -> Command Int64+ ZRemRangeByRank :: Resp -> Command Int64+ ZRemRangeByScore :: Resp -> Command Int64+ ZRevRange :: FromByteString a => Bool -> Resp -> Command (ScoreList a)+ ZRevRangeByScore :: FromByteString a => Bool -> Resp -> Command (ScoreList a)+ ZRevRank :: Resp -> Command (Maybe Int64)+ ZScan :: FromByteString a => Resp -> Command (Cursor, [a])+ ZScore :: Resp -> Command (Maybe Double)+ ZUnionStore :: Resp -> Command Int64++ -- HyperLogLog+ PfAdd :: Resp -> Command Bool+ PfCount :: Resp -> Command Int64+ PfMerge :: Resp -> Command ()++ -- Pub/Sub+ Publish :: Resp -> Command Int64++-- | Pub/Sub commands.+data PubSubCommand r where+ Subscribe :: Resp -> PubSubCommand ()+ Unsubscribe :: Resp -> PubSubCommand ()+ PSubscribe :: Resp -> PubSubCommand ()+ PUnsubscribe :: Resp -> PubSubCommand ()++-- | Messages which are published to subscribers.+data PushMessage+ = SubscribeMessage+ { channel :: !ByteString+ , subscriptions :: !Int64+ }+ | UnsubscribeMessage+ { channel :: !ByteString+ , subscriptions :: !Int64+ }+ | Message+ { channel :: !ByteString+ , message :: !ByteString+ }+ | PMessage+ { pattern :: !ByteString+ , channel :: !ByteString+ , message :: !ByteString+ }+ deriving (Eq, Ord, Show)++-- | The types redis reports via <http://redis.io/commands/type type>.+data RedisType+ = RedisString+ | RedisList+ | RedisSet+ | RedisZSet+ | RedisHash+ deriving (Eq, Ord, Show)++-- | A type representing time-to-live values.+data TTL = NoTTL | TTL !Int64+ deriving (Eq, Ord, Show)++-- | Used in 'linsert' to specify the insertion point.+data Side = Before | After+ deriving (Eq, Ord, Show)++data Choose+ = One -- ^ Exactly one element+ | Dist !Int64 -- ^ @n@ distint elements+ | Arb !Int64 -- ^ @n@ arbitrary (i.e. potentially repeated) elements+ deriving (Eq, Ord, Show)++data Aggregate+ = None -- ^ no aggregation+ | Min -- ^ take the minimum score+ | Max -- ^ take the maximum score+ | Sum -- ^ addition of scores+ deriving (Eq, Ord, Show)++data Min+ = MinIncl !ByteString -- ^ lower bound (inclusive)+ | MinExcl !ByteString -- ^ lower bound (exclusive)+ | MinInf -- ^ infinite lower bound+ deriving (Eq, Ord, Show)++data Max+ = MaxIncl !ByteString -- ^ upper bound (inclusive)+ | MaxExcl !ByteString -- ^ upper bound (exclusive)+ | MaxInf -- ^ infinite upper bound+ deriving (Eq, Ord, Show)++data ScoreList a = ScoreList+ { scores :: [Double]+ , elements :: [a]+ } deriving (Eq, Ord, Show)++newtype Cursor = Cursor+ { cursor :: ByteString+ } deriving (Eq, Ord, Show, FromByteString)++zero :: Cursor+zero = Cursor "0"++type Field = ByteString+type Index = Int64++-- | Redis key type+newtype Key = Key+ { key :: ByteString+ } deriving (Eq, Ord, Show, FromByteString)++instance IsString Key where+ fromString = Key . fromString++-- | Command options+data Opts (a :: Symbol) = Opts { len :: !Int, opts :: DList ByteString }++instance Monoid (Opts a) where+ mempty = Opts 0 DL.empty+ Opts x a `mappend` Opts y b = Opts (x + y) (a `DL.append` b)++none :: Monoid m => m+none = mempty++newtype Seconds = Seconds Int64+newtype Timestamp = Timestamp Int64+newtype BitStart = BitStart ByteString+newtype BitEnd = BitEnd ByteString++instance Monoid BitStart where+ mempty = BitStart ""+ _ `mappend` b = b++instance Monoid BitEnd where+ mempty = BitEnd ""+ _ `mappend` b = b++start :: Int64 -> BitStart+start = BitStart . int2bytes++end :: Int64 -> BitEnd+end = BitEnd . int2bytes++one :: a -> NonEmpty a+one a = a :| []++-----------------------------------------------------------------------------+-- Connection++ping :: Monad m => Redis m ()+ping = singleton $ Ping $ cmd 1 ["PING"]++echo :: (Monad m, ToByteString a, FromByteString a) => a -> Redis m a+echo x = singleton $ Echo $ cmd 2 ["ECHO", toByteString x]++auth :: Monad m => ByteString -> Redis m ()+auth x = singleton $ Auth $ cmd 2 ["AUTH", x]++quit :: Monad m => Redis m ()+quit = singleton $ Quit $ cmd 1 ["QUIT"]++select :: Monad m => Int64 -> Redis m ()+select x = singleton $ Select $ cmd 2 ["SELECT", int2bytes x]++-----------------------------------------------------------------------------+-- Server++bgrewriteaof :: Monad m => Redis m ()+bgrewriteaof = singleton $ BgRewriteAOF $ cmd 1 ["BGREWRITEAOF"]++bgsave :: Monad m => Redis m ()+bgsave = singleton $ BgSave $ cmd 1 ["BGSAVE"]++save :: Monad m => Redis m ()+save = singleton $ Save $ cmd 1 ["SAVE"]++flushall :: Monad m => Redis m ()+flushall = singleton $ FlushAll $ cmd 1 ["FLUSHALL"]++flushdb :: Monad m => Redis m ()+flushdb = singleton $ FlushDb $ cmd 1 ["FLUSHDB"]++lastsave :: Monad m => Redis m Int64+lastsave = singleton $ LastSave $ cmd 1 ["LASTSAVE"]++dbsize :: Monad m => Redis m Int64+dbsize = singleton $ DbSize $ cmd 1 ["DBSIZE"]++-----------------------------------------------------------------------------+-- Transactions++multi :: Monad m => Redis m ()+multi = singleton $ Multi $ cmd 1 ["MULTI"]++discard :: Monad m => Redis m ()+discard = singleton $ Discard $ cmd 1 ["DISCARD"]++unwatch :: Monad m => Redis m ()+unwatch = singleton $ Unwatch $ cmd 1 ["UNWATCH"]++watch :: Monad m => NonEmpty Key -> Redis m ()+watch kk = singleton $ Watch $ cmd (1 + NE.length kk) $ "WATCH" : map key (toList kk)++exec :: (Monad m, FromByteString a) => Redis m [a]+exec = singleton $ Exec $ cmd 1 ["EXEC"]++execRaw :: Monad m => Redis m Resp+execRaw = singleton $ ExecRaw $ cmd 1 ["EXEC"]++-----------------------------------------------------------------------------+-- Keys++dump :: Monad m => Key -> Redis m (Maybe ByteString)+dump k = singleton $ Dump $ cmd 2 ["DUMP", key k]++exists :: Monad m => Key -> Redis m Bool+exists k = singleton $ Exists $ cmd 2 ["EXISTS", key k]++del :: Monad m => NonEmpty Key -> Redis m Int64+del kk = singleton $ Del $ cmd (1 + NE.length kk) $ "DEL" : map key (toList kk)++expire :: Monad m => Key -> Seconds -> Redis m Bool+expire k (Seconds n) = singleton $ Expire $ cmd 3 ["EXPIRE", key k, int2bytes n]++expireat :: Monad m => Key -> Timestamp -> Redis m Bool+expireat k (Timestamp n) = singleton $ ExpireAt $ cmd 3 ["EXPIREAT", key k, int2bytes n]++persist :: Monad m => Key -> Redis m Bool+persist k = singleton $ Persist $ cmd 2 ["PERSIST", key k]++keys :: Monad m => ByteString -> Redis m [Key]+keys pat = singleton $ Keys $ cmd 2 ["KEYS", pat]++randomkey :: Monad m => Redis m (Maybe Key)+randomkey = singleton $ RandomKey $ cmd 1 ["RANDOMKEY"]++rename :: Monad m => Key -> Key -> Redis m ()+rename a b = singleton $ Rename $ cmd 3 ["RENAME", key a, key b]++renamenx :: Monad m => Key -> Key -> Redis m Bool+renamenx a b = singleton $ RenameNx $ cmd 3 ["RENAMENX", key a, key b]++ttl :: Monad m => Key -> Redis m (Maybe TTL)+ttl k = singleton $ Ttl $ cmd 2 ["TTL", key k]++typeof :: Monad m => Key -> Redis m (Maybe RedisType)+typeof k = singleton $ Type $ cmd 2 ["TYPE", key k]++-----------------------------------------------------------------------------+-- Strings++get :: (Monad m, FromByteString a) => Key -> Redis m (Maybe a)+get k = singleton $ Get $ cmd 2 ["GET", key k]++set :: (Monad m, ToByteString a) => Key -> a -> Opts "SET" -> Redis m Bool+set k v o = singleton $ Set $ cmd (3 + len o) $ "SET" : key k : toByteString v : toList (opts o)++ex :: Int64 -> Opts "SET"+ex i = Opts 2 $ "EX" `cons` DL.singleton (int2bytes i)++px :: Int64 -> Opts "SET"+px i = Opts 2 $ "PX" `cons` DL.singleton (int2bytes i)++xx :: Opts "SET"+xx = Opts 1 $ DL.singleton "XX"++nx :: Opts "SET"+nx = Opts 1 $ DL.singleton "NX"++getset :: (Monad m, ToByteString a, FromByteString b) => Key -> a -> Redis m (Maybe b)+getset k v = singleton $ GetSet $ cmd 3 ["GETSET", key k, toByteString v]++mget :: (Monad m, FromByteString a) => NonEmpty Key -> Redis m [Maybe a]+mget kk = singleton $ MGet $ cmd (1 + NE.length kk) $ "MGET" : map key (toList kk)++mset :: (Monad m, ToByteString a) => NonEmpty (Key, a) -> Redis m ()+mset kv = singleton $ MSet $ cmd (1 + 2 * NE.length kv) $ "MSET" : foldr f [] kv+ where+ f (k, v) acc = key k : toByteString v : acc++msetnx :: (Monad m, ToByteString a) => NonEmpty (Key, a) -> Redis m Bool+msetnx kv = singleton $ MSetNx $ cmd (1 + 2 * NE.length kv) $ "MSETNX" : foldr f [] kv+ where+ f (k, v) acc = key k : toByteString v : acc++getrange :: (Monad m, FromByteString a) => Key -> Int64 -> Int64 -> Redis m a+getrange k a b = singleton $ GetRange $ cmd 4 ["GETRANGE", key k, int2bytes a, int2bytes b]++setrange :: (Monad m, ToByteString a) => Key -> Int64 -> a -> Redis m Int64+setrange k i a = singleton $ SetRange $ cmd 4 ["SETRANGE", key k, int2bytes i, toByteString a]++append :: (Monad m, ToByteString a) => Key -> a -> Redis m Int64+append k v = singleton $ Append $ cmd 3 ["APPEND", key k, toByteString v]++strlen :: Monad m => Key -> Redis m Int64+strlen k = singleton $ StrLen $ cmd 2 ["STRLEN", key k]++decr :: Monad m => Key -> Redis m Int64+decr k = singleton $ Decr $ cmd 2 ["DECR", key k]++decrby :: Monad m => Key -> Int64 -> Redis m Int64+decrby k v = singleton $ DecrBy $ cmd 3 ["DECRBY", key k, int2bytes v]++incr :: Monad m => Key -> Redis m Int64+incr k = singleton $ Incr $ cmd 2 ["INCR", key k]++incrby :: Monad m => Key -> Int64 -> Redis m Int64+incrby k v = singleton $ IncrBy $ cmd 3 ["INCRBY", key k, int2bytes v]++incrbyfloat :: Monad m => Key -> Double -> Redis m Double+incrbyfloat k v = singleton $ IncrByFloat $ cmd 3 ["INCRBYFLOAT", key k, dbl2bytes v]++-----------------------------------------------------------------------------+-- Bits++bitcount :: Monad m => Key -> Opts "RANGE" -> Redis m Int64+bitcount k o = singleton $ BitCount $ cmd (2 + len o) $ "BITCOUNT" : key k : toList (opts o)++range :: Int64 -> Int64 -> Opts "RANGE"+range x y = Opts 2 $ int2bytes x `cons` DL.singleton (int2bytes y)++bitand :: Monad m => Key -> NonEmpty Key -> Redis m Int64+bitand k kk = singleton $ BitAnd $ bitop "AND" (k <| kk)++bitor :: Monad m => Key -> NonEmpty Key -> Redis m Int64+bitor k kk = singleton $ BitOr $ bitop "OR" (k <| kk)++bitxor :: Monad m => Key -> NonEmpty Key -> Redis m Int64+bitxor k kk = singleton $ BitXOr $ bitop "XOR" (k <| kk)++bitnot :: Monad m => Key -> Key -> Redis m Int64+bitnot k l = singleton $ BitNot $ bitop "NOT" (k :| [l])++bitop :: ByteString -> NonEmpty Key -> Resp+bitop o kk = cmd (2 + NE.length kk) $ "BITOP" : o : map key (toList kk)+{-# INLINE bitop #-}++bitpos :: Monad m => Key -> Bool -> BitStart -> BitEnd -> Redis m Int64+bitpos k b (BitStart s) (BitEnd e) =+ let args = filter (not . Lazy.null) [s, e] in+ singleton $ BitPos $ cmd (3 + length args) $ "BITPOS" : key k : toBit b : args+ where+ toBit True = "1"+ toBit False = "0"++getbit :: Monad m => Key -> Int64 -> Redis m Int64+getbit k o = singleton $ GetBit $ cmd 3 ["GETBIT", key k, int2bytes o]++setbit :: Monad m => Key -> Int64 -> Bool -> Redis m Int64+setbit k o b = singleton $ SetBit $ cmd 4 ["SETBIT", key k, int2bytes o, toBit b]+ where+ toBit True = "1"+ toBit False = "0"++-----------------------------------------------------------------------------+-- Hashes++hget :: (Monad m, FromByteString a) => Key -> Field -> Redis m (Maybe a)+hget h k = singleton $ HGet $ cmd 3 ["HGET", key h, k]++hgetall :: (Monad m, FromByteString a) => Key -> Redis m [(Field, a)]+hgetall h = singleton $ HGetAll $ cmd 2 ["HGETALL", key h]++hvals :: (Monad m, FromByteString a) => Key -> Redis m [a]+hvals h = singleton $ HVals $ cmd 2 ["HVALS", key h]++hmget :: (Monad m, FromByteString a) => Key -> NonEmpty Field -> Redis m [Maybe a]+hmget h kk = singleton $ HMGet $ cmd (2 + NE.length kk) $ "HMGET" : key h : toList kk++hmset :: (Monad m, ToByteString a) => Key -> NonEmpty (Field, a) -> Redis m ()+hmset h kv = singleton $ HMSet $ cmd (2 + 2 * NE.length kv) $ "HMSET" : key h : foldr f [] kv+ where+ f (k, v) acc = k : toByteString v : acc++hset :: (Monad m, ToByteString a) => Key -> Field -> a -> Redis m Bool+hset h k v = singleton $ HSet $ cmd 4 ["HSET", key h, k, toByteString v]++hsetnx :: (Monad m, ToByteString a) => Key -> Field -> a -> Redis m Bool+hsetnx h k v = singleton $ HSetNx $ cmd 4 ["HSETNX", key h, k, toByteString v]++hincrby :: Monad m => Key -> Field -> Int64 -> Redis m Int64+hincrby h k v = singleton $ HIncrBy $ cmd 4 ["HINCRBY", key h, k, int2bytes v]++hincrbyfloat :: Monad m => Key -> Field -> Double -> Redis m Double+hincrbyfloat h k v = singleton $ HIncrByFloat $ cmd 4 ["HINCRBYFLOAT", key h, k, dbl2bytes v]++hdel :: Monad m => Key -> NonEmpty Field -> Redis m Int64+hdel h kk = singleton $ HDel $ cmd (2 + NE.length kk) $ "HDEL" : key h : toList kk++hexists :: Monad m => Key -> Field -> Redis m Bool+hexists h k = singleton $ HExists $ cmd 3 ["HEXISTS", key h, k]++hkeys :: Monad m => Key -> Redis m [Field]+hkeys h = singleton $ HKeys $ cmd 2 ["HKEYS", key h]++hlen :: Monad m => Key -> Redis m Int64+hlen h = singleton $ HLen $ cmd 2 ["HLEN", key h]++-----------------------------------------------------------------------------+-- Lists++lindex :: (Monad m, FromByteString a) => Key -> Index -> Redis m (Maybe a)+lindex k i = singleton $ LIndex $ cmd 3 ["LINDEX", key k, int2bytes i]++lpop :: (Monad m, FromByteString a) => Key -> Redis m (Maybe a)+lpop k = singleton $ LPop $ cmd 2 ["LPOP", key k]++rpop :: (Monad m, FromByteString a) => Key -> Redis m (Maybe a)+rpop k = singleton $ RPop $ cmd 2 ["RPOP", key k]++rpoplpush :: (Monad m, FromByteString a) => Key -> Key -> Redis m (Maybe a)+rpoplpush a b = singleton $ RPopLPush $ cmd 3 ["RPOPLPUSH", key a, key b]++brpoplpush :: (Monad m, FromByteString a) => Key -> Key -> Seconds -> Redis m (Maybe a)+brpoplpush a b (Seconds t) = singleton $ BRPopLPush t $ cmd 4 ["BRPOPLPUSH", key a, key b, int2bytes t]++blpop :: (Monad m, FromByteString a) => NonEmpty Key -> Seconds -> Redis m (Maybe (Key, a))+blpop kk (Seconds t) = singleton $ BLPop t $ cmd (2 + NE.length kk) $+ "BLPOP" : map key (toList kk) ++ [int2bytes t]++brpop :: (Monad m, FromByteString a) => NonEmpty Key -> Seconds -> Redis m (Maybe (Key, a))+brpop kk (Seconds t) = singleton $ BRPop t $ cmd (2 + NE.length kk) $+ "BRPOP" : map key (toList kk) ++ [int2bytes t]++lrange :: (Monad m, FromByteString a) => Key -> Int64 -> Int64 -> Redis m [a]+lrange k a b = singleton $ LRange $ cmd 4 ["LRANGE", key k, int2bytes a, int2bytes b]++linsert :: (Monad m, ToByteString a) => Key -> Side -> a -> a -> Redis m Int64+linsert k s p v = singleton $ LInsert $ cmd 5 ["LINSERT", key k, side2bytes s, toByteString p, toByteString v]++lpush :: (Monad m, ToByteString a) => Key -> NonEmpty a -> Redis m Int64+lpush k vv = singleton $ LPush $ cmd (2 + NE.length vv) $ "LPUSH" : key k : map toByteString (toList vv)++rpush :: (Monad m, ToByteString a) => Key -> NonEmpty a -> Redis m Int64+rpush k vv = singleton $ RPush $ cmd (2 + NE.length vv) $ "RPUSH" : key k : map toByteString (toList vv)++lset :: (Monad m, ToByteString a) => Key -> Int64 -> a -> Redis m ()+lset k i v = singleton $ LSet $ cmd 4 ["LSET", key k, int2bytes i, toByteString v]++ltrim :: Monad m => Key -> Int64 -> Int64 -> Redis m ()+ltrim k i j = singleton $ LTrim $ cmd 4 ["LTRIM", key k, int2bytes i, int2bytes j]++lrem :: (Monad m, ToByteString a) => Key -> Int64 -> a -> Redis m Int64+lrem k c v = singleton $ LRem $ cmd 4 ["LREM", key k, int2bytes c, toByteString v]++lpushx :: (Monad m, ToByteString a) => Key -> a -> Redis m Int64+lpushx k v = singleton $ LPushX $ cmd 3 ["LPUSHX", key k, toByteString v]++rpushx :: (Monad m, ToByteString a) => Key -> a -> Redis m Int64+rpushx k v = singleton $ RPushX $ cmd 3 ["RPUSHX", key k, toByteString v]++llen :: Monad m => Key -> Redis m Int64+llen k = singleton $ LLen $ cmd 2 ["LLEN", key k]++-----------------------------------------------------------------------------+-- Sets++spop :: (Monad m, FromByteString a) => Key -> Redis m (Maybe a)+spop k = singleton $ SPop $ cmd 2 ["SPOP", key k]++sismember :: (Monad m, ToByteString a) => Key -> a -> Redis m Bool+sismember k v = singleton $ SIsMember $ cmd 3 ["SISMEMBER", key k, toByteString v]++smove :: (Monad m, ToByteString a) => Key -> Key -> a -> Redis m Bool+smove a b v = singleton $ SMove $ cmd 4 ["SMOVE", key a, key b, toByteString v]++sdiff :: (Monad m, FromByteString a) => NonEmpty Key -> Redis m [a]+sdiff kk = singleton $ SDiff $ cmd (1 + NE.length kk) $ "SDIFF" : map key (toList kk)++sinter :: (Monad m, FromByteString a) => NonEmpty Key -> Redis m [a]+sinter kk = singleton $ SInter $ cmd (1 + NE.length kk) $ "SINTER" : map key (toList kk)++smembers :: (Monad m, FromByteString a) => Key -> Redis m [a]+smembers k = singleton $ SMembers $ cmd 2 ["SMEMBERS", key k]++srandmember :: (Monad m, FromByteString a) => Key -> Choose -> Redis m [a]+srandmember k One = singleton $ SRandMember One $ cmd 2 ["SRANDMEMBER", key k]+srandmember k chs = singleton $ SRandMember chs $ cmd 3 ["SRANDMEMBER", key k, choose chs]+ where+ choose (Dist n) = int2bytes n+ choose (Arb n) = int2bytes n+ choose One = "1"++sdiffstore :: Monad m => Key -> NonEmpty Key -> Redis m Int64+sdiffstore k kk = singleton $ SDiffStore $ cmd (2 + NE.length kk) $+ "SDIFFSTORE" : key k : map key (toList kk)++sinterstore :: Monad m => Key -> NonEmpty Key -> Redis m Int64+sinterstore k kk = singleton $ SInterStore $ cmd (2 + NE.length kk) $+ "SINTERSTORE" : key k : map key (toList kk)++sunionstore :: Monad m => Key -> NonEmpty Key -> Redis m Int64+sunionstore k kk = singleton $ SUnionStore $ cmd (2 + NE.length kk) $+ "SUNIONSTORE" : key k : map key (toList kk)++sadd :: (Monad m, ToByteString a) => Key -> NonEmpty a -> Redis m Int64+sadd k v = singleton $ SAdd $ cmd (2 + NE.length v) $ "SADD" : key k : map toByteString (toList v)++srem :: (Monad m, ToByteString a) => Key -> NonEmpty a -> Redis m Int64+srem k vv = singleton $ SRem $ cmd (2 + NE.length vv) $ "SREM" : key k : map toByteString (toList vv)++sunion :: (Monad m, FromByteString a) => NonEmpty Key -> Redis m [a]+sunion kk = singleton $ SUnion $ cmd (1 + NE.length kk) $ "SUNION" : map key (toList kk)++scard :: Monad m => Key -> Redis m Int64+scard k = singleton $ SCard $ cmd 2 ["SCARD", key k]++-----------------------------------------------------------------------------+-- Sorted Sets++zrange :: (Monad m, FromByteString a) => Key -> Int64 -> Int64 -> Bool -> Redis m (ScoreList a)+zrange k a b s =+ let args = ["ZRANGE", key k, int2bytes a, int2bytes b, "WITHSCORES"]+ in if s then singleton $ ZRange s $ cmd 5 args+ else singleton $ ZRange s $ cmd 4 (init args)++zrevrange :: (Monad m, FromByteString a) => Key -> Int64 -> Int64 -> Bool -> Redis m (ScoreList a)+zrevrange k a b s =+ let args = ["ZREVRANGE", key k, int2bytes a, int2bytes b, "WITHSCORES"]+ in if s then singleton $ ZRevRange s $ cmd 5 args+ else singleton $ ZRevRange s $ cmd 4 (init args)++zrangebyscore :: (Monad m, FromByteString a) => Key -> Double -> Double -> Bool -> Opts "LIMIT" -> Redis m (ScoreList a)+zrangebyscore k a b s o =+ let args = ["ZRANGEBYSCORE", key k, dbl2bytes a, dbl2bytes b, "WITHSCORES"] in+ if s then singleton $ ZRangeByScore s $ cmd (5 + len o) $ args ++ toList (opts o)+ else singleton $ ZRangeByScore s $ cmd (4 + len o) $ init args ++ toList (opts o)++zrevrangebyscore :: (Monad m, FromByteString a) => Key -> Double -> Double -> Bool -> Opts "LIMIT" -> Redis m (ScoreList a)+zrevrangebyscore k a b s o =+ let args = ["ZREVRANGEBYSCORE", key k, dbl2bytes a, dbl2bytes b, "WITHSCORES"] in+ if s then singleton $ ZRevRangeByScore s $ cmd (5 + len o) $ args ++ toList (opts o)+ else singleton $ ZRevRangeByScore s $ cmd (4 + len o) $ init args ++ toList (opts o)++zadd :: (Monad m, ToByteString a) => Key -> NonEmpty (Double, a) -> Redis m Int64+zadd k v = singleton $ ZAdd $ cmd (2 + 2 * NE.length v) $ "ZADD" : key k : foldr f [] v+ where+ f (i, x) acc = dbl2bytes i : toByteString x : acc++zinterstore :: Monad m => Key -> NonEmpty Key -> [Int64] -> Aggregate -> Redis m Int64+zinterstore = _interstore ZInterStore "ZINTERSTORE"++zunionstore :: Monad m => Key -> NonEmpty Key -> [Int64] -> Aggregate -> Redis m Int64+zunionstore = _interstore ZUnionStore "ZUNIONSTORE"++_interstore :: (Resp -> Command Int64)+ -> ByteString+ -> Key+ -> NonEmpty Key+ -> [Int64]+ -> Aggregate+ -> Redis m Int64+_interstore c n k kk ww a =+ let ww' = map int2bytes ww ++ repeat "1"+ aggr = aggr2bytes a+ nkeys = NE.length kk+ ntotal = 3 + 2 * nkeys + 1 + length aggr+ keys' = map key (toList kk)+ weights = "WEIGHTS" : take nkeys ww'+ in singleton $ c $ cmd ntotal $ toList $ n+ `cons` key k+ `cons` int2bytes (fromIntegral nkeys)+ `cons` DL.fromList keys'+ <> DL.fromList weights+ <> DL.fromList aggr+ where+ aggr2bytes :: Aggregate -> [ByteString]+ aggr2bytes None = []+ aggr2bytes Min = ["AGGREGATE", "MIN"]+ aggr2bytes Max = ["AGGREGATE", "MAX"]+ aggr2bytes Sum = ["AGGREGATE", "SUM"]+{-# INLINE _interstore #-}++zlexcount :: Monad m => Key -> Min -> Max -> Redis m Int64+zlexcount k a b = singleton $ ZLexCount $ cmd 4 ["ZLEXCOUNT", key k, min2bytes a, max2bytes b]++min2bytes :: Min -> ByteString+min2bytes MinInf = "-"+min2bytes (MinIncl x) = "[" <> x+min2bytes (MinExcl x) = "(" <> x++max2bytes :: Max -> ByteString+max2bytes MaxInf = "+"+max2bytes (MaxIncl x) = "[" <> x+max2bytes (MaxExcl x) = "(" <> x++zrangebylex :: (Monad m, FromByteString a) => Key -> Min -> Max -> Opts "LIMIT" -> Redis m [a]+zrangebylex k a b o = singleton $ ZRangeByLex $ cmd (4 + len o) $+ "ZRANGEBYLEX" : key k : min2bytes a : max2bytes b : toList (opts o)++zremrangebylex :: Monad m => Key -> Min -> Max -> Redis m Int64+zremrangebylex k a b = singleton $ ZRemRangeByLex $ cmd 4+ ["ZREMRANGEBYLEX", key k, min2bytes a, max2bytes b]++zremrangebyrank :: Monad m => Key -> Int64 -> Int64 -> Redis m Int64+zremrangebyrank k a b = singleton $ ZRemRangeByRank $ cmd 4+ ["ZREMRANGEBYRANK", key k, int2bytes a, int2bytes b]++zremrangebyscore :: Monad m => Key -> Double -> Double -> Redis m Int64+zremrangebyscore k a b = singleton $ ZRemRangeByScore $ cmd 4+ ["ZREMRANGEBYSCORE", key k, dbl2bytes a, dbl2bytes b]++zrem :: (Monad m, ToByteString a) => Key -> NonEmpty a -> Redis m Int64+zrem k vv = singleton $ ZRem $ cmd (2 + NE.length vv) $ "ZREM" : key k : map toByteString (toList vv)++zincrby :: (Monad m, ToByteString a) => Key -> Double -> a -> Redis m Double+zincrby k i v = singleton $ ZIncrBy $ cmd 4 ["ZINCRBY", key k, dbl2bytes i, toByteString v]++zscore :: (Monad m, ToByteString a) => Key -> a -> Redis m (Maybe Double)+zscore k v = singleton $ ZScore $ cmd 3 ["ZSCORE", key k, toByteString v]++zcard :: Monad m => Key -> Redis m Int64+zcard k = singleton $ ZCard $ cmd 2 ["ZCARD", key k]++zcount :: Monad m => Key -> Double -> Double -> Redis m Int64+zcount k a b = singleton $ ZCount $ cmd 4 ["ZCOUNT", key k, dbl2bytes a, dbl2bytes b]++zrank :: (Monad m, ToByteString a) => Key -> a -> Redis m (Maybe Int64)+zrank k a = singleton $ ZRank $ cmd 3 ["ZRANK", key k, toByteString a]++zrevrank :: (Monad m, ToByteString a) => Key -> a -> Redis m (Maybe Int64)+zrevrank k a = singleton $ ZRevRank $ cmd 3 ["ZREVRANK", key k, toByteString a]++-----------------------------------------------------------------------------+-- HyperLogLog++pfadd :: (Monad m, ToByteString a) => Key -> NonEmpty a -> Redis m Bool+pfadd k v = singleton $ PfAdd $ cmd (2 + NE.length v) $ "PFADD" : key k : map toByteString (toList v)++pfcount :: Monad m => NonEmpty Key -> Redis m Int64+pfcount kk = singleton $ PfCount $ cmd (1 + NE.length kk) $ "PFCOUNT" : map key (toList kk)++pfmerge :: Monad m => Key -> NonEmpty Key -> Redis m ()+pfmerge k kk = singleton $ PfMerge $ cmd (2 + NE.length kk) $ "PFMERGE" : key k : map key (toList kk)++-----------------------------------------------------------------------------+-- Scan++scan :: (Monad m, FromByteString a) => Cursor -> Opts "SCAN" -> Redis m (Cursor, [a])+scan c o = singleton $ Scan $ cmd (2 + len o) $ "SCAN" : cursor c : toList (opts o)++hscan :: (Monad m, FromByteString a) => Key -> Cursor -> Opts "SCAN" -> Redis m (Cursor, [a])+hscan h c o = singleton $ HScan $ cmd (3 + len o) $ "HSCAN" : key h : cursor c : toList (opts o)++sscan :: (Monad m, FromByteString a) => Key -> Cursor -> Opts "SCAN" -> Redis m (Cursor, [a])+sscan h c o = singleton $ SScan $ cmd (3 + len o) $ "SSCAN" : key h : cursor c : toList (opts o)++zscan :: (Monad m, FromByteString a) => Key -> Cursor -> Opts "SCAN" -> Redis m (Cursor, [a])+zscan h c o = singleton $ ZScan $ cmd (3 + len o) $ "ZSCAN" : key h : cursor c : toList (opts o)++match :: ByteString -> Opts "SCAN"+match pat = Opts 2 $ "MATCH" `cons` DL.singleton pat++count :: Int64 -> Opts "SCAN"+count n = Opts 2 $ "COUNT" `cons` DL.singleton (int2bytes n)++-----------------------------------------------------------------------------+-- Sort++sort :: (Monad m, FromByteString a) => Key -> Opts "SORT" -> Redis m [a]+sort k o = singleton $ Sort $ cmd (2 + len o) $ "SORT" : key k : toList (opts o)++by :: ByteString -> Opts "SORT"+by pat = Opts 2 $ "BY" `cons` DL.singleton pat++limit :: Int64 -> Int64 -> Opts o+limit off cnt = Opts 3 $ DL.fromList ["LIMIT", int2bytes off, int2bytes cnt]++getkey :: NonEmpty ByteString -> Opts "SORT"+getkey pats = foldr f none (toList pats)+ where+ f p acc = Opts 2 ("GET" `cons` DL.singleton p) <> acc++asc :: Opts "SORT"+asc = Opts 1 $ DL.singleton "ASC"++desc :: Opts "SORT"+desc = Opts 1 $ DL.singleton "DESC"++alpha :: Opts "SORT"+alpha = Opts 1 $ DL.singleton "ALPHA"++store :: Key -> Opts "SORT"+store k = Opts 2 $ "STORE" `cons` DL.singleton (key k)++-----------------------------------------------------------------------------+-- Pub/Sub++publish :: (Monad m, ToByteString a) => ByteString -> a -> Redis m Int64+publish c m = singleton $ Publish $ cmd 3 $ ["PUBLISH", c, toByteString m]++subscribe :: Monad m => NonEmpty ByteString -> PubSub m ()+subscribe cs = singleton $ Subscribe $ cmd (1 + NE.length cs) $ "SUBSCRIBE" : toList cs++psubscribe :: Monad m => NonEmpty ByteString -> PubSub m ()+psubscribe cs = singleton $ PSubscribe $ cmd (1 + NE.length cs) $ "PSUBSCRIBE" : toList cs++unsubscribe :: Monad m => [ByteString] -> PubSub m ()+unsubscribe cs = singleton $ Unsubscribe $ cmd (1 + length cs) $ "UNSUBSCRIBE" : toList cs++punsubscribe :: Monad m => [ByteString] -> PubSub m ()+punsubscribe cs = singleton $ PUnsubscribe $ cmd (1 + length cs) $ "PUNSUBSCRIBE" : toList cs++-----------------------------------------------------------------------------+-- Responses++readInt'Null :: String -> Resp -> Result (Maybe Int64)+readInt'Null _ (Int i) = Right $ Just i+readInt'Null _ NullBulk = Right Nothing+readInt'Null s _ = Left $ InvalidResponse s++readInt :: String -> Resp -> Result Int64+readInt _ (Int i) = Right i+readInt s _ = Left $ InvalidResponse s++readTTL :: String -> Resp -> Result (Maybe TTL)+readTTL s r = toTTL <$> readInt s r+ where+ toTTL (-2) = Nothing+ toTTL (-1) = Just NoTTL+ toTTL n = Just $ TTL n++readBool :: String -> Resp -> Result Bool+readBool s r = readInt s r >>= toBool+ where+ toBool 0 = Right False+ toBool 1 = Right True+ toBool _ = Left $ InvalidResponse s++readListOfMaybes :: FromByteString a => String -> Resp -> Result [Maybe a]+readListOfMaybes n (Array _ r) = foldr f (Right []) r+ where+ f _ x@(Left _) = x+ f NullBulk (Right acc) = Right $ Nothing : acc+ f (Bulk s) (Right acc) = (:acc) . Just <$> readStr s+ f (Str s) (Right acc) = (:acc) . Just <$> readStr s+ f _ _ = Left $ InvalidResponse n+readListOfMaybes n _ = Left $ InvalidResponse n++readList :: FromByteString a => String -> Resp -> Result [a]+readList r (Array _ v) = foldr f (Right []) v+ where+ f _ x@(Left _) = x+ f (Bulk s) (Right acc) = (:acc) <$> readStr s+ f (Str s) (Right acc) = (:acc) <$> readStr s+ f _ _ = Left $ InvalidResponse r+readList r _ = Left $ InvalidResponse r++readScoreList :: FromByteString a => String -> Bool -> Resp -> Result (ScoreList a)+readScoreList r False a = ScoreList [] <$> readList r a+readScoreList r True (Array _ v) = toScoreList . unzip <$> foldr f (Right []) (chunksOf 2 v)+ where+ f _ x@(Left _) = x+ f [Bulk x, Bulk d] (Right acc) = (\a b -> (a, b):acc) <$> readStr x <*> readStr d+ f _ _ = Left $ InvalidResponse r+ toScoreList (a, s) = ScoreList s a+readScoreList r _ _ = Left $ InvalidResponse r++readFields :: FromByteString a => String -> Resp -> Result [(Field, a)]+readFields r (Array _ v) = foldr f (Right []) (chunksOf 2 v)+ where+ f _ x@(Left _) = x+ f [Bulk k, Bulk x] (Right acc) = (:acc) . (k,) <$> readStr x+ f _ _ = Left $ InvalidResponse r+readFields r _ = Left $ InvalidResponse r++readKeyValue :: FromByteString a => String -> Resp -> Result (Maybe (Key, a))+readKeyValue _ NullArray = return Nothing+readKeyValue _ (Array _ [Bulk k, Bulk v]) = Just . (Key k,) <$> readStr v+readKeyValue r _ = Left $ InvalidResponse r++readBulk'Null :: FromByteString a => String -> Resp -> Result (Maybe a)+readBulk'Null _ NullBulk = Right Nothing+readBulk'Null _ (Bulk s) = Just <$> readStr s+readBulk'Null n _ = Left $ InvalidResponse n++readBulk :: FromByteString a => String -> Resp -> Result a+readBulk _ (Bulk s) = readStr s+readBulk n _ = Left $ InvalidResponse n++readBulk'Array :: FromByteString a => String -> Choose -> Resp -> Result [a]+readBulk'Array n One r = maybeToList <$> readBulk'Null n r+readBulk'Array n _ r = readList n r++readScan :: FromByteString a => String -> Resp -> Result (Cursor, [a])+readScan n (Array 2 (Bulk c:v:[])) = (Cursor c,) <$> readList n v+readScan n _ = Left $ InvalidResponse n++matchStr :: String -> ByteString -> Resp -> Result ()+matchStr n x (Str s)+ | x == s = Right ()+ | otherwise = Left $ InvalidResponse n+matchStr n _ _ = Left $ InvalidResponse n++anyStr :: String -> Resp -> Result ()+anyStr _ (Str _) = Right ()+anyStr n _ = Left $ InvalidResponse n++readType :: String -> Resp -> Result (Maybe RedisType)+readType _ (Str s) = case s of+ "string" -> return $ Just RedisString+ "hash" -> return $ Just RedisHash+ "list" -> return $ Just RedisList+ "set" -> return $ Just RedisSet+ "zset" -> return $ Just RedisZSet+ "none" -> return Nothing+ _ -> Left $ InvalidConversion ("unknown redis type: " ++ show s)+readType n _ = Left $ InvalidResponse n++fromSet :: Resp -> Result Bool+fromSet (Str "OK") = Right True+fromSet NullBulk = Right False+fromSet _ = Left $ InvalidResponse "SET"++readPushMessage :: Resp -> Result PushMessage+readPushMessage (Array 3 (Bulk "message":Bulk c:Bulk m:[])) =+ Right $ Message c m+readPushMessage (Array 4 (Bulk "pmessage":Bulk p:Bulk c:Bulk m:[])) =+ Right $ PMessage p c m+readPushMessage (Array 3 (Bulk "subscribe":Bulk c:Int n:[])) =+ Right $ SubscribeMessage c n+readPushMessage (Array 3 (Bulk "unsubscribe":Bulk c:Int n:[])) =+ Right $ UnsubscribeMessage c n+readPushMessage (Array 3 (Bulk "psubscribe":Bulk c:Int n:[])) =+ Right $ SubscribeMessage c n+readPushMessage (Array 3 (Bulk "punsubscribe":Bulk c:Int n:[])) =+ Right $ UnsubscribeMessage c n+readPushMessage _ = Left $ InvalidResponse "pub/sub"++-----------------------------------------------------------------------------+-- Helpers++cmd :: Int -> [ByteString] -> Resp+cmd n a = Array n (map Bulk a)+{-# INLINE cmd #-}++int2bytes :: Int64 -> ByteString+int2bytes = toLazyByteStringWith (safeStrategy 20 8) mempty . int64Dec+{-# INLINE int2bytes #-}++dbl2bytes :: Double -> ByteString+dbl2bytes = fromStrict . toShortest+{-# INLINE dbl2bytes #-}++side2bytes :: Side -> ByteString+side2bytes Before = "BEFORE"+side2bytes After = "AFTER"+{-# INLINE side2bytes #-}++readStr :: FromByteString a => ByteString -> Result a+readStr s = either (Left . InvalidConversion) Right $ runParser' parser s+{-# INLINE readStr #-}
+ src/Data/Redis/Resp.hs view
@@ -0,0 +1,95 @@+-- This Source Code Form is subject to the terms of the Mozilla Public+-- License, v. 2.0. If a copy of the MPL was not distributed with this+-- file, You can obtain one at http://mozilla.org/MPL/2.0/.++{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE OverloadedStrings #-}++module Data.Redis.Resp where++import Control.Applicative+import Control.Monad (replicateM)+import Data.Attoparsec.ByteString.Char8 hiding (char8)+import Data.ByteString.Lazy (ByteString)+import Data.ByteString.Builder+import Data.Int+import Data.Monoid+import Prelude hiding (take, takeWhile)++import qualified Data.Attoparsec.ByteString.Lazy as P+import qualified Data.ByteString.Lazy as Lazy++-- | 'Resp' defines the various RESP constructors.+data Resp+ = Str !ByteString -- ^ RESP simple atrings+ | Err !ByteString -- ^ RESP errors+ | Int !Int64 -- ^ RESP integers+ | Bulk !ByteString -- ^ RESP bulk strings+ | Array !Int [Resp] -- ^ RESP arrays+ | NullArray+ | NullBulk+ deriving (Eq, Ord, Show)++decode :: ByteString -> Either String Resp+decode = P.eitherResult . P.parse resp++encode :: Resp -> Lazy.ByteString+encode d = toLazyByteString (go d)+ where+ go (Str x) = char8 '+' <> lazyByteString x <> crlf'+ go (Err x) = char8 '-' <> lazyByteString x <> crlf'+ go (Int x) = char8 ':' <> int64Dec x <> crlf'+ go (Bulk x) = char8 '$'+ <> int64Dec (Lazy.length x)+ <> crlf'+ <> lazyByteString x+ <> crlf'+ go (Array n x) = char8 '*'+ <> intDec n+ <> crlf'+ <> foldr (<>) mempty (map go x)+ go NullArray = nullArray+ go NullBulk = nullBulk++-----------------------------------------------------------------------------+-- Parsing++-- | An attoparsec parser to parse a single 'Resp' value.+resp :: Parser Resp+resp = do+ t <- anyChar+ case t of+ '+' -> Str `fmap` bytes <* crlf+ '-' -> Err `fmap` bytes <* crlf+ ':' -> Int <$> signed decimal <* crlf+ '$' -> bulk+ '*' -> array+ _ -> fail $ "invalid type tag: " ++ show t++bulk :: Parser Resp+bulk = do+ n <- signed decimal <* crlf+ if | n >= 0 -> Bulk . Lazy.fromStrict <$> take n <* crlf+ | n == -1 -> return NullBulk+ | otherwise -> fail "negative bulk length"++array :: Parser Resp+array = do+ n <- signed decimal <* crlf :: Parser Int+ if | n >= 0 -> Array n <$> replicateM n resp+ | n == -1 -> return NullArray+ | otherwise -> fail "negative array length"++bytes :: Parser ByteString+bytes = Lazy.fromStrict <$> takeWhile (/= '\r')++crlf :: Parser ()+crlf = string "\r\n" >> return ()++-----------------------------------------------------------------------------+-- Serialising++nullArray, nullBulk, crlf' :: Builder+nullArray = byteString "*-1\r\n"+nullBulk = byteString "$-1\r\n"+crlf' = byteString "\r\n"