persistent 0.4.1 → 0.4.2

raw patch · 4 files changed

+46/−17 lines, 4 files

Files

• Database/Persist/GenericSql.hs +1/−0
• Database/Persist/TH.hs +26/−9
• persistent.cabal +2/−2
• runtests.hs +17/−6

@@ -347,6 +347,7 @@ getFieldName t s = rawFieldName $ tableColumn t s  tableColumn :: EntityDef -> String -> (String, String, [String])+tableColumn _ "id" = ("id", "Int64", []) tableColumn t s = go $ entityColumns t   where     go [] = error $ "Unknown table column: " ++ s

@@ -56,9 +56,11 @@ filterTypeDec :: EntityDef -> Dec filterTypeDec t =     DataInstD [] ''Filter [ConT $ mkName $ entityName t]-            (map (mkFilter $ entityName t) filts)+            (NormalC (mkName $ entityName t ++ "IdIn") [(NotStrict, listOfIds)]+            : map (mkFilter $ entityName t) filts)             (if null filts then [] else [''Show, ''Read, ''Eq])   where+    listOfIds = ListT `AppT` (ConT ''Key `AppT` ConT (mkName $ entityName t))     filts = entityFilters t  entityFilters :: EntityDef -> [(String, String, Bool, PersistFilter)]@@ -229,14 +231,21 @@     go (constr, val) =         Clause [RecP (mkName constr) []] (NormalB val) [] -mkToFilter :: [(String, PersistFilter, Bool)] -> Q [Dec]-mkToFilter pairs = do+mkToFilter :: EntityDef -> [(String, PersistFilter, Bool)] -> Q [Dec]+mkToFilter e pairs = do     c1 <- mapM go pairs+    idIn' <- idIn     let _FIXMEc2 = concatMap go' pairs     return-        [ FunD (mkName "persistFilterToFilter") $ degen c1+        [ FunD (mkName "persistFilterToFilter") $ idIn' : c1         ]   where+    idIn = do+        in_ <- [|In|]+        return $ Clause+            [RecP (mkName $ entityName e ++ "IdIn") []]+            (NormalB in_)+            []     go (constr, pf, _) = do         pf' <- lift pf         return $ Clause [RecP (mkName constr) []] (NormalB pf') []@@ -259,13 +268,20 @@                    (NormalB $ VarE (mkName "toPersistValue") `AppE` VarE x)                    [] -mkToFiltValue :: String -> [(String, Bool)] -> Q Dec-mkToFiltValue func pairs = do+mkToFiltValue :: EntityDef -> String -> [(String, Bool)] -> Q Dec+mkToFiltValue e func pairs = do     left <- [|Left . toPersistValue|]     right <- [|Right . map toPersistValue|]     clauses <- mapM (go left right) pairs-    return . FunD (mkName func) . degen $ clauses+    inId' <- inId right+    return $ FunD (mkName func) $ (inId' : clauses)   where+    inId right = do+        x <- newName "x"+        return $ Clause+            [ConP (mkName $ entityName e ++ "IdIn") [VarP x]]+            (NormalB $ right `AppE` VarE x)+            []     go left right (constr, isList) = do         x <- newName "x"         return@@ -316,11 +332,11 @@     entityOrders' <- entityOrders t     otd <- orderTypeDec t     puk <- mkUniqueKeys t-    tf <- mkToFilter+    tf <- mkToFilter t                 (map (\(x, _, z, y) ->                     (name ++ upperFirst x ++ show y, y, z))                 $ entityFilters t)-    ftv <- mkToFiltValue "persistFilterToValue"+    ftv <- mkToFiltValue t "persistFilterToValue"                 $ map (\(x, _, _, y) ->                     (name ++ upperFirst x ++ show y, isFilterList y))                 $ entityFilters t@@ -358,6 +374,7 @@                 $ entityUpdates t         , putu         , mkToFieldName "persistFilterToFieldName"+                $ (:) (entityName t ++ "IdIn", "id")                 $ map (\(x, _, _, y) -> (name ++ upperFirst x ++ show y, x))                 $ entityFilters t         , ftv

@@ -1,5 +1,5 @@ name:            persistent-version:         0.4.1+version:         0.4.2 license:         BSD3 license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>@@ -10,7 +10,7 @@ stability:       Stable cabal-version:   >= 1.6 build-type:      Simple-homepage:        http://docs.yesodweb.com/persistent/+homepage:        http://docs.yesodweb.com/book/persistent  library     build-depends:   base                     >= 4         && < 5

@@ -48,8 +48,8 @@ share2 mkPersist (mkMigrate "testMigrate") [$persist|
 
   Person
-    name String update Eq Ne Desc
-    age Int update "Asc" Desc Lt "some ignored -- attribute" Eq Add
+    name String Update Eq Ne Desc
+    age Int Update "Asc" Desc Lt "some ignored -- attribute" Eq Add
     color String Maybe Eq Ne -- this is a comment sql=foobarbaz
     PersonNameKey name -- this is a comment sql=foobarbaz
   Pet
@@ -95,9 +95,8 @@   defaultMain [testSuite]
 
 testSuite :: Test
-testSuite = testGroup "Database.Persistent"
-    [
-      testCase "sqlite persistent" case_sqlitePersistent
+testSuite = testGroup "Database.Persistent" $ reverse
+    [ testCase "sqlite persistent" case_sqlitePersistent
     , testCase "sqlite deleteWhere" case_sqliteDeleteWhere
     , testCase "sqlite deleteBy" case_sqliteDeleteBy
     , testCase "sqlite delete" case_sqliteDelete
@@ -110,6 +109,7 @@     , testCase "insertBy" case_insertBy
     , testCase "derivePersistField" case_derivePersistField
     , testCase "afterException" case_afterException
+    , testCase "idIn" case_idIn
     ]
 
                           
@@ -128,7 +128,8 @@ case_largeNumbers = sqliteTest _largeNumbers
 case_insertBy = sqliteTest _insertBy
 case_derivePersistField = sqliteTest _derivePersistField
-case_afterException = sqliteTest _afterException
+case_afterException = (withSqlitePool "testdb" 1) $ runSqlPool _afterException
+case_idIn = sqliteTest _idIn
 
 _deleteWhere = do
   key2 <- insert $ Person "Michael2" 90 Nothing
@@ -343,3 +344,13 @@   where
     catcher :: Monad m => SomeException -> m ()
     catcher _ = return ()
+
+_idIn = do
+    let p1 = Person "A" 0 Nothing
+        p2 = Person "B" 1 Nothing
+        p3 = Person "C" 2 Nothing
+    pid1 <- insert p1
+    _pid2 <- insert p2
+    pid3 <- insert p3
+    x <- selectList [PersonIdIn [pid1, pid3]] [] 0 0
+    liftIO $ x @?= [(pid1, p1), (pid3, p3)]