monarch (empty) → 0.1.0.0

raw patch · 5 files changed

+209/−0 lines, 5 filesdep +HUnitdep +basedep +bytestringsetup-changed

Dependencies added: HUnit, base, bytestring, hspec, mtl, tokyotyrant-haskell

Files

• Database/Monarch.hs +111/−0
• LICENSE +30/−0
• Setup.hs +2/−0
• monarch.cabal +35/−0
• test/test.hs +31/−0

@@ -0,0 +1,111 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+-- | This module makes tokyotyrant-haskell monadic.+module Database.Monarch+    (+      -- * Basic Types+      Key, Value, Host, Port+      -- * TokyoTyrant DB action monad and its runner+    , Monarch, runMonarch+      -- * Fetch/store single key/value+    , get, put, putKeep+      -- * Fetch/store multiple key/value+    , mget, mput+      -- * Delete key/value+    , delete, vanish+      -- * Search key prefix+    , fwmkeys+    ) where++import qualified Database.TokyoTyrant.FFI as TT+import Data.ByteString+import Control.Applicative+import Control.Monad.Reader+import Control.Monad.Error+import Control.Exception++type Key = ByteString++type Value = ByteString++type Host = ByteString++type Port = Int++-- | A monad supporting TokyoTyrant access.+newtype Monarch a = Monarch { unMonarch :: ErrorT String (ReaderT TT.Connection IO) a}+    deriving ( Functor, Applicative, Monad, MonadIO+             , MonadReader TT.Connection, MonadError String )++-- | Run Monarch with TokyoTyrant at target host and port.+runMonarch :: MonadIO m =>+              Host      -- ^ host+           -> Port      -- ^ port+           -> Monarch a -- ^ action+           -> m (Either String a)+runMonarch host port monarch = liftIO $ bracket open' close' action+    where+      action = (return . Left) `either` (runReaderT . runErrorT . unMonarch $ monarch)+      open' = TT.open host port+      close' = (const $ return ()) `either` TT.close++liftMonarch :: (MonadIO m, MonadError a m) => IO (Either a b) -> m b+liftMonarch action = liftIO action >>= either throwError return++-- | Get a value. If not found, return Nothing.+get :: Key -- ^ key+    -> Monarch (Maybe Value)+get key = do+  conn <- ask+  liftMonarch $ TT.get conn key++-- | Destructive store a value.+put :: Key   -- ^ key+    -> Value -- ^ value+    -> Monarch ()+put key value = do+  conn <- ask+  liftMonarch $ TT.put conn key value++-- | Non-Destructive store a value.+putKeep :: Key   -- ^ key+        -> Value -- ^ value+        -> Monarch ()+putKeep key value = do+  conn <- ask+  liftMonarch $ TT.putKeep conn key value++-- | Get values.+mget :: [Key] -- ^ keys to get+     -> Monarch [(Key, Value)]+mget keys = do+  conn <- ask+  liftMonarch $ TT.mget conn keys++-- | Put values.+mput :: [(Key, Value)] -- ^ key/value pairs to put+     -> Monarch ()+mput kvs = do+  conn <- ask+  liftMonarch $ TT.mput conn kvs++-- | Delete a value.+delete :: Key -- ^ key to delete+       -> Monarch ()+delete key = do+  conn <- ask+  liftMonarch $ TT.delete conn key++-- | Delete all value.+vanish :: Monarch ()+vanish = do+  conn <- ask+  liftMonarch $ TT.vanish conn++-- | Search keys by prefix.+fwmkeys :: ByteString -- ^ key prefix+        -> Maybe Int  -- ^ max # of returned keys;+                      --   Nothing means no limit+        -> Monarch [Key]+fwmkeys key n = do+  conn <- ask+  liftMonarch $ TT.fwmkeys conn key (maybe (-1) id n)

@@ -0,0 +1,30 @@+Copyright (c) 2012, Noriyuki OHKAWA++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Noriyuki OHKAWA nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,35 @@+name:                monarch+version:             0.1.0.0+synopsis:            Monadic interface for TokyoTyrant.+description:         This package provides simple monadic interface for TokyoTyrant.+license:             BSD3+license-file:        LICENSE+author:              Noriyuki OHKAWA <n.ohkawa@gmail.com>+maintainer:          Noriyuki OHKAWA <n.ohkawa@gmail.com>+category:            Database+build-type:          Simple+cabal-version:       >=1.8+homepage:            https://github.com/notogawa/monarch++library+  exposed-modules:     Database.Monarch+  ghc-options:         -Wall+  build-depends:       base ==4.*+                     , mtl ==2.1.*+                     , bytestring ==0.9.*+                     , tokyotyrant-haskell ==1.0.*++test-suite unit-test+  hs-source-dirs:      test, .+  type:                exitcode-stdio-1.0+  main-is:             test.hs+  build-depends:       base ==4.*+                     , mtl ==2.1.*+                     , bytestring ==0.9.*+                     , tokyotyrant-haskell ==1.0.*+                     , hspec ==1.3.*+                     , HUnit ==1.2.*++source-repository head+  type:                git+  location:            https://github.com/notogawa/monarch

@@ -0,0 +1,31 @@+{-# LANGUAGE OverloadedStrings #-}+import Database.Monarch++import Test.HUnit+import Test.Hspec.Monadic+import Test.Hspec.HUnit ()++main :: IO ()+main = hspec $ do+         describe "TokyoTyrant" $ do+                it "get unstored value" caseGetUnstored+                it "get already stored value" caseGetStored++caseGetUnstored :: Assertion+caseGetUnstored = do+  result <- runMonarch "localhost" 1978 $ do+                    vanish+                    result <- get "foo"+                    vanish+                    return result+  result @?= Right Nothing++caseGetStored :: Assertion+caseGetStored = do+  result <- runMonarch "localhost" 1978 $ do+                  vanish+                  put "foo" "bar"+                  result <- get "foo"+                  vanish+                  return result+  result @?= Right (Just "bar")