packages feed

persistent-zookeeper 0.0.3 → 0.1.0

raw patch · 9 files changed

+197/−223 lines, 9 filesdep +resourcetdep ~hzkdep ~persistentdep ~persistent-templatePVP ok

version bump matches the API change (PVP)

Dependencies added: resourcet

Dependency ranges changed: hzk, persistent, persistent-template

API changes (from Hackage documentation)

- Database.Persist.Zookeeper: data ZookeeperBackend
- Database.Persist.Zookeeper: fieldval :: (PersistEntity val, PersistField typ) => EntityField val typ -> val -> PersistValue
- Database.Persist.Zookeeper: filter2path :: PersistEntity val => [Filter val] -> String
- Database.Persist.Zookeeper: getFieldName :: (PersistEntity val, PersistField typ) => EntityField val typ -> Text
- Database.Persist.Zookeeper: getFieldsName :: PersistEntity val => val -> [Text]
- Database.Persist.Zookeeper: getList :: PersistEntity val => val -> [(Text, PersistValue)]
- Database.Persist.Zookeeper: getMap :: PersistEntity val => val -> Map Text PersistValue
- Database.Persist.Zookeeper: updateEntity :: PersistEntity val => val -> [Update val] -> Either Text val
- Database.Persist.Zookeeper: updateVal :: PersistEntity val => PersistValue -> Update val -> PersistValue
- Database.Persist.Zookeeper: updateVals :: PersistEntity val => [(Text, PersistValue)] -> Update val -> [(Text, PersistValue)]
+ Database.Persist.Zookeeper: defaultZookeeperConf :: ZookeeperConf
+ Database.Persist.Zookeeper: defaultZookeeperSettings :: MkPersistSettings
+ Database.Persist.Zookeeper: runZookeeper :: MonadBaseControl IO m => Connection -> ReaderT Zookeeper m b -> m b
- Database.Persist.Zookeeper: execZookeeperT :: (Read a, Show a, Monad m, MonadIO m) => (Zookeeper -> IO (Either ZKError a)) -> ZookeeperT m a
+ Database.Persist.Zookeeper: execZookeeperT :: (Read a, Show a, Monad m, MonadIO m) => (Zookeeper -> IO (Either ZKError a)) -> ReaderT Zookeeper m a
- Database.Persist.Zookeeper: type Connection = Pool ZooStat
+ Database.Persist.Zookeeper: type Connection = Pool Zookeeper

Files

Database/Persist/Zookeeper/Config.hs view
@@ -6,26 +6,23 @@ {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, UndecidableInstances #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ImpredicativeTypes #-}+{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Database.Persist.Zookeeper.Config-    (-     ZookeeperConf (..)-    , Connection-    , ZookeeperT (..)-    , runZookeeperPool-    , withZookeeperConn-    , thisConnection-    , module Database.Persist-    ) where+    where  import Database.Persist+import Database.Persist.TH+import Language.Haskell.TH import qualified Database.Persist.Zookeeper.ZooUtil as Z import qualified Database.Zookeeper as Z+import qualified Database.Zookeeper.Pool as Z import Data.Pool import Data.Aeson import Control.Monad (mzero, MonadPlus(..)) import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad.Trans.Class (MonadTrans (..))+import Control.Monad.Trans.Control import Control.Applicative (Applicative (..)) import Control.Monad.Reader(ReaderT(..)) import Control.Monad.Reader.Class@@ -41,7 +38,7 @@   , zMaxResources :: Int } deriving (Show) -type Connection = Pool Z.ZooStat+type Connection = Pool Z.Zookeeper  -- | Monad reader transformer keeping Zookeeper connection through out the work newtype ZookeeperT m a = ZookeeperT { runZookeeperT :: ReaderT Connection m a }@@ -59,6 +56,17 @@  runZookeeperPool :: ZookeeperT m a -> Connection -> m a runZookeeperPool (ZookeeperT r) = runReaderT r++--runZookeeper :: ZookeeperT m a -> Connection -> m a+runZookeeper :: MonadBaseControl IO m =>+                Connection -> ReaderT Z.Zookeeper m b -> m b+runZookeeper pool action = withResource pool (\stat -> runReaderT action stat)++defaultZookeeperConf :: ZookeeperConf+defaultZookeeperConf = ZookeeperConf "localhost:2181" 10000 1 50 30++defaultZookeeperSettings :: MkPersistSettings+defaultZookeeperSettings = (mkPersistSettings $ ConT ''Z.Zookeeper)  instance PersistConfig ZookeeperConf where     type PersistConfigBackend ZookeeperConf = ZookeeperT
Database/Persist/Zookeeper/Internal.hs view
@@ -12,14 +12,22 @@ import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy.Char8 as BL import qualified Data.ByteString.Base64.URL as B64+import qualified Data.Map as M   txtToKey :: (PersistEntity val) => T.Text -> Key val-txtToKey = Key . PersistText+txtToKey txt = +  case (keyFromValues [PersistText txt]) of+    Right v -> v+    Left v -> error $ T.unpack v  keyToTxt :: (PersistEntity val) => Key val -> T.Text-keyToTxt (Key (PersistText key)) = key-keyToTxt v = error $ "do not support "++show v+--keyToTxt (Key (PersistText key)) = key+keyToTxt key = +  case keyToValues key of+    [PersistText txt] -> txt+    _ -> error "keyToTxt"+--keyToTxt v = error $ "do not support "++show v  dummyFromKey :: Key v -> Maybe v dummyFromKey _ = Nothing@@ -71,3 +79,46 @@  -- key2path :: (PersistEntity val) => Key val -> String -- key2path key = entityAndKey2path (fromJust (dummyFromKey key)) key++++filter2path :: (PersistEntity val) => [Filter val] -> String +filter2path filterList = entity2path $ dummyFromFList filterList++getMap :: PersistEntity val => val -> M.Map T.Text PersistValue+getMap val =  M.fromList $ getList val+getList :: PersistEntity val => val -> [(T.Text,PersistValue)]+getList val =  +  let fields = fmap toPersistValue (toPersistFields val)+      in zip (getFieldsName val) fields+getFieldsName :: (PersistEntity val) => val -> [T.Text]+getFieldsName val =  fmap (unDBName.fieldDB) $ entityFields $ entityDef $ Just val+getFieldName :: (PersistEntity val,PersistField typ) => EntityField val typ -> T.Text+getFieldName field =  unDBName $ fieldDB $ persistFieldDef $ field+fieldval :: (PersistEntity val,PersistField typ) => EntityField val typ -> val -> PersistValue+fieldval field val =  (getMap val) M.! (getFieldName field)++updateEntity :: PersistEntity val =>  val -> [Update val] -> Either T.Text val+updateEntity val upds = +  fromPersistValues $ map snd $ foldl updateVals (getList val) upds+++updateVals :: PersistEntity val =>  [(T.Text,PersistValue)] -> Update val -> [(T.Text,PersistValue)]+updateVals [] _ = []+updateVals ((k,v):xs) u@(Update field _ _) = +  if getFieldName field == k+    then (k,updateVal v u):xs+    else (k,v):updateVals xs u+updateVals _ _ = error "not supported"++updateVal :: PersistEntity val =>  PersistValue -> Update val -> PersistValue+updateVal _v (Update _ val upd) = +  case upd of+    Assign -> toPersistValue val+    _ -> error "not support"+    -- Add -> (+) <$> v <$> toPersistValue val +    -- Subtract -> v - toPersistValue val +    -- Multiply -> v * toPersistValue val +    -- Divide -> v `div` toPersistValue val +updateVal _v _ = error "not supported"+
Database/Persist/Zookeeper/PathPiece.hs view
@@ -7,20 +7,16 @@ module Database.Persist.Zookeeper.PathPiece     where +import qualified Database.Zookeeper as Z import Database.Persist import Database.Persist.Zookeeper.Store+import Database.Persist.Zookeeper.ZooUtil import Web.PathPieces (PathPiece (..))-import qualified Data.ByteString.Char8 as B-import qualified Data.Text as T-import qualified Data.ByteString.Base64.URL as B64-+import Control.Applicative  -- | ToPathPiece is used to convert a key to/from text-instance PathPiece (KeyBackend ZookeeperBackend entity) where-  fromPathPiece txt =-    case B64.decode $ B.pack $ T.unpack txt of-      Right v -> Just (Key (PersistText (T.pack $ B.unpack v)))-      Left _ -> Nothing-  toPathPiece (Key (PersistText txt)) = T.pack $ B.unpack $ B64.encode $ B.pack $ T.unpack txt-  toPathPiece (Key _) = error "Wrong key for pathpiece "+instance PathPiece (BackendKey Z.Zookeeper) where+  fromPathPiece txt = pure $ ZooKey txt+  toPathPiece (ZooKey txt) = txt+ 
Database/Persist/Zookeeper/Query.hs view
@@ -9,79 +9,29 @@  import Database.Persist import Data.Monoid-import Control.Applicative import Control.Monad.IO.Class (MonadIO (..))-import Control.Monad.Trans.Control (MonadBaseControl)-import Control.Monad.Trans.Class+import Control.Monad.Trans.Reader import qualified Data.Text as T import qualified Database.Zookeeper as Z-import Database.Persist.Zookeeper.Config import Database.Persist.Zookeeper.Internal import Database.Persist.Zookeeper.Store-import qualified Data.Map as M+import Database.Persist.Zookeeper.ZooUtil import Data.Conduit--filter2path :: (PersistEntity val) => [Filter val] -> String -filter2path filterList = entity2path $ dummyFromFList filterList--getMap :: PersistEntity val => val -> M.Map T.Text PersistValue-getMap val =  M.fromList $ getList val-getList :: PersistEntity val => val -> [(T.Text,PersistValue)]-getList val =  -  let fields = fmap toPersistValue (toPersistFields val)-      in zip (getFieldsName val) fields-getFieldsName :: (PersistEntity val) => val -> [T.Text]-getFieldsName val =  fmap (unDBName.fieldDB) $ entityFields $ entityDef $ Just val-getFieldName :: (PersistEntity val,PersistField typ) => EntityField val typ -> T.Text-getFieldName field =  unDBName $ fieldDB $ persistFieldDef $ field-fieldval :: (PersistEntity val,PersistField typ) => EntityField val typ -> val -> PersistValue-fieldval field val =  (getMap val) M.! (getFieldName field)---updateEntity :: PersistEntity val =>  val -> [Update val] -> Either T.Text val-updateEntity val upds = -  fromPersistValues $ map snd $ foldl updateVals (getList val) upds---updateVals :: PersistEntity val =>  [(T.Text,PersistValue)] -> Update val -> [(T.Text,PersistValue)]-updateVals [] _ = []-updateVals ((k,v):xs) u@(Update field _ _) = -  if getFieldName field == k-    then (k,updateVal v u):xs-    else (k,v):updateVals xs u-updateVals _ _ = error "not supported"--updateVal :: PersistEntity val =>  PersistValue -> Update val -> PersistValue-updateVal _v (Update _ val upd) = -  case upd of-    Assign -> toPersistValue val-    _ -> error "not support"-    -- Add -> (+) <$> v <$> toPersistValue val -    -- Subtract -> v - toPersistValue val -    -- Multiply -> v * toPersistValue val -    -- Divide -> v `div` toPersistValue val -updateVal _v _ = error "not supported"-+import qualified Data.Conduit.List as CL+import Data.Acquire -instance (Applicative m, Functor m, MonadIO m, MonadBaseControl IO m) => PersistQuery (ZookeeperT m) where-  update key valList = do-    va <- get key-    case va of-      Nothing -> return ()-      Just v ->-        case updateEntity v valList of-          Right v' -> -            replace key v'-          Left v' -> error $ show v'+instance PersistQuery Z.Zookeeper where   updateWhere filterList valList = do-    (selectKeys filterList []) $$ loop+    stat <- ask+    srcRes <- selectKeysRes filterList []+    liftIO $ with srcRes ( $$ loop stat)     where-      loop = do+      loop stat = do         key <- await         case key of           Just key' -> do-            lift $ update key' valList-            loop+            liftIO $ flip runReaderT stat $ update key' valList+            loop stat           Nothing ->             return ()   deleteWhere filterList = do@@ -101,15 +51,16 @@               then delete key               else return ()         loop xs-  selectSource filterList [] = do-    (str::[String]) <- lift $ execZookeeperT $ \zk -> do+  selectSourceRes filterList [] = do+    stat <- ask+    (str::[String]) <- liftIO $ flip runReaderT stat $ execZookeeperT $ \zk -> do       Z.getChildren zk (filter2path filterList) Nothing-    loop str+    return $ return $ loop stat str     where-      loop [] = return ()-      loop (x:xs) = do+      loop _ [] = return ()+      loop stat (x:xs) = do         let key = txtToKey $ T.pack $ (filter2path filterList) <> "/" <> x-        va <- get key+        va <- liftIO $ flip runReaderT stat $ get key         case va of           Nothing -> return ()           Just v -> do@@ -117,23 +68,22 @@             if chk               then yield $ Entity key v               else return ()-        loop xs-  selectSource _ _ = error "not supported selectOpt"-  selectFirst filterList selectOpts =  do-    (selectSource filterList selectOpts) $$ do-      val <- await-      case val of-        Just val' -> return $ Just val'-        Nothing -> return Nothing-  selectKeys filterList [] = do -    (str::[String]) <- lift $ execZookeeperT $ \zk -> +        loop stat xs+  selectSourceRes _ _ = error "not supported selectOpt"+  selectFirst filterList [] =  do+    srcRes <- selectSourceRes filterList []+    liftIO $ with srcRes ( $$ CL.head)+  selectFirst _ _ = error "not supported selectOpt"+  selectKeysRes filterList [] = do +    stat <- ask+    (str::[String]) <- liftIO $ flip runReaderT stat $ execZookeeperT $ \zk ->        Z.getChildren zk (filter2path filterList) Nothing-    loop str+    return $ return (loop stat str)     where-      loop [] = return ()-      loop (x:xs) = do+      loop _ [] = return ()+      loop stat (x:xs) = do         let key = txtToKey $ T.pack $ (filter2path filterList) <> "/" <> x-        va <- get key+        va <- liftIO $ flip runReaderT stat $ get key         case va of           Nothing -> return ()           Just v -> do@@ -141,8 +91,8 @@             if chk               then yield key               else return ()-        loop xs-  selectKeys  _ _ = error "not supported selectOpt"+        loop stat xs+  selectKeysRes  _ _ = error "not supported selectOpt"   count filterList = do     v <- selectList filterList []     return $ length v
Database/Persist/Zookeeper/Store.hs view
@@ -3,19 +3,17 @@ {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-}-module Database.Persist.Zookeeper.Store -    ( ZookeeperBackend-    , execZookeeperT-    )where+module Database.Persist.Zookeeper.Store where  import Database.Persist+import qualified Database.Persist.Sql as Sql -- import Database.Persist.Class -- import Database.Persist.Types import Control.Exception import Control.Applicative import Control.Monad.IO.Class (MonadIO (..))-import Control.Monad.Trans.Control (MonadBaseControl) import qualified Database.Zookeeper as Z import Data.Monoid import qualified Data.Text as T@@ -24,24 +22,47 @@ import Database.Persist.Zookeeper.Internal import Database.Persist.Zookeeper.ZooUtil import Data.Pool-+import Control.Monad+import Control.Monad.Reader+import qualified Data.Aeson as A -data ZookeeperBackend+--data ZookeeperBackend     -- -- | Execute Zookeeper transaction inside ZookeeperT monad transformer-execZookeeperT :: (Read a,Show a,Monad m, MonadIO m) => (Z.Zookeeper -> IO (Either Z.ZKError a)) -> ZookeeperT m a+execZookeeperT :: (Read a,Show a,Monad m, MonadIO m) => (Z.Zookeeper -> IO (Either Z.ZKError a)) -> ReaderT Z.Zookeeper m a execZookeeperT action = do-    conn <- thisConnection-    r <- liftIO $ withResource conn $ \s ->-      zExec s action+    s <- ask+    r <- liftIO $ action s     case r of       (Right x) -> return x       (Left x)  -> liftIO $ throwIO $ userError $ "Zookeeper error: code" ++ show x --fail $ show x -instance (Applicative m, Functor m, MonadIO m, MonadBaseControl IO m) => PersistStore (ZookeeperT m) where-    type PersistMonadBackend (ZookeeperT m) = ZookeeperBackend+-- instance PersistField DB.ObjectId where+--     toPersistValue = oidToPersistValue+--     fromPersistValue oid@(PersistObjectId _) = Right $ persistObjectIdToDbOid oid+--     fromPersistValue (PersistByteString bs) = fromPersistValue (PersistObjectId bs)+--     fromPersistValue _ = Left $ T.pack "expected PersistObjectId" +-- instance Sql.PersistFieldSql T.Text where+--     sqlType _ = Sql.SqlOther "doesn't make much sense for MongoDB"++instance Sql.PersistFieldSql (BackendKey Z.Zookeeper) where+    sqlType _ = Sql.SqlOther "doesn't make much sense for MongoDB"++instance A.ToJSON (BackendKey Z.Zookeeper) where+    toJSON (ZooKey key) = A.String key++instance A.FromJSON (BackendKey Z.Zookeeper) where+    parseJSON (A.String key) = pure $ ZooKey key+    parseJSON _ = mzero+++instance PersistStore Z.Zookeeper where+    --type PersistMonadBackend (ZookeeperT m) = ZookeeperBackend+    newtype BackendKey Z.Zookeeper = ZooKey { unZooKey :: T.Text }+        deriving (Show, Read, Eq, Ord, PersistField)+     insert val = do       let dir = entity2path val       let path = dir <> "/"@@ -49,39 +70,39 @@         zCreate zk dir path (Just (entity2bin val)) [Z.Sequence]       return $ txtToKey $ T.pack $ str -    insertKey (Key (PersistText key)) val = do+    insertKey key val = do       _ <- execZookeeperT $ \zk -> do         let dir = entity2path val-        zCreate zk dir (T.unpack key) (Just (entity2bin val)) []+        zCreate zk dir (T.unpack (keyToTxt key)) (Just (entity2bin val)) []       return ()      insertKey _ _ = fail "Wrong key type in insertKey" -    repsert (Key (PersistText key)) val = do+    repsert key val = do       _ <- execZookeeperT $ \zk -> do         let dir = entity2path val-        zRepSert zk dir (T.unpack key) (Just (entity2bin val))+        zRepSert zk dir (T.unpack (keyToTxt key)) (Just (entity2bin val))       return ()     repsert _ _ = fail "Wrong key type in repsert" -    replace (Key (PersistText key)) val = do+    replace key val = do       execZookeeperT $ \zk -> do-        _ <- zReplace zk (T.unpack key) (Just (entity2bin val))+        _ <- zReplace zk (T.unpack (keyToTxt key)) (Just (entity2bin val))         return $ Right ()       return ()      replace _ _ = fail "Wrong key type in replace" -    delete (Key (PersistText key)) = do+    delete key = do       execZookeeperT $ \zk -> do-        _ <- Z.delete zk (T.unpack key) Nothing+        _ <- Z.delete zk (T.unpack (keyToTxt key)) Nothing         return $ Right ()       return ()     delete _ = fail "Wrong key type in delete" -    get (Key (PersistText key)) = do+    get key = do       r <- execZookeeperT $ \zk -> do-        val <- Z.get zk (T.unpack key) Nothing+        val <- Z.get zk (T.unpack (keyToTxt key)) Nothing         return $ Right val       case r of         (Left Z.NoNodeError) ->@@ -94,3 +115,12 @@           fail $ "data is nothing"            get  _ = fail "Wrong key type in get"+    update key valList = do+      va <- get key+      case va of+        Nothing -> return ()+        Just v ->+          case updateEntity v valList of+            Right v' -> +              replace key v'+            Left v' -> error $ show v'
Database/Persist/Zookeeper/Unique.hs view
@@ -18,7 +18,7 @@ import Database.Persist.Zookeeper.Store import Database.Persist.Zookeeper.ZooUtil -instance (Applicative m, Functor m, MonadIO m, MonadBaseControl IO m) => PersistUnique (ZookeeperT m) where+instance PersistUnique Z.Zookeeper where     getBy uniqVal = do       let key = uniqkey2key uniqVal       val <- get key@@ -34,7 +34,8 @@       mUniqVal <- val2uniqkey val       case mUniqVal of         Just uniqVal -> do-          let key@(Key (PersistText txt)) = uniqkey2key uniqVal+          let key = (uniqkey2key uniqVal)+          let txt = keyToTxt key           execZookeeperT $ \zk -> do             let dir = entity2path val             r <- zCreate zk dir (T.unpack txt) (Just (entity2bin val)) []
Database/Persist/Zookeeper/ZooUtil.hs view
@@ -86,74 +86,3 @@         Right _ -> zCreate zk dir path value flag     v' -> return v' -data ZooStat = ZooStat {-    zVar :: TMVar (ZAction String)-  , rVar :: TMVar String-  }--data ZAction t = -    Action (Z.Zookeeper -> IO String)-  | Close--zOpen ::   String-        -> Z.Timeout-        -> Maybe Z.Watcher-        -> Maybe Z.ClientID-        -> IO ZooStat-zOpen endpoint timeout watcher clientId = do-  Z.setDebugLevel Z.ZLogError-  zvar <- atomically $ newEmptyTMVar-  rvar <- atomically $ newEmptyTMVar-  stateVar <- newTVarIO Z.ConnectingState-  let watcher' = if isJust watcher then watcher else (Just (watcherd stateVar))-  _ <- forkIO $ Z.withZookeeper endpoint timeout watcher' clientId $ \z -> do-    atomically $ do-      state <- readTVar stateVar-      case state of-        Z.ConnectingState -> retry-        _ -> return ()-    loop zvar rvar z-  return $ ZooStat zvar rvar-  where-    loop zvar rvar z = do-      var <- atomically $ takeTMVar zvar-      case var of-        Close -> return ()-        Action io -> do-          v <- io z-          atomically $ putTMVar rvar v-          loop zvar rvar z-    watcherd :: TVar Z.State -> Z.Watcher-    watcherd stateVar _z event state _mZnode = do-      case event of-        Z.SessionEvent -> atomically $ writeTVar stateVar state-        _ -> return ()--zExec :: (Read a, Show a) => ZooStat -> (Z.Zookeeper -> IO a) -> IO a-zExec (ZooStat zvar rvar) action = do-  atomically $ do-    putTMVar zvar $ Action $ \zk -> do-      v <- action zk-      return $ show v-  var <- atomically $ do-    takeTMVar rvar-  return $ read var--zClose :: ZooStat -> IO ()-zClose (ZooStat zvar _rvar) = do-  atomically $ do-    putTMVar zvar Close--connect :: String-        -> Z.Timeout-        -> Maybe Z.Watcher-        -> Maybe Z.ClientID-        -> Int-        -> NominalDiffTime-        -> Int-        -> IO (P.Pool ZooStat)-connect endpoint timeout watcher clientId numStripes idleTime maxResources =-  P.createPool-    (zOpen endpoint timeout watcher clientId) -    zClose-    numStripes idleTime maxResources
persistent-zookeeper.cabal view
@@ -1,5 +1,5 @@ name:            persistent-zookeeper-version:         0.0.3+version:         0.1.0 license:         BSD3 license-file:    LICENSE author:          Junji Hashimoto <junji.hashimoto@gree.net>@@ -18,7 +18,9 @@ library     build-depends:   base                  >= 4        && < 5                    , bytestring            >= 0.10.0.0 && < 0.11.0.0-                   , persistent            >= 1.3      && < 1.4+                   , persistent            >= 2.1+                   , persistent-template+                   , template-haskell                    , text                  >= 0.8                    , aeson                 >= 0.5                    , time                  >= 1.4      && < 1.5@@ -30,7 +32,7 @@                    , utf8-string           >= 0.3.7    && < 0.4.0                    , binary                >= 0.7      && < 0.8                    , scientific-                   , hzk+                   , hzk                   >= 2.1                    , resource-pool                    , path-pieces                    , template-haskell@@ -38,6 +40,7 @@                    , stm                    , conduit                    , containers+                   , resourcet      exposed-modules: Database.Persist.Zookeeper @@ -55,8 +58,8 @@     type: exitcode-stdio-1.0     main-is: tests/basic-test.hs     build-depends:   base                  >= 4        && < 5-                   , persistent            >= 1.3      && < 1.4-                   , persistent-template   >= 1.3      && < 1.4+                   , persistent            >= 2.1+                   , persistent-template                    , mtl                    , transformers                    , transformers-base@@ -72,7 +75,7 @@                    , utf8-string           >= 0.3.7    && < 0.4.0                    , persistent-zookeeper                    , scientific-                   , hzk+                   , hzk                   >= 2.1                    , resource-pool                    , path-pieces                    , base64-bytestring@@ -80,6 +83,7 @@                    , stm                    , conduit                    , containers+                   , resourcet  --    ghc-options:     -Wall -ddump-splices     ghc-options:     -Wall
tests/basic-test.hs view
@@ -1,15 +1,20 @@ {-# LANGUAGE TemplateHaskell, QuasiQuotes, OverloadedStrings #-} {-# LANGUAGE TypeFamilies, EmptyDataDecls, GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-} module Main where +import qualified Database.Zookeeper as Z import Database.Persist import Database.Persist.Zookeeper+import Database.Persist.Zookeeper.Internal import Database.Persist.TH import Language.Haskell.TH.Syntax import Data.Maybe+import Data.Pool import Test.Hspec -let zookeeperSettings = mkPersistSettings (ConT ''ZookeeperBackend)+let zookeeperSettings = defaultZookeeperSettings  in share [mkPersist zookeeperSettings] [persistLowerCase| Person     name String@@ -27,34 +32,34 @@ main =    withZookeeperConn zookeeperConf $ \conn -> do     hspec $ do-      let key = (Key (PersistText "/person/WyJzVGVzdC9ob2dlIl0="))+      let key = txtToKey "/person/WyJzVGVzdC9ob2dlIl0="       let val = Person "Test/hoge" 12 Nothing       describe "PersistUnique test" $ do         it "insertUnique" $ do-          v <- flip runZookeeperPool conn $ do+          v <- runZookeeper conn $ do             deleteBy $ PersonU "Test/hoge"             insertUnique val           v `shouldBe` (Just key)         it "getBy" $ do-          v <- flip runZookeeperPool conn $ do+          v <- runZookeeper conn $ do             getBy $ PersonU "Test/hoge"            (entityKey (fromJust v)) `shouldBe` key           (entityVal (fromJust v)) `shouldBe` val           v `shouldBe` (Just (Entity key val))         it "deleteBy" $ do-          v <- flip runZookeeperPool conn $ do+          v <- runZookeeper conn $ do             deleteBy $ PersonU "Test/hoge"             getBy $ PersonU "Test/hoge"           v `shouldBe` Nothing       describe "PersistStore test" $ do         it "StoreTest" $ do-          key' <- flip runZookeeperPool conn $ do+          key' <- runZookeeper conn $ do             insert val-          v <- flip runZookeeperPool conn $ do-            get key' :: ZookeeperT IO (Maybe Person)+          v <- runZookeeper conn $ do+            get key'           print $ show key'           v `shouldBe` (Just val)-          v' <- flip runZookeeperPool conn $ do+          v' <- runZookeeper conn $ do             delete key'             get key'           v' `shouldBe` Nothing@@ -77,7 +82,7 @@           check (Person "Test/hoge" 12 (Just 4)) [PersonHoge <=. Just 3] False           check (Person "Test/hoge" 12 (Just 2)) [PersonHoge <=. Just 3] True         it "StoreTest" $ do-          va <- flip runZookeeperPool conn $ do+          va <- runZookeeper conn $ do             deleteWhere [PersonName !=. ""]             _ <- insert (Person "hoge0" 1 Nothing)             _ <- insert (Person "hoge1" 2 Nothing)@@ -85,17 +90,17 @@             _ <- insert (Person "hoge3" 4 Nothing)             selectList [PersonAge ==. 2] []           (entityVal (head va)) `shouldBe` (Person "hoge1" 2 Nothing)-          [Entity _k v] <- flip runZookeeperPool conn $ do+          [Entity _k v] <- runZookeeper conn $ do             selectList [PersonName ==. "hoge2"] []           v `shouldBe` (Person "hoge2" 3 Nothing)-          [Entity _k v1] <- flip runZookeeperPool conn $ do+          [Entity _k v1] <- runZookeeper conn $ do             updateWhere [PersonName ==. "hoge2"] [PersonAge =. 10]             selectList [PersonName ==. "hoge2"] []           v1 `shouldBe` (Person "hoge2" 10 Nothing)-          v2 <- flip runZookeeperPool conn $ do+          v2 <- runZookeeper conn $ do             selectList [PersonName !=. ""] []           length v2 `shouldBe` 4-          v3 <- flip runZookeeperPool conn $ do+          v3 <- runZookeeper conn $ do             deleteWhere [PersonName !=. ""]             selectList [PersonName !=. ""] []           length v3 `shouldBe` 0