From b2c01b1286f90b4491df20a84a662daafa5d2cad Mon Sep 17 00:00:00 2001 From: Philipp Balzarek Date: Thu, 8 Mar 2018 15:23:41 +0100 Subject: [PATCH] Fix Postgres aggregate function types (#68) 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) --- src/Database/Esqueleto/PostgreSQL.hs | 28 +++++++++-- test/PostgreSQL/Test.hs | 72 ++++++++++++++++------------ 2 files changed, 65 insertions(+), 35 deletions(-) diff --git a/src/Database/Esqueleto/PostgreSQL.hs b/src/Database/Esqueleto/PostgreSQL.hs index 67d28da..1b17ac9 100644 --- a/src/Database/Esqueleto/PostgreSQL.hs +++ b/src/Database/Esqueleto/PostgreSQL.hs @@ -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 diff --git a/test/PostgreSQL/Test.hs b/test/PostgreSQL/Test.hs index 294a3ac..2f909f9 100644 --- a/test/PostgreSQL/Test.hs +++ b/test/PostgreSQL/Test.hs @@ -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` [] +