persistent 0.9.0.1 → 0.9.0.2
raw patch · 5 files changed
+129/−23 lines, 5 files
Files
- Database/Persist/Quasi.hs +9/−8
- Database/Persist/Query/GenericSql.hs +23/−7
- Database/Persist/Query/Join/Sql.hs +17/−7
- persistent.cabal +3/−1
- test/main.hs +77/−0
Database/Persist/Quasi.hs view
@@ -186,7 +186,7 @@ mkEntityDef ps name entattribs lines = EntityDef (HaskellName name)- (DBName $ psToDBName ps name)+ (DBName $ getDbName ps name entattribs) (DBName $ idName entattribs) entattribs cols uniqs derives extras@@ -222,16 +222,17 @@ Nothing -> error $ "Invalid field type: " ++ show typ Just ft -> Just $ FieldDef (HaskellName n)- (DBName $ db rest)+ (DBName $ getDbName ps n rest) ft rest- where- db [] = psToDBName ps n- db (a:as) =- case T.stripPrefix "sql=" a of- Nothing -> db as- Just s -> s takeCols _ _ = Nothing++getDbName :: PersistSettings -> Text -> [Text] -> Text+getDbName ps n [] = psToDBName ps n+getDbName ps n (a:as) =+ case T.stripPrefix "sql=" a of+ Nothing -> getDbName ps n as+ Just s -> s takeUniqs :: PersistSettings -> [FieldDef]
Database/Persist/Query/GenericSql.hs view
@@ -12,6 +12,7 @@ ( PersistQuery (..) , SqlPersist (..) , filterClauseNoWhere+ , filterClauseNoWhereOrNull , getFiltsValues , selectSourceConn , dummyFromFilts@@ -198,29 +199,39 @@ execute' = R.execute getFiltsValues :: forall val. PersistEntity val => Connection -> [Filter val] -> [PersistValue]-getFiltsValues conn = snd . filterClauseHelper False False conn+getFiltsValues conn = snd . filterClauseHelper False False conn OrNullNo filterClause :: PersistEntity val => Bool -- ^ include table name? -> Connection -> [Filter val] -> Text-filterClause b c = fst . filterClauseHelper b True c+filterClause b c = fst . filterClauseHelper b True c OrNullNo +data OrNull = OrNullYes | OrNullNo+ filterClauseNoWhere :: PersistEntity val => Bool -- ^ include table name? -> Connection -> [Filter val] -> Text-filterClauseNoWhere b c = fst . filterClauseHelper b False c+filterClauseNoWhere b c = fst . filterClauseHelper b False c OrNullNo +filterClauseNoWhereOrNull :: PersistEntity val+ => Bool -- ^ include table name?+ -> Connection+ -> [Filter val]+ -> Text+filterClauseNoWhereOrNull b c = fst . filterClauseHelper b False c OrNullYes+ filterClauseHelper :: PersistEntity val => Bool -- ^ include table name? -> Bool -- ^ include WHERE? -> Connection+ -> OrNull -> [Filter val] -> (Text, [PersistValue])-filterClauseHelper includeTable includeWhere conn filters =+filterClauseHelper includeTable includeWhere conn orNull filters = (if not (T.null sql) && includeWhere then " WHERE " ++ sql else sql, vals)@@ -253,8 +264,8 @@ ], notNullVals) -- We use 1=2 (and below 1=1) to avoid using TRUE and FALSE, since -- not all databases support those words directly.- (_, In, 0) -> ("1=2", [])- (False, In, _) -> (name ++ " IN " ++ qmarks, allVals)+ (_, In, 0) -> ("1=2" ++ orNullSuffix, [])+ (False, In, _) -> (name ++ " IN " ++ qmarks ++ orNullSuffix, allVals) (True, In, _) -> (T.concat [ "(" , name@@ -283,10 +294,15 @@ , qmarks , ")" ], notNullVals)- _ -> (name ++ showSqlFilter pfilter ++ "?", allVals)+ _ -> (name ++ showSqlFilter pfilter ++ "?" ++ 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 -> concat [" OR ", name, " IS NULL"]+ OrNullNo -> "" isNull = any (== PersistNull) allVals notNullVals = filter (/= PersistNull) allVals
Database/Persist/Query/Join/Sql.hs view
@@ -82,25 +82,35 @@ , escapeName conn $ entityDB $ entityDef many , "." , escapeName conn $ filterName $ eq undefined- , filts+ , onFilts+ , whereFilts , case ords of [] -> "" _ -> " ORDER BY " ++ T.intercalate ", " ords ] where filts1 = filterClauseNoWhere True conn oneF- filts2 = filterClauseNoWhere True conn manyF+ filts2 = (if isOuter then filterClauseNoWhereOrNull else filterClauseNoWhere) True conn manyF + whereFilts+ | isOuter =+ if null filts1+ then ""+ else " WHERE " ++ filts1+ | null filts1 && null filts2 = ""+ | null filts1 = " WHERE " ++ filts2+ | null filts2 = " WHERE " ++ filts1+ | otherwise = " WHERE " ++ filts1 ++ " AND " ++ filts2++ onFilts+ | isOuter && not (null filts2) = " AND " ++ filts2+ | otherwise = ""+ orders :: PersistEntity val => [SelectOpt val] -> [SelectOpt val] orders x = let (_, _, y) = limitOffsetOrder x in y - filts- | null filts1 && null filts2 = ""- | null filts1 = " WHERE " ++ filts2- | null filts2 = " WHERE " ++ filts1- | otherwise = " WHERE " ++ filts1 ++ " AND " ++ filts2 ords = map (orderClause True conn) (orders oneO) ++ map (orderClause True conn) (orders manyO) addTable :: PersistEntity val
persistent.cabal view
@@ -1,5 +1,5 @@ name: persistent-version: 0.9.0.1+version: 0.9.0.2 license: MIT license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -11,6 +11,8 @@ cabal-version: >= 1.8 build-type: Simple homepage: http://www.yesodweb.com/book/persistent+extra-source-files:+ test/main.hs flag nooverlap default: False
+ test/main.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE OverloadedStrings #-}+import Test.Hspec.Monadic+import Test.Hspec.HUnit ()+import Test.HUnit++import Database.Persist.Quasi+import Database.Persist.EntityDef++main :: IO ()+main = hspecX $ do+ describe "tokenization" $ do+ it "handles normal words" $+ tokenize " foo bar baz" @?=+ [ Spaces 1+ , Token "foo"+ , Spaces 3+ , Token "bar"+ , Spaces 2+ , Token "baz"+ ]+ it "handles quotes" $+ tokenize " \"foo bar\" \"baz\"" @?=+ [ Spaces 2+ , Token "foo bar"+ , Spaces 2+ , Token "baz"+ ]+ it "handles unnested parantheses" $+ tokenize " (foo bar) (baz)" @?=+ [ Spaces 2+ , Token "foo bar"+ , Spaces 2+ , Token "baz"+ ]+ it "handles nested parantheses" $+ tokenize " (foo (bar)) (baz)" @?=+ [ Spaces 2+ , Token "foo (bar)"+ , Spaces 2+ , Token "baz"+ ]+ it "escaping " $+ tokenize " (foo \\(bar) \"baz\\\"\"" @?=+ [ Spaces 2+ , Token "foo (bar"+ , Spaces 2+ , Token "baz\""+ ]+ describe "parseFieldType" $ do+ it "simple types" $+ parseFieldType "FooBar" @?= Just (FTTypeCon Nothing "FooBar")+ it "module types" $+ parseFieldType "Data.Map.FooBar" @?= Just (FTTypeCon (Just "Data.Map") "FooBar")+ it "application" $+ parseFieldType "Foo Bar" @?= Just (+ FTTypeCon Nothing "Foo" `FTApp` FTTypeCon Nothing "Bar")+ it "application multiple" $+ parseFieldType "Foo Bar Baz" @?= Just (+ (FTTypeCon Nothing "Foo" `FTApp` FTTypeCon Nothing "Bar")+ `FTApp` FTTypeCon Nothing "Baz"+ )+ it "parens" $ do+ let foo = FTTypeCon Nothing "Foo"+ bar = FTTypeCon Nothing "Bar"+ baz = FTTypeCon Nothing "Baz"+ parseFieldType "Foo (Bar Baz)" @?= Just (+ foo `FTApp` (bar `FTApp` baz))+ it "lists" $ do+ let foo = FTTypeCon Nothing "Foo"+ bar = FTTypeCon Nothing "Bar"+ bars = FTList bar+ baz = FTTypeCon Nothing "Baz"+ parseFieldType "Foo [Bar] Baz" @?= Just (+ foo `FTApp` bars `FTApp` baz)+ describe "stripId" $ do+ it "works" $+ (parseFieldType "FooId" >>= stripId) @?= Just "Foo"