From e735378f90f500fe887318dc41270cd03332965d Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Fri, 11 Jul 2014 16:03:04 -0700 Subject: [PATCH 1/2] added coalesce/coalesceDefault functions --- src/Database/Esqueleto.hs | 1 + src/Database/Esqueleto/Internal/Language.hs | 12 ++++ src/Database/Esqueleto/Internal/Sql.hs | 3 + test/Test.hs | 73 +++++++++++++++++---- 4 files changed, 75 insertions(+), 14 deletions(-) diff --git a/src/Database/Esqueleto.hs b/src/Database/Esqueleto.hs index 0a10a9b..113a67a 100644 --- a/src/Database/Esqueleto.hs +++ b/src/Database/Esqueleto.hs @@ -45,6 +45,7 @@ module Database.Esqueleto , (+.), (-.), (/.), (*.) , random_, round_, ceiling_, floor_ , min_, max_, sum_, avg_ + , coalesce, coalesceDefault , like, (%), concat_, (++.) , subList_select, subList_selectDistinct, valList , in_, notIn, exists, notExists diff --git a/src/Database/Esqueleto/Internal/Language.hs b/src/Database/Esqueleto/Internal/Language.hs index b71f066..bbf0e50 100644 --- a/src/Database/Esqueleto/Internal/Language.hs +++ b/src/Database/Esqueleto/Internal/Language.hs @@ -253,6 +253,18 @@ class (Functor query, Applicative query, Monad query) => max_ :: (PersistField a) => expr (Value a) -> expr (Value (Maybe a)) avg_ :: (PersistField a, PersistField b) => expr (Value a) -> expr (Value (Maybe b)) + -- | @COALESCE@ function. Evaluates the arguments in order and + -- returns the value of the first non-NULL expression, or NULL + -- (Nothing) otherwise. Some RDBMSs (such as SQLite) require + -- at least two arguments; please refer to the appropriate + -- documentation. + coalesce :: PersistField a => [expr (Value (Maybe a))] -> expr (Value (Maybe a)) + + -- | Like @coalesce@, but takes a non-nullable expression + -- placed at the end of the expression list, which guarantees + -- a non-NULL result. + coalesceDefault :: PersistField a => expr (Value a) -> [expr (Value (Maybe a))] -> expr (Value a) + -- | @LIKE@ operator. like :: (PersistField s, IsString s) => expr (Value s) -> expr (Value s) -> expr (Value Bool) -- | The string @'%'@. May be useful while using 'like' and diff --git a/src/Database/Esqueleto/Internal/Sql.hs b/src/Database/Esqueleto/Internal/Sql.hs index 04f3e90..e991f10 100644 --- a/src/Database/Esqueleto/Internal/Sql.hs +++ b/src/Database/Esqueleto/Internal/Sql.hs @@ -373,6 +373,9 @@ instance Esqueleto SqlQuery SqlExpr SqlBackend where min_ = unsafeSqlFunction "MIN" max_ = unsafeSqlFunction "MAX" + coalesce = unsafeSqlFunction "COALESCE" + coalesceDefault def_expr exprs = unsafeSqlFunction "COALESCE" (exprs ++ [just def_expr]) + like = unsafeSqlBinOp " LIKE " (%) = unsafeSqlValue "'%'" concat_ = unsafeSqlFunction "CONCAT" diff --git a/test/Test.hs b/test/Test.hs index dc16400..eaade67 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -15,6 +15,7 @@ module Main (main) where import Control.Applicative ((<$>)) +import Control.Exception (IOException) import Control.Monad (replicateM, replicateM_) import Control.Monad.IO.Class (MonadIO(liftIO)) import Control.Monad.Logger (MonadLogger(..), runStderrLoggingT, runNoLoggingT) @@ -45,6 +46,8 @@ share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistUpperCase| Person name String age Int Maybe + weight Int Maybe + favNum Int deriving Eq Show BlogPost title String @@ -63,10 +66,11 @@ sameElementsAs l1 l2 = null (l1 L.\\ l2) main :: IO () main = do - let p1 = Person "John" (Just 36) - p2 = Person "Rachel" Nothing - p3 = Person "Mike" (Just 17) - p4 = Person "Livia" (Just 17) + let p1 = Person "John" (Just 36) Nothing 1 + p2 = Person "Rachel" Nothing (Just 37) 2 + p3 = Person "Mike" (Just 17) Nothing 3 + p4 = Person "Livia" (Just 17) (Just 18) 4 + p5 = Person "Mitch" Nothing Nothing 5 hspec $ do describe "select" $ do it "works for a single value" $ @@ -560,6 +564,47 @@ main = do return title liftIO $ ret `shouldBe` [ Value t1, Value t2, Value t3 ] + describe "coalesce/coalesceDefault" $ do + it "works on a simple example" $ + run $ do + mapM_ insert' [p1, p2, p3, p4, p5] + ret1 <- select $ + from $ \p -> do + orderBy [asc (p ^. PersonId)] + return (coalesce [p ^. PersonAge, p ^. PersonWeight]) + liftIO $ ret1 `shouldBe` [ Value (Just (36 :: Int)) + , Value (Just 37) + , Value (Just 17) + , Value (Just 17) + , Value Nothing + ] + + ret2 <- select $ + from $ \p -> do + orderBy [asc (p ^. PersonId)] + return (coalesceDefault (p ^. PersonFavNum) [p ^. PersonAge, p ^. PersonWeight]) + liftIO $ ret2 `shouldBe` [ Value (36 :: Int) + , Value 37 + , Value 17 + , Value 17 + , Value 5 + ] + +#if defined(WITH_POSTGRESQL) || defined(WITH_MYSQL) + it "works on PostgreSQL and MySQL with <2 arguments" $ + run $ do + _ :: [Value (Maybe Int)] <- select $ + from $ \p -> do + return (coalesce [p ^. PersonAge]) + return True +#else + it "throws an exception on SQLite with <2 arguments" $ + run (select $ + from $ \p -> do + return (coalesce [p ^. PersonAge]) :: SqlQuery (SqlExpr (Value (Maybe Int))) + ) `shouldThrow` (\(_ :: IOException) -> True) +#endif + describe "text functions" $ it "like, (%) and (++.) work on a simple example" $ run $ do @@ -620,21 +665,21 @@ main = do -- matched rows, not actually changed rows. #if defined(WITH_POSTGRESQL) liftIO $ n `shouldBe` 2 - liftIO $ ret `shouldBe` [ Entity p1k (Person anon (Just 73)) - , Entity p2k (Person anon Nothing) + liftIO $ ret `shouldBe` [ Entity p1k (Person anon (Just 73) Nothing 1) + , Entity p2k (Person anon Nothing (Just 37) 2) , Entity p3k p3 ] -- MySQL: nulls appear first, and update returns actual number -- of changed rows #elif defined(WITH_MYSQL) liftIO $ n `shouldBe` 1 - liftIO $ ret `shouldBe` [ Entity p2k (Person anon Nothing) - , Entity p1k (Person anon (Just 73)) + liftIO $ ret `shouldBe` [ Entity p2k (Person anon Nothing (Just 37) 2) + , Entity p1k (Person anon (Just 73) Nothing 1) , Entity p3k p3 ] #else -- SQLite: nulls appear first, update returns matched rows. liftIO $ n `shouldBe` 2 - liftIO $ ret `shouldBe` [ Entity p2k (Person anon Nothing) - , Entity p1k (Person anon (Just 73)) + liftIO $ ret `shouldBe` [ Entity p2k (Person anon Nothing (Just 37) 2) + , Entity p1k (Person anon (Just 73) Nothing 1) , Entity p3k p3 ] #endif @@ -803,10 +848,10 @@ main = do _ <- insert p2 _ <- insert p3 _ <- insert p4 - _ <- insert $ Person "Jane" Nothing - _ <- insert $ Person "Mark" Nothing - _ <- insert $ Person "Sarah" Nothing - insert $ Person "Paul" Nothing + _ <- insert $ Person "Jane" Nothing Nothing 0 + _ <- insert $ Person "Mark" Nothing Nothing 0 + _ <- insert $ Person "Sarah" Nothing Nothing 0 + insert $ Person "Paul" Nothing Nothing 0 ret1 <- fmap (map unValue) $ select $ from $ \p -> do orderBy [rand] return (p ^. PersonId) From 22f03c2e39e667a5fe8e324cf92e6864160ba474 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Fri, 11 Jul 2014 19:51:01 -0700 Subject: [PATCH 2/2] change coalesceDefault argument order --- src/Database/Esqueleto/Internal/Language.hs | 2 +- src/Database/Esqueleto/Internal/Sql.hs | 4 ++-- test/Test.hs | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Database/Esqueleto/Internal/Language.hs b/src/Database/Esqueleto/Internal/Language.hs index bbf0e50..38617f1 100644 --- a/src/Database/Esqueleto/Internal/Language.hs +++ b/src/Database/Esqueleto/Internal/Language.hs @@ -263,7 +263,7 @@ class (Functor query, Applicative query, Monad query) => -- | Like @coalesce@, but takes a non-nullable expression -- placed at the end of the expression list, which guarantees -- a non-NULL result. - coalesceDefault :: PersistField a => expr (Value a) -> [expr (Value (Maybe a))] -> expr (Value a) + coalesceDefault :: PersistField a => [expr (Value (Maybe a))] -> expr (Value a) -> expr (Value a) -- | @LIKE@ operator. like :: (PersistField s, IsString s) => expr (Value s) -> expr (Value s) -> expr (Value Bool) diff --git a/src/Database/Esqueleto/Internal/Sql.hs b/src/Database/Esqueleto/Internal/Sql.hs index e991f10..bb9e97d 100644 --- a/src/Database/Esqueleto/Internal/Sql.hs +++ b/src/Database/Esqueleto/Internal/Sql.hs @@ -373,8 +373,8 @@ instance Esqueleto SqlQuery SqlExpr SqlBackend where min_ = unsafeSqlFunction "MIN" max_ = unsafeSqlFunction "MAX" - coalesce = unsafeSqlFunction "COALESCE" - coalesceDefault def_expr exprs = unsafeSqlFunction "COALESCE" (exprs ++ [just def_expr]) + coalesce = unsafeSqlFunction "COALESCE" + coalesceDefault exprs = unsafeSqlFunction "COALESCE" . (exprs ++) . return . just like = unsafeSqlBinOp " LIKE " (%) = unsafeSqlValue "'%'" diff --git a/test/Test.hs b/test/Test.hs index eaade67..0ed8a23 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -582,7 +582,7 @@ main = do ret2 <- select $ from $ \p -> do orderBy [asc (p ^. PersonId)] - return (coalesceDefault (p ^. PersonFavNum) [p ^. PersonAge, p ^. PersonWeight]) + return (coalesceDefault [p ^. PersonAge, p ^. PersonWeight] (p ^. PersonFavNum)) liftIO $ ret2 `shouldBe` [ Value (36 :: Int) , Value 37 , Value 17