module Database.Persist.Zookeeper.Store (
deleteRecursive
, BackendKey(..)
)where
import Database.Persist
import qualified Database.Persist.Sql as Sql
import qualified Database.Zookeeper as Z
import Data.Monoid
import qualified Data.Text as T
import Database.Persist.Zookeeper.Config
import Database.Persist.Zookeeper.Internal
import Database.Persist.Zookeeper.ZooUtil
import Control.Monad
import Control.Monad.Reader
import qualified Data.Aeson as A
import Web.PathPieces (PathPiece (..))
instance PathPiece (BackendKey Z.Zookeeper) where
toPathPiece key = "z" <> (unZooKey key)
fromPathPiece keyText =
case T.uncons keyText of
Just ('z', prefixed) -> Just $ ZooKey prefixed
_ -> mzero
instance Sql.PersistFieldSql (BackendKey Z.Zookeeper) where
sqlType _ = Sql.SqlOther "doesn't make much sense for Zookeeper"
instance A.ToJSON (BackendKey Z.Zookeeper) where
toJSON (ZooKey key) = A.toJSON $ "z" <> key
instance A.FromJSON (BackendKey Z.Zookeeper) where
parseJSON = A.withText "ZooKey" $ \t ->
case T.uncons t of
Just ('z', prefixed) -> return $ ZooKey prefixed
_ -> (fail "Invalid json for zookey")
deleteRecursive :: (Monad m, MonadIO m) => String -> Action m ()
deleteRecursive dir = execZookeeper $ \zk -> zDeleteRecursive zk dir
instance PersistStore Z.Zookeeper where
newtype BackendKey Z.Zookeeper = ZooKey { unZooKey :: T.Text }
deriving (Show, Read, Eq, Ord, PersistField)
insert val = do
mUniqVal <- val2uniqkey val
case mUniqVal of
Just uniqVal -> do
let key = (uniqkey2key uniqVal)
execZookeeper $ \zk -> do
let dir = entity2path val
r <- zCreate zk dir (keyToTxt key) (Just (entity2bin val)) []
case r of
Right _ -> return $ Right $ key
Left v -> return $ Left v
Nothing -> do
let dir = entity2path val
str <- execZookeeper $ \zk -> do
zCreate zk dir "" (Just (entity2bin val)) [Z.Sequence]
return $ txtToKey str
insertKey key val = do
_ <- execZookeeper $ \zk -> do
let dir = entity2path val
zCreate zk dir (keyToTxt key) (Just (entity2bin val)) []
return ()
repsert key val = do
_ <- execZookeeper $ \zk -> do
let dir = entity2path val
zRepSert zk dir (keyToTxt key) (Just (entity2bin val))
return ()
replace key val = do
execZookeeper $ \zk -> do
let dir = entity2path val
_ <- zReplace zk dir (keyToTxt key) (Just (entity2bin val))
return $ Right ()
return ()
delete key = do
execZookeeper $ \zk -> do
let dir = key2path key
_ <- zDelete zk dir (keyToTxt key) Nothing
return $ Right ()
return ()
get key = do
r <- execZookeeper $ \zk -> do
let dir = key2path key
val <- zGet zk dir (keyToTxt key)
return $ Right val
case r of
(Left Z.NoNodeError) ->
return Nothing
(Left v) ->
fail $ show v
(Right (Just str,_sta)) -> do
return (bin2entity str)
(Right (Nothing,_stat)) -> do
fail $ "data is nothing"
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'