diff --git a/Database/Persist/Quasi.hs b/Database/Persist/Quasi.hs --- a/Database/Persist/Quasi.hs +++ b/Database/Persist/Quasi.hs @@ -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] diff --git a/Database/Persist/Query/GenericSql.hs b/Database/Persist/Query/GenericSql.hs --- a/Database/Persist/Query/GenericSql.hs +++ b/Database/Persist/Query/GenericSql.hs @@ -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 diff --git a/Database/Persist/Query/Join/Sql.hs b/Database/Persist/Query/Join/Sql.hs --- a/Database/Persist/Query/Join/Sql.hs +++ b/Database/Persist/Query/Join/Sql.hs @@ -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 diff --git a/persistent.cabal b/persistent.cabal --- a/persistent.cabal +++ b/persistent.cabal @@ -1,5 +1,5 @@ name: persistent -version: 0.9.0.1 +version: 0.9.0.2 license: MIT license-file: LICENSE author: Michael Snoyman @@ -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 diff --git a/test/main.hs b/test/main.hs new file mode 100644 --- /dev/null +++ b/test/main.hs @@ -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"