Fix non-exhaustive patterns in 'unsafeSqlAggregateFunction' (#238)

* Fix non-exhaustive patterns in 'unsafeSqlAggregateFunction' * Update changelog * Abstract 'UnexpectedValueError' in 'valueToRawSqlParens' Co-authored-by: Matt Parsons <[email protected]>
bitemyapp · Feb 21, 2021 · a61f552 · a61f552
1 parent 8fb9a1f
commit a61f552
Show file tree

Hide file tree

Showing 3 changed files with 19 additions and 17 deletions.
diff --git a/changelog.md b/changelog.md
@@ -1,5 +1,8 @@
 3.4.1.0
 =======
+- @arthurxavierx
+  - [#238](https://github.com/bitemyapp/esqueleto/pull/238)
+    - Fix non-exhaustive patterns in `unsafeSqlAggregateFunction`
 - @Vlix
   - [#232](https://github.com/bitemyapp/esqueleto/pull/232)
     - Export the `ValidOnClauseValue` type family

diff --git a/src/Database/Esqueleto/Internal/Internal.hs b/src/Database/Esqueleto/Internal/Internal.hs
@@ -2160,7 +2160,7 @@ unsafeSqlCase when v = ERaw Never buildCase
   where
     buildCase :: IdentInfo -> (TLB.Builder, [PersistValue])
     buildCase info =
-        let (elseText, elseVals) = valueToSql v info
+        let (elseText, elseVals) = valueToRawSqlParens SqlCaseError v info
             (whenText, whenVals) = mapWhen when info
         in ( "CASE" <> whenText <> " ELSE " <> elseText <> " END", whenVals <> elseVals)
 
@@ -2172,15 +2172,20 @@ unsafeSqlCase when v = ERaw Never buildCase
     foldHelp _ _ (ECompositeKey _, _) = throw (CompositeKeyErr FoldHelpError)
     foldHelp _ _ (_, ECompositeKey _) = throw (CompositeKeyErr FoldHelpError)
     foldHelp info (b0, vals0) (v1, v2) =
-        let (b1, vals1) = valueToSql v1 info
-            (b2, vals2) = valueToSql v2 info
+        let (b1, vals1) = valueToRawSqlParens SqlCaseError v1 info
+            (b2, vals2) = valueToRawSqlParens SqlCaseError v2 info
         in ( b0 <> " WHEN " <> b1 <> " THEN " <> b2, vals0 <> vals1 <> vals2 )
 
-    valueToSql :: SqlExpr (Value a) -> IdentInfo -> (TLB.Builder, [PersistValue])
-    valueToSql (ERaw p f) = (first (parensM p)) . f
-    valueToSql (ECompositeKey _) = throw (CompositeKeyErr SqlCaseError)
-    valueToSql (EAliasedValue i _) = aliasedValueIdentToRawSql i
-    valueToSql (EValueReference i i') = valueReferenceToRawSql i i'
+-- | (Internal) Convert a value to a raw SQL builder, preserving parens around
+-- 'ERaw' SQL expressions. This is useful for turning values into function or
+-- operator arguments.
+--
+-- Since: 3.4.0.2
+valueToRawSqlParens :: UnexpectedValueError -> SqlExpr (Value a) -> IdentInfo -> (TLB.Builder, [PersistValue])
+valueToRawSqlParens _ (ERaw p f) = (first (parensM p)) . f
+valueToRawSqlParens e (ECompositeKey _) = throw (CompositeKeyErr e)
+valueToRawSqlParens _ (EAliasedValue i _) = aliasedValueIdentToRawSql i
+valueToRawSqlParens _ (EValueReference i i') = valueReferenceToRawSql i i'
 
 -- | (Internal) Create a custom binary operator.  You /should/
 -- /not/ use this function directly since its type is very
@@ -2323,14 +2328,8 @@ unsafeSqlFunctionParens
     => TLB.Builder -> a -> SqlExpr (Value b)
 unsafeSqlFunctionParens name arg =
     ERaw Never $ \info ->
-        let valueToFunctionArgParens v =
-                case v of
-                    ERaw p f             -> first (parensM p) (f info)
-                    EAliasedValue i _    -> aliasedValueIdentToRawSql i info
-                    EValueReference i i' -> valueReferenceToRawSql i i' info
-                    ECompositeKey _      -> throw (CompositeKeyErr SqlFunctionError)
-            (argsTLB, argsVals) =
-                uncommas' $ map valueToFunctionArgParens $ toArgList arg
+        let (argsTLB, argsVals) =
+                uncommas' $ map (\v -> valueToRawSqlParens SqlFunctionError v info) $ toArgList arg
         in
             (name <> parens argsTLB, argsVals)
 

diff --git a/src/Database/Esqueleto/PostgreSQL.hs b/src/Database/Esqueleto/PostgreSQL.hs
@@ -91,7 +91,7 @@ unsafeSqlAggregateFunction name mode args orderByClauses = ERaw Never $ \info ->
                 [] -> ""
                 (_:_) -> " "
         (argsTLB, argsVals) =
-            uncommas' $ map (\(ERaw _ f) -> f info) $ toArgList args
+            uncommas' $ map (\v -> valueToRawSqlParens SqlFunctionError v info) $ toArgList args
         aggMode =
             case mode of
                 AggModeAll -> ""