haskell/esqueleto
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge pull request #71 from mitchellwrosen/coalesce

Browse Source 
added coalesce/coalesceDefault functions
This commit is contained in:
Felipe Lessa 2014-07-12 00:26:09 -03:00
commit dc285e41ad
4 changed files with 75 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
src/Database/Esqueleto.hs
View File

@ -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

12
src/Database/Esqueleto/Internal/Language.hs
View File

@ -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 (Maybe a))] -> expr (Value 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

3
src/Database/Esqueleto/Internal/Sql.hs
View File

@ -373,6 +373,9 @@ instance Esqueleto SqlQuery SqlExpr SqlBackend where
min_ = unsafeSqlFunction "MIN"
max_ = unsafeSqlFunction "MAX"
coalesce = unsafeSqlFunction "COALESCE"
coalesceDefault exprs = unsafeSqlFunction "COALESCE" . (exprs ++) . return . just
like = unsafeSqlBinOp " LIKE "
(%) = unsafeSqlValue "'%'"
concat_ = unsafeSqlFunction "CONCAT"

73
test/Test.hs
View File

@ -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 ^. PersonAge, p ^. PersonWeight] (p ^. PersonFavNum))
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)