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 +18/−10
- Database/Persist/Zookeeper/Internal.hs +54/−3
- Database/Persist/Zookeeper/PathPiece.hs +7/−11
- Database/Persist/Zookeeper/Query.hs +33/−83
- Database/Persist/Zookeeper/Store.hs +53/−23
- Database/Persist/Zookeeper/Unique.hs +3/−2
- Database/Persist/Zookeeper/ZooUtil.hs +0/−71
- persistent-zookeeper.cabal +10/−6
- tests/basic-test.hs +19/−14
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