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

Fix Postgres aggregate function types (#68)

Browse Source 
Aggregate functions like array_agg and string_agg will return NULL instead of
empty arrays and empty strings resp. when run on zero rows. This change reflects
that in the haskell types. It also adds a "maybeArray" function that
coalesces NULL into an empty array, because currently there is no way to write
an empty array literal (`val []` does not work)
This commit is contained in:
Philipp Balzarek 2018-03-08 15:23:41 +01:00
parent 381e50494a
commit b2c01b1286
2 changed files with 65 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
src/Database/Esqueleto/PostgreSQL.hs
View File

@ -14,6 +14,7 @@ module Database.Esqueleto.PostgreSQL
, arrayRemoveNull
, stringAgg
, stringAggWith
, maybeArray
, chr
, now_
, random_
@ -35,6 +36,17 @@ import Database.Esqueleto.Internal.Sql
random_ :: (PersistField a, Num a) => SqlExpr (Value a)
random_ = unsafeSqlValue "RANDOM()"
-- | Empty array literal. (@val []@) does unfortunately not work
emptyArray :: SqlExpr (Value [a])
emptyArray = unsafeSqlValue "'{}'"
-- | Coalesce an array with an empty default value
maybeArray ::
(PersistField a, PersistField [a])
=> SqlExpr (Value (Maybe [a]))
-> SqlExpr (Value [a])
maybeArray x = coalesceDefault [x] (emptyArray)
-- | Aggregate mode
data AggMode = AggModeAll -- ^ ALL
| AggModeDistinct -- ^ DISTINCT
@ -71,19 +83,25 @@ unsafeSqlAggregateFunction name mode args orderByClauses =
--- | (@array_agg@) Concatenate input values, including @NULL@s,
--- into an array.
arrayAggWith ::
AggMode -> SqlExpr (Value a) -> [OrderByClause] -> SqlExpr (Value [a])
AggMode
-> SqlExpr (Value a)
-> [OrderByClause]
-> SqlExpr (Value (Maybe [a]))
arrayAggWith = unsafeSqlAggregateFunction "array_agg"
--- | (@array_agg@) Concatenate input values, including @NULL@s,
--- into an array.
arrayAgg :: SqlExpr (Value a) -> SqlExpr (Value [a])
arrayAgg :: (PersistField a) => SqlExpr (Value a) -> SqlExpr (Value (Maybe [a]))
arrayAgg x = arrayAggWith AggModeAll x []
-- | (@array_agg@) Concatenate distinct input values, including @NULL@s, into
-- an array.
--
-- /Since: 2.5.3/
arrayAggDistinct :: SqlExpr (Value a) -> SqlExpr (Value [a])
arrayAggDistinct ::
(PersistField a, PersistField [a])
=> SqlExpr (Value a)
-> SqlExpr (Value (Maybe [a]))
arrayAggDistinct x = arrayAggWith AggModeDistinct x []
@ -108,7 +126,7 @@ stringAggWith ::
-> SqlExpr (Value s) -- ^ Input values.
-> SqlExpr (Value s) -- ^ Delimiter.
-> [OrderByClause] -- ^ ORDER BY clauses
-> SqlExpr (Value s) -- ^ Concatenation.
-> SqlExpr (Value (Maybe s)) -- ^ Concatenation.
stringAggWith mode expr delim os =
unsafeSqlAggregateFunction "string_agg" mode (expr, delim) os
@ -120,7 +138,7 @@ stringAgg ::
SqlString s
=> SqlExpr (Value s) -- ^ Input values.
-> SqlExpr (Value s) -- ^ Delimiter.
-> SqlExpr (Value s) -- ^ Concatenation.
-> SqlExpr (Value (Maybe s)) -- ^ Concatenation.
stringAgg expr delim = stringAggWith AggModeAll expr delim []
-- | (@chr@) Translate the given integer to a character. (Note the result will

72
test/PostgreSQL/Test.hs
View File

@ -242,25 +242,6 @@ testSelectDistinctOn = do
testArrayRemoveNull :: SpecWith (Arg (IO ()))
testArrayRemoveNull = do
describe "array_remove (NULL)" $ do
it "removes NULL from arrays from nullable fields" $ run $ do
mapM_ insert [ Person "1" Nothing Nothing 1
, Person "2" (Just 7) Nothing 1
, Person "3" (Nothing) Nothing 1
, Person "4" (Just 8) Nothing 2
, Person "5" (Just 9) Nothing 2
]
ret <- select . from $ \(person :: SqlExpr (Entity Person)) -> do
groupBy (person ^. PersonFavNum)
return . EP.arrayRemoveNull $ EP.arrayAgg (person ^. PersonAge)
liftIO $ (L.sort $ map (L.sort . unValue) ret) `shouldBe` [[7], [8,9]]
testArrayAggWith :: Spec
testArrayAggWith = do
describe "ALL, no ORDER BY" $ do
@ -275,7 +256,7 @@ testArrayAggWith = do
it "works on an example" $ run $ do
let people = [p1, p2, p3, p4, p5]
mapM_ insert people
[Value ret] <-
[Value (Just ret)] <-
select . from $ \p ->
return (EP.arrayAggWith EP.AggModeAll (p ^. PersonName) [])
liftIO $ L.sort ret `shouldBe` L.sort (map personName people)
@ -292,7 +273,7 @@ testArrayAggWith = do
it "works on an example" $ run $ do
let people = [p1, p2, p3, p4, p5]
mapM_ insert people
[Value ret] <-
[Value (Just ret)] <-
select . from $ \p ->
return (EP.arrayAggWith EP.AggModeDistinct (p ^. PersonAge) [])
liftIO $ L.sort ret `shouldBe` [Nothing, Just 17, Just 36]
@ -313,7 +294,7 @@ testArrayAggWith = do
it "works on an example" $ run $ do
let people = [p1, p2, p3, p4, p5]
mapM_ insert people
[Value ret] <-
[Value (Just ret)] <-
select . from $ \p ->
return (EP.arrayAggWith EP.AggModeAll (p ^. PersonName) [])
liftIO $ L.sort ret `shouldBe` L.sort (map personName people)
@ -332,7 +313,7 @@ testArrayAggWith = do
it "works on an example" $ run $ do
let people = [p1, p2, p3, p4, p5]
mapM_ insert people
[Value ret] <-
[Value (Just ret)] <-
select . from $ \p ->
return (EP.arrayAggWith EP.AggModeDistinct (p ^. PersonAge)
[asc $ p ^. PersonAge])
@ -357,7 +338,7 @@ testStringAggWith = do
it "works on an example" $ run $ do
let people = [p1, p2, p3, p4, p5]
mapM_ insert people
[Value ret] <-
[Value (Just ret)] <-
select . from $ \p ->
return (EP.stringAggWith EP.AggModeAll (p ^. PersonName) (val " ")[])
liftIO $ (L.sort $ words ret) `shouldBe` L.sort (map personName people)
@ -366,7 +347,7 @@ testStringAggWith = do
[Value ret] <-
select . from $ \p ->
return (EP.stringAggWith EP.AggModeAll (p ^. PersonName) (val " ")[])
liftIO $ ret `shouldBe` ""
liftIO $ ret `shouldBe` Nothing
describe "DISTINCT, no ORDER BY" $ do
it "creates sane SQL" $ run $ do
@ -381,7 +362,7 @@ testStringAggWith = do
it "works on an example" $ run $ do
let people = [p1, p2, p3 {personName = "John"}, p4, p5]
mapM_ insert people
[Value ret] <-
[Value (Just ret)] <-
select . from $ \p ->
return $ EP.stringAggWith EP.AggModeDistinct (p ^. PersonName) (val " ")
[]
@ -404,7 +385,7 @@ testStringAggWith = do
it "works on an example" $ run $ do
let people = [p1, p2, p3, p4, p5]
mapM_ insert people
[Value ret] <-
[Value (Just ret)] <-
select . from $ \p ->
return $ EP.stringAggWith EP.AggModeAll (p ^. PersonName) (val " ")
[desc $ p ^. PersonName]
@ -425,7 +406,7 @@ testStringAggWith = do
it "works on an example" $ run $ do
let people = [p1, p2, p3 {personName = "John"}, p4, p5]
mapM_ insert people
[Value ret] <-
[Value (Just ret)] <-
select . from $ \p ->
return $ EP.stringAggWith EP.AggModeDistinct (p ^. PersonName) (val " ")
[desc $ p ^. PersonName]
@ -442,22 +423,53 @@ testAggregateFunctions = do
it "looks sane" $ run $ do
let people = [p1, p2, p3, p4, p5]
mapM_ insert people
[Value ret] <-
[Value (Just ret)] <-
select . from $ \p -> return (EP.arrayAgg (p ^. PersonName))
liftIO $ L.sort ret `shouldBe` L.sort (map personName people)
it "works on zero rows" $ run $ do
[Value ret] <-
select . from $ \p -> return (EP.arrayAgg (p ^. PersonName))
liftIO $ ret `shouldBe` Nothing
describe "arrayAggWith" testArrayAggWith
describe "stringAgg" $ do
it "looks sane" $
run $ do
let people = [p1, p2, p3, p4, p5]
mapM_ insert people
[Value ret] <-
[Value (Just ret)] <-
select $
from $ \p -> do
return (EP.stringAgg (p ^. PersonName) (val " "))
liftIO $ L.sort (words ret) `shouldBe` L.sort (map personName people)
it "works on zero rows" $ run $ do
[Value ret] <-
select . from $ \p -> return (EP.stringAgg (p ^. PersonName) (val " "))
liftIO $ ret `shouldBe` Nothing
describe "stringAggWith" testStringAggWith
describe "array_remove (NULL)" $ do
it "removes NULL from arrays from nullable fields" $ run $ do
mapM_ insert [ Person "1" Nothing Nothing 1
, Person "2" (Just 7) Nothing 1
, Person "3" (Nothing) Nothing 1
, Person "4" (Just 8) Nothing 2
, Person "5" (Just 9) Nothing 2
]
ret <- select . from $ \(person :: SqlExpr (Entity Person)) -> do
groupBy (person ^. PersonFavNum)
return . EP.arrayRemoveNull . EP.maybeArray . EP.arrayAgg
$ person ^. PersonAge
liftIO $ (L.sort $ map (L.sort . unValue) ret)
`shouldBe` [[7], [8,9]]
describe "maybeArray" $ do
it "Coalesces NULL into an empty array" $ run $ do
[Value ret] <-
select . from $ \p ->
return (EP.maybeArray $ EP.arrayAgg (p ^. PersonName))
liftIO $ ret `shouldBe` []