    {-# LANGUAGE OverloadedStrings, RecordWildCards, FlexibleContexts #-}

    module Database.Redis.ManualCommands where

    import Prelude hiding (min,max)
    import Data.ByteString (ByteString)
    import Database.Redis.Core
    import Database.Redis.Protocol
    import Database.Redis.Types

    objectRefcount
        :: (RedisCtx m f)
        => ByteString -- ^ key
        -> m (f Integer)
    objectRefcount key = sendRequest ["OBJECT", "refcount", encode key]

    objectIdletime
        :: (RedisCtx m f)
        => ByteString -- ^ key
        -> m (f Integer)
    objectIdletime key = sendRequest ["OBJECT", "idletime", encode key]

    objectEncoding
        :: (RedisCtx m f)
        => ByteString -- ^ key
        -> m (f ByteString)
    objectEncoding key = sendRequest ["OBJECT", "encoding", encode key]

    linsertBefore
        :: (RedisCtx m f)
        => ByteString -- ^ key
        -> ByteString -- ^ pivot
        -> ByteString -- ^ value
        -> m (f Integer)
    linsertBefore key pivot value =
        sendRequest ["LINSERT", encode key, "BEFORE", encode pivot, encode value]

    linsertAfter
        :: (RedisCtx m f)
        => ByteString -- ^ key
        -> ByteString -- ^ pivot
        -> ByteString -- ^ value
        -> m (f Integer)
    linsertAfter key pivot value =
            sendRequest ["LINSERT", encode key, "AFTER", encode pivot, encode value]

    getType
        :: (RedisCtx m f)
        => ByteString -- ^ key
        -> m (f RedisType)
    getType key = sendRequest ["TYPE", encode key]

    -- |A single entry from the slowlog.
    data Slowlog = Slowlog
        { slowlogId        :: Integer
          -- ^ A unique progressive identifier for every slow log entry.
        , slowlogTimestamp :: Integer
          -- ^ The unix timestamp at which the logged command was processed.
        , slowlogMicros    :: Integer
          -- ^ The amount of time needed for its execution, in microseconds.
        , slowlogCmd       :: [ByteString]
          -- ^ The command and it's arguments.
        } deriving (Show, Eq)

    instance RedisResult Slowlog where
        decode (MultiBulk (Just [logId,timestamp,micros,cmd])) = do
            slowlogId        <- decode logId
            slowlogTimestamp <- decode timestamp
            slowlogMicros    <- decode micros
            slowlogCmd       <- decode cmd
            return Slowlog{..}
        decode r = Left r

    slowlogGet
        :: (RedisCtx m f)
        => Integer -- ^ cnt
        -> m (f [Slowlog])
    slowlogGet n = sendRequest ["SLOWLOG", "GET", encode n]

    slowlogLen :: (RedisCtx m f) => m (f Integer)
    slowlogLen = sendRequest ["SLOWLOG", "LEN"]

    slowlogReset :: (RedisCtx m f) => m (f Status)
    slowlogReset = sendRequest ["SLOWLOG", "RESET"]

    zrange
        :: (RedisCtx m f)
        => ByteString -- ^ key
        -> Integer -- ^ start
        -> Integer -- ^ stop
        -> m (f [ByteString])
    zrange key start stop =
        sendRequest ["ZRANGE", encode key, encode start, encode stop]

    zrangeWithscores
        :: (RedisCtx m f)
        => ByteString -- ^ key
        -> Integer -- ^ start
        -> Integer -- ^ stop
        -> m (f [(ByteString, Double)])
    zrangeWithscores key start stop =
        sendRequest ["ZRANGE", encode key, encode start, encode stop, "WITHSCORES"]

    zrevrange
        :: (RedisCtx m f)
        => ByteString -- ^ key
        -> Integer -- ^ start
        -> Integer -- ^ stop
        -> m (f [ByteString])
    zrevrange key start stop =
        sendRequest ["ZREVRANGE", encode key, encode start, encode stop]

    zrevrangeWithscores
        :: (RedisCtx m f)
        => ByteString -- ^ key
        -> Integer -- ^ start
        -> Integer -- ^ stop
        -> m (f [(ByteString, Double)])
    zrevrangeWithscores key start stop =
        sendRequest ["ZREVRANGE", encode key, encode start, encode stop
                    ,"WITHSCORES"]

    zrangebyscore
        :: (RedisCtx m f)
        => ByteString -- ^ key
        -> Double -- ^ min
        -> Double -- ^ max
        -> m (f [ByteString])
    zrangebyscore key min max =
        sendRequest ["ZRANGEBYSCORE", encode key, encode min, encode max]

    zrangebyscoreWithscores
        :: (RedisCtx m f)
        => ByteString -- ^ key
        -> Double -- ^ min
        -> Double -- ^ max
        -> m (f [(ByteString, Double)])
    zrangebyscoreWithscores key min max =
        sendRequest ["ZRANGEBYSCORE", encode key, encode min, encode max
                    ,"WITHSCORES"]

    zrangebyscoreLimit
        :: (RedisCtx m f)
        => ByteString -- ^ key
        -> Double -- ^ min
        -> Double -- ^ max
        -> Integer -- ^ offset
        -> Integer -- ^ count
        -> m (f [ByteString])
    zrangebyscoreLimit key min max offset count =
        sendRequest ["ZRANGEBYSCORE", encode key, encode min, encode max
                    ,"LIMIT", encode offset, encode count]

    zrangebyscoreWithscoresLimit
        :: (RedisCtx m f)
        => ByteString -- ^ key
        -> Double -- ^ min
        -> Double -- ^ max
        -> Integer -- ^ offset
        -> Integer -- ^ count
        -> m (f [(ByteString, Double)])
    zrangebyscoreWithscoresLimit key min max offset count =
        sendRequest ["ZRANGEBYSCORE", encode key, encode min, encode max
                    ,"WITHSCORES","LIMIT", encode offset, encode count]

    zrevrangebyscore
        :: (RedisCtx m f)
        => ByteString -- ^ key
        -> Double -- ^ max
        -> Double -- ^ min
        -> m (f [ByteString])
    zrevrangebyscore key min max =
        sendRequest ["ZREVRANGEBYSCORE", encode key, encode min, encode max]

    zrevrangebyscoreWithscores
        :: (RedisCtx m f)
        => ByteString -- ^ key
        -> Double -- ^ max
        -> Double -- ^ min
        -> m (f [(ByteString, Double)])
    zrevrangebyscoreWithscores key min max =
        sendRequest ["ZREVRANGEBYSCORE", encode key, encode min, encode max
                    ,"WITHSCORES"]

    zrevrangebyscoreLimit
        :: (RedisCtx m f)
        => ByteString -- ^ key
        -> Double -- ^ max
        -> Double -- ^ min
        -> Integer -- ^ offset
        -> Integer -- ^ count
        -> m (f [ByteString])
    zrevrangebyscoreLimit key min max offset count =
        sendRequest ["ZREVRANGEBYSCORE", encode key, encode min, encode max
                    ,"LIMIT", encode offset, encode count]

    zrevrangebyscoreWithscoresLimit
        :: (RedisCtx m f)
        => ByteString -- ^ key
        -> Double -- ^ max
        -> Double -- ^ min
        -> Integer -- ^ offset
        -> Integer -- ^ count
        -> m (f [(ByteString, Double)])
    zrevrangebyscoreWithscoresLimit key min max offset count =
        sendRequest ["ZREVRANGEBYSCORE", encode key, encode min, encode max
                    ,"WITHSCORES","LIMIT", encode offset, encode count]

    -- |Options for the 'sort' command.
    data SortOpts = SortOpts
        { sortBy     :: Maybe ByteString
        , sortLimit  :: (Integer,Integer)
        , sortGet    :: [ByteString]
        , sortOrder  :: SortOrder
        , sortAlpha  :: Bool
        } deriving (Show, Eq)

    -- |Redis default 'SortOpts'. Equivalent to omitting all optional parameters.
    --
    -- @
    -- SortOpts
    --     { sortBy    = Nothing -- omit the BY option
    --     , sortLimit = (0,-1)  -- return entire collection
    --     , sortGet   = []      -- omit the GET option
    --     , sortOrder = Asc     -- sort in ascending order
    --     , sortAlpha = False   -- sort numerically, not lexicographically
    --     }
    -- @
    --
    defaultSortOpts :: SortOpts
    defaultSortOpts = SortOpts
        { sortBy    = Nothing
        , sortLimit = (0,-1)
        , sortGet   = []
        , sortOrder = Asc
        , sortAlpha = False
        }

    data SortOrder = Asc | Desc deriving (Show, Eq)

    sortStore
        :: (RedisCtx m f)
        => ByteString -- ^ key
        -> ByteString -- ^ destination
        -> SortOpts
        -> m (f Integer)
    sortStore key dest = sortInternal key (Just dest)

    sort
        :: (RedisCtx m f)
        => ByteString -- ^ key
        -> SortOpts
        -> m (f [ByteString])
    sort key = sortInternal key Nothing

    sortInternal
        :: (RedisResult a, RedisCtx m f)
        => ByteString -- ^ key
        -> Maybe ByteString -- ^ destination
        -> SortOpts
        -> m (f a)
    sortInternal key destination SortOpts{..} = sendRequest $
        concat [["SORT", encode key], by, limit, get, order, alpha, store]
      where
        by    = maybe [] (\pattern -> ["BY", pattern]) sortBy
        limit = let (off,cnt) = sortLimit in ["LIMIT", encode off, encode cnt]
        get   = concatMap (\pattern -> ["GET", pattern]) sortGet
        order = case sortOrder of Desc -> ["DESC"]; Asc -> ["ASC"]
        alpha = ["ALPHA" |sortAlpha]
        store = maybe [] (\dest -> ["STORE", dest]) destination

    data Aggregate = Sum | Min | Max deriving (Show,Eq)

    zunionstore
        :: (RedisCtx m f)
        => ByteString -- ^ destination
        -> [ByteString] -- ^ keys
        -> Aggregate
        -> m (f Integer)
    zunionstore dest keys =
        zstoreInternal "ZUNIONSTORE" dest keys []

    zunionstoreWeights
        :: (RedisCtx m f)
        => ByteString -- ^ destination
        -> [(ByteString,Double)] -- ^ weighted keys
        -> Aggregate
        -> m (f Integer)
    zunionstoreWeights dest kws =
        let (keys,weights) = unzip kws
        in zstoreInternal "ZUNIONSTORE" dest keys weights

    zinterstore
        :: (RedisCtx m f)
        => ByteString -- ^ destination
        -> [ByteString] -- ^ keys
        -> Aggregate
        -> m (f Integer)
    zinterstore dest keys =
        zstoreInternal "ZINTERSTORE" dest keys []

    zinterstoreWeights
        :: (RedisCtx m f)
        => ByteString -- ^ destination
        -> [(ByteString,Double)] -- ^ weighted keys
        -> Aggregate
        -> m (f Integer)
    zinterstoreWeights dest kws =
        let (keys,weights) = unzip kws
        in zstoreInternal "ZINTERSTORE" dest keys weights

    zstoreInternal
        :: (RedisCtx m f)
        => ByteString -- ^ cmd
        -> ByteString -- ^ destination
        -> [ByteString] -- ^ keys
        -> [Double] -- ^ weights
        -> Aggregate
        -> m (f Integer)
    zstoreInternal cmd dest keys weights aggregate = sendRequest $
        concat [ [cmd, dest, encode . toInteger $ length keys], keys
               , if null weights then [] else "WEIGHTS" : map encode weights
               , ["AGGREGATE", aggregate']
               ]
      where
        aggregate' = case aggregate of
            Sum -> "SUM"
            Min -> "MIN"
            Max -> "MAX"

    eval
        :: (RedisCtx m f, RedisResult a)
        => ByteString -- ^ script
        -> [ByteString] -- ^ keys
        -> [ByteString] -- ^ args
        -> m (f a)
    eval script keys args =
        sendRequest $ ["EVAL", script, encode numkeys] ++ keys ++ args
      where
        numkeys = toInteger (length keys)

    evalsha
        :: (RedisCtx m f, RedisResult a)
        => ByteString -- ^ script
        -> [ByteString] -- ^ keys
        -> [ByteString] -- ^ args
        -> m (f a)
    evalsha script keys args =
        sendRequest $ ["EVALSHA", script, encode numkeys] ++ keys ++ args
      where
        numkeys = toInteger (length keys)

    bitcount
        :: (RedisCtx m f)
        => ByteString -- ^ key
        -> m (f Integer)
    bitcount key = sendRequest ["BITCOUNT", key]

    bitcountRange
        :: (RedisCtx m f)
        => ByteString -- ^ key
        -> Integer -- ^ start
        -> Integer -- ^ end
        -> m (f Integer)
    bitcountRange key start end =
        sendRequest ["BITCOUNT", key, encode start, encode end]

    bitopAnd
        :: (RedisCtx m f)
        => ByteString -- ^ destkey
        -> [ByteString] -- ^ srckeys
        -> m (f Integer)
    bitopAnd dst srcs = bitop "AND" (dst:srcs)

    bitopOr
        :: (RedisCtx m f)
        => ByteString -- ^ destkey
        -> [ByteString] -- ^ srckeys
        -> m (f Integer)
    bitopOr dst srcs = bitop "OR" (dst:srcs)

    bitopXor
        :: (RedisCtx m f)
        => ByteString -- ^ destkey
        -> [ByteString] -- ^ srckeys
        -> m (f Integer)
    bitopXor dst srcs = bitop "XOR" (dst:srcs)

    bitopNot
        :: (RedisCtx m f)
        => ByteString -- ^ destkey
        -> ByteString -- ^ srckey
        -> m (f Integer)
    bitopNot dst src = bitop "NOT" [dst, src]

    bitop
        :: (RedisCtx m f)
        => ByteString -- ^ operation
        -> [ByteString] -- ^ keys
        -> m (f Integer)
    bitop op ks = sendRequest $ "BITOP" : op : ks