{-|

Module: Network.Starling
Copyright: Antoine Latter 2009
Maintainer: Antoine Latter <aslatter@gmail.com>

A haskell implementation of the memcahed
protocol.

This implements the new binary protocol, so
it only works with memcached version 1.3 and newer.

Example of usage, using the network package to obain
a handle, and the OverloadedStrings language extension:

> h <- connectTo "filename" $ UnixSocket "filename"
> hSetBuffering h NoBuffering
> con <- open h

> set con "hello" "world"
> get con "hello"

In the above example we connect to a unix socket in the file \"filename\",
set the key \"hello\" to the value \"world\" and then retrieve the value.

Operations are thread safe - multiple threads of execution may make
concurrent requests on the memcahced connection.

Operations are blocking, but do not block other concurrent threads
from placing requests on the connection.

-}
module Network.Starling
    ( open
    , close
    , Connection
    , Key
    , Value
    , Result
    , ResultM
    , ResponseStatus(..)
    , set
    , get
    , delete
    , add
    , replace
    , update
    , increment
    , decrement
    , flush
    , stats
    -- , oneStat -- doesn't seem to work for me
    , version
    ) where

import Network.Starling.Connection
import Network.Starling.Core hiding
    ( get
    , set
    , delete
    , add
    , replace
    , increment
    , decrement
    , flush
    , stat
    , version
    , quit
    )
import qualified Network.Starling.Core as Core

import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as BS
import qualified Data.Binary.Get as B

import Data.Word

import Control.Monad.Trans (liftIO, MonadIO)

type Result a = ResultM IO a

-- | If an operation fails the result will return in 'Left'
-- with the failure code and a text description of the failure
type ResultM m a = m (Either (ResponseStatus, ByteString) a)

-- | Set a value in the cache
set :: Connection -> Key -> Value -> Result ()
set con key value = simpleRequest con (Core.set key value) (const ())

-- | Set a vlue in the cache. Fails if a value is already defined
-- for the indicated key.
add :: Connection -> Key -> Value -> Result ()
add con key value = simpleRequest con (Core.add key value) (const ())

-- | Set a value in the cache. Fails if a value is not already defined
-- for the indicated key.
replace :: Connection -> Key -> Value -> Result ()
replace con key value = simpleRequest con (Core.replace key value) (const ())

-- | Retrive a value from the cache
get :: Connection -> Key -> Result ByteString
get con key = simpleRequest con (Core.get key) rsBody

-- | Delete an entry in the cache
delete :: Connection -> Key -> Result ()
delete con key = simpleRequest con (Core.delete key) (const ())

-- | Update a value in the cache. This operation requires two round trips.
-- This operation can fail if the key is not present in the cache, or if
-- the value changes in the cache between the two calls.
-- So watch out! Even if the value exists the operation might
-- not go through in the face of concurrent access.
--
-- Testing indicates that if we fail because we could not gaurantee
-- atomicity the failure code will be 'KeyExists'.
update :: MonadIO m =>
          Connection -> Key -> (Value -> m (Maybe Value)) -> ResultM m ()
update con key f
    = do
  response <- liftIO $ synchRequest con (Core.get key)
  case rsStatus response of
    NoError -> do
        let oldVal = rsBody response
            cas = rsCas response
        res <- f oldVal
        let baseRequest = case res of
                            Nothing -> Core.delete key
                            Just newVal -> Core.replace key newVal
            request = addCAS cas $ baseRequest
        liftIO $ simpleRequest con request (const ())
    _ -> return . errorResult $ response

-- | Increment a value in the cache. The first 'Word64' argument is the
-- amount by which to increment and the second is the intial value to
-- use of the key does not yet have a value.
-- The return value is the updated value in the cache.
increment :: Connection -> Key -> Word64 -> Word64 -> Result Word64
increment con key amount init
    = simpleRequest con (Core.increment key amount init) $ \response ->
      B.runGet B.getWord64be (rsBody response)

-- | Decrement a value in the cache. The first 'Word64' argument is the
-- amount by which to decrement and the second is the intial value to
-- use of the key does not yet have a value.
-- The return value is the updated value in the cache.
decrement :: Connection -> Key -> Word64 -> Word64 -> Result Word64
decrement con key amount init
    = simpleRequest con (Core.decrement key amount init) $ \response ->
      B.runGet B.getWord64be (rsBody response)

-- | Delete all entries in the cache
flush :: Connection -> Result ()
flush con = simpleRequest con Core.flush (const ())

simpleRequest :: Connection -> Request -> (Response -> a) -> Result a
simpleRequest con req f
    = do
  response <- synchRequest con req
  if rsStatus response == NoError
   then return . Right . f $ response
   else return . errorResult $ response

errorResult response = Left (rsStatus response, rsBody response)

-- | Returns a list of stats about the server in key,value pairs
stats :: Connection -> Result [(ByteString,ByteString)]
stats con
    = do
  resps <- synchRequestMulti con $ Core.stat Nothing
  if null resps then error "fatal error in Network.Starling.stats"
   else do
     let resp = head resps
     if rsStatus resp == NoError
      then return . Right . unpackStats $ resps
      else return $ errorResult resp

 where

   unpackStats
       = filter (\(x,y) -> not (BS.null x && BS.null y)) .
         map (\response -> (rsKey response, rsBody response))

-- | Returns a single stat. Example: 'stat con "pid"' will return
-- the 
oneStat :: Connection -> Key -> Result ByteString
oneStat con key = simpleRequest con (Core.stat $ Just key) rsBody

-- | Returns the version of the server
version :: Connection -> Result ByteString
version con = simpleRequest con Core.version rsBody