persistent-zookeeper 0.0.2 → 0.0.3

raw patch · 5 files changed

+285/−5 lines, 5 filesdep +conduitdep +containersdep +transformers-basePVP ok

version bump matches the API change (PVP)

Dependencies added: conduit, containers, transformers-base

API changes (from Hackage documentation)

Files

• Database/Persist/Zookeeper.hs +2/−0
• Database/Persist/Zookeeper/Internal.hs +3/−1
• Database/Persist/Zookeeper/Query.hs +228/−0
• persistent-zookeeper.cabal +9/−1
• tests/basic-test.hs +43/−3

@@ -2,10 +2,12 @@     ( module Database.Persist.Zookeeper.Config     , module Database.Persist.Zookeeper.Store     , module Database.Persist.Zookeeper.Unique+    , module Database.Persist.Zookeeper.Query     , module Database.Persist.Zookeeper.PathPiece     ) where  import Database.Persist.Zookeeper.Config import Database.Persist.Zookeeper.Store import Database.Persist.Zookeeper.Unique()+import Database.Persist.Zookeeper.Query import Database.Persist.Zookeeper.PathPiece()

@@ -24,6 +24,9 @@ dummyFromKey :: Key v -> Maybe v dummyFromKey _ = Nothing +dummyFromFList :: [Filter v] -> v+dummyFromFList _ = error "huga"+ dummyFromUnique :: Unique v -> Maybe v dummyFromUnique _ = Nothing @@ -43,7 +46,6 @@  entity2bin :: (PersistEntity val) => val -> B.ByteString entity2bin val = BL.toStrict (A.encode (map toPersistValue (toPersistFields val)))-  kv2v :: [PersistValue] -> [PersistValue] kv2v [] = []

@@ -0,0 +1,228 @@+{-# LANGUAGE FlexibleContexts, UndecidableInstances #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Database.Persist.Zookeeper.Query+       where++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 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 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"+++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'+  updateWhere filterList valList = do+    (selectKeys filterList []) $$ loop+    where+      loop = do+        key <- await+        case key of+          Just key' -> do+            lift $ update key' valList+            loop+          Nothing ->+            return ()+  deleteWhere filterList = do+    (str::[String]) <- execZookeeperT $ \zk -> do+      Z.getChildren zk (filter2path filterList) Nothing+    loop str+    where+      loop [] = return ()+      loop (x:xs) = do+        let key = txtToKey $ T.pack $ (filter2path filterList) <> "/" <> x+        va <- get key+        case va of+          Nothing -> return ()+          Just v -> do+            let (chk,_,_) = filterClause v filterList +            if chk+              then delete key+              else return ()+        loop xs+  selectSource filterList [] = do+    (str::[String]) <- lift $ execZookeeperT $ \zk -> do+      Z.getChildren zk (filter2path filterList) Nothing+    loop str+    where+      loop [] = return ()+      loop (x:xs) = do+        let key = txtToKey $ T.pack $ (filter2path filterList) <> "/" <> x+        va <- get key+        case va of+          Nothing -> return ()+          Just v -> do+            let (chk,_,_) = filterClause v filterList +            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 -> +      Z.getChildren zk (filter2path filterList) Nothing+    loop str+    where+      loop [] = return ()+      loop (x:xs) = do+        let key = txtToKey $ T.pack $ (filter2path filterList) <> "/" <> x+        va <- get key+        case va of+          Nothing -> return ()+          Just v -> do+            let (chk,_,_) = filterClause v filterList +            if chk+              then yield key+              else return ()+        loop xs+  selectKeys  _ _ = error "not supported selectOpt"+  count filterList = do+    v <- selectList filterList []+    return $ length v++  +dummyFromFilts :: [Filter v] -> Maybe v+dummyFromFilts _ = Nothing++data OrNull = OrNullYes | OrNullNo+++filterClauseHelper :: PersistEntity val+             => Bool -- ^ include WHERE?+             -> OrNull+             -> val+             -> [Filter val]+             -> (Bool, T.Text, [PersistValue])+filterClauseHelper includeWhere orNull val filters =+    (bool, if not (T.null sql) && includeWhere+            then " WHERE " <> sql+            else sql, vals)+  where+    (bool, sql, vals) = combineAND filters+    combineAND = combine " AND " (&&)+    combineOR = combine " OR " (||)++    combine s op fs =+        (foldr1 op c ,T.intercalate s $ map wrapP a, mconcat b)+      where+        (c, a, b) = unzip3 $ map go fs+        wrapP x = T.concat ["(", x, ")"]+    go (BackendFilter _) = error "BackendFilter not expected"+    go (FilterAnd []) = (True,"1=1", [])+    go (FilterAnd fs) = combineAND fs+    go (FilterOr []) = (True,"1=0", [])+    go (FilterOr fs)  = combineOR fs+    go (Filter field value pfilter) = +      (showSqlFilter' pfilter (fieldval field val) allVals, +      name <> ":"+      <> T.pack (show (fieldval field val)) <> ":" +      <> showSqlFilter pfilter+      <> T.pack (show (showSqlFilter' pfilter (fieldval field val) allVals))+      <> "?5:" <> T.pack (show allVals) <> orNullSuffix, allVals) +      where+        +        filterValueToPersistValues :: forall a.  PersistField a => Either a [a] -> [PersistValue]+        filterValueToPersistValues v = map toPersistValue $ either return id v++        orNullSuffix =+            case orNull of+                OrNullYes -> mconcat [" OR ", name, " IS NULL"]+                OrNullNo -> ""++        allVals = filterValueToPersistValues value+        name = unDBName $ fieldDB $ persistFieldDef field+        showSqlFilter Eq = "="+        showSqlFilter Ne = "<>"+        showSqlFilter Gt = ">"+        showSqlFilter Lt = "<"+        showSqlFilter Ge = ">="+        showSqlFilter Le = "<="+        showSqlFilter In = " IN "+        showSqlFilter NotIn = " NOT IN "+        showSqlFilter (BackendSpecificFilter s) = s+        showSqlFilter' :: PersistFilter -> PersistValue -> [PersistValue] -> Bool+        showSqlFilter' Eq a b = (==) a (head b)+        showSqlFilter' Ne a b = (/=) a (head b)+        showSqlFilter' Gt a b = (>)  a (head b)+        showSqlFilter' Lt a b = (<)  a (head b)+        showSqlFilter' Ge a b = (>=) a (head b)+        showSqlFilter' Le a b = (<=) a (head b)+        showSqlFilter' In _ [] = False+        showSqlFilter' In a (x:xs) = if a==x then True else showSqlFilter' In a xs+        showSqlFilter' NotIn _ [] = True+        showSqlFilter' NotIn a (x:xs) = if a==x then False else showSqlFilter' NotIn a xs+        showSqlFilter' (BackendSpecificFilter _s) _ _ =  error "not supported"+++filterClause :: PersistEntity val+             => val+             -> [Filter val]+             -> (Bool, T.Text, [PersistValue])+filterClause val = filterClauseHelper True OrNullNo val

@@ -1,5 +1,5 @@ name:            persistent-zookeeper-version:         0.0.2+version:         0.0.3 license:         BSD3 license-file:    LICENSE author:          Junji Hashimoto <junji.hashimoto@gree.net>@@ -25,6 +25,7 @@                    , attoparsec                    , mtl                    , transformers+                   , transformers-base                    , monad-control                    , utf8-string           >= 0.3.7    && < 0.4.0                    , binary                >= 0.7      && < 0.8@@ -35,6 +36,8 @@                    , template-haskell                    , base64-bytestring                    , stm+                   , conduit+                   , containers      exposed-modules: Database.Persist.Zookeeper @@ -42,6 +45,7 @@                      Database.Persist.Zookeeper.Internal                      Database.Persist.Zookeeper.Store                      Database.Persist.Zookeeper.Unique+                     Database.Persist.Zookeeper.Query                      Database.Persist.Zookeeper.PathPiece                      Database.Persist.Zookeeper.ZooUtil @@ -55,6 +59,7 @@                    , persistent-template   >= 1.3      && < 1.4                    , mtl                    , transformers+                   , transformers-base                    , utf8-string           >= 0.3.7    && < 0.4.0                    , bytestring            >= 0.10.0.0 && < 0.11.0.0                    , text                  >= 0.8@@ -73,5 +78,8 @@                    , base64-bytestring                    , hspec                    , stm+                   , conduit+                   , containers +--    ghc-options:     -Wall -ddump-splices     ghc-options:     -Wall

@@ -14,6 +14,7 @@ Person     name String     age Int+    hoge Int Maybe     PersonU name     deriving Show     deriving Eq@@ -27,7 +28,7 @@   withZookeeperConn zookeeperConf $ \conn -> do     hspec $ do       let key = (Key (PersistText "/person/WyJzVGVzdC9ob2dlIl0="))-      let val = Person "Test/hoge" 12+      let val = Person "Test/hoge" 12 Nothing       describe "PersistUnique test" $ do         it "insertUnique" $ do           v <- flip runZookeeperPool conn $ do@@ -57,5 +58,44 @@             delete key'             get key'           v' `shouldBe` Nothing-      -      +      describe "PersistQeuery test" $ do+        let check val' filter' expbool = case filterClause val' filter' of+                                           a@(bool,_,_) -> do+                                           print $ show a+                                           bool `shouldBe` expbool+        it "FilterTestEq" $ do+          check (Person "Test/hoge" 12 Nothing) [PersonName ==. ""] False+          check (Person "Test/hoge" 12 (Just 3)) [PersonHoge ==. Just 3] True+          check (Person "Test/hoge" 12 Nothing) [PersonAge ==. 12]  True+        it "FilterTestNe" $ do+          check (Person "Test/hoge" 12 Nothing) [PersonAge !=. 12] False+          check (Person "Test/hoge" 12 Nothing) [PersonAge !=. 11] True+          check (Person "Test/hoge" 12 (Just 4)) [PersonHoge !=. Just 4] False+          check (Person "Test/hoge" 12 Nothing) [PersonHoge !=. Just 3] True+          check (Person "Test/hoge" 12 (Just 4)) [PersonHoge !=. Just 3] True+        it "FilterTestLt" $ do+          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+            deleteWhere [PersonName !=. ""]+            _ <- insert (Person "hoge0" 1 Nothing)+            _ <- insert (Person "hoge1" 2 Nothing)+            _ <- insert (Person "hoge2" 3 Nothing)+            _ <- insert (Person "hoge3" 4 Nothing)+            selectList [PersonAge ==. 2] []+          (entityVal (head va)) `shouldBe` (Person "hoge1" 2 Nothing)+          [Entity _k v] <- flip runZookeeperPool conn $ do+            selectList [PersonName ==. "hoge2"] []+          v `shouldBe` (Person "hoge2" 3 Nothing)+          [Entity _k v1] <- flip runZookeeperPool conn $ do+            updateWhere [PersonName ==. "hoge2"] [PersonAge =. 10]+            selectList [PersonName ==. "hoge2"] []+          v1 `shouldBe` (Person "hoge2" 10 Nothing)+          v2 <- flip runZookeeperPool conn $ do+            selectList [PersonName !=. ""] []+          length v2 `shouldBe` 4+          v3 <- flip runZookeeperPool conn $ do+            deleteWhere [PersonName !=. ""]+            selectList [PersonName !=. ""] []+          length v3 `shouldBe` 0