From 7df5fe0eddce0df4309c657d890e2ca6ab1406eb Mon Sep 17 00:00:00 2001
From: Felipe Lessa <felipe.lessa@gmail.com>
Date: Sun, 9 Sep 2012 10:44:55 -0300
Subject: [PATCH] New function unsafeSqlFunction.

---
 src/Database/Esqueleto/Internal/Sql.hs | 36 ++++++++++++++++++++++++++
 1 file changed, 36 insertions(+)

diff --git a/src/Database/Esqueleto/Internal/Sql.hs b/src/Database/Esqueleto/Internal/Sql.hs
index 86c61ea..3c552af 100644
--- a/src/Database/Esqueleto/Internal/Sql.hs
+++ b/src/Database/Esqueleto/Internal/Sql.hs
@@ -24,6 +24,8 @@ module Database.Esqueleto.Internal.Sql
     -- * The guts
   , unsafeSqlBinOp
   , unsafeSqlValue
+  , unsafeSqlFunction
+  , UnsafeSqlFunctionArgument
   , rawSelectSource
   , runSource
   , rawExecute
@@ -353,6 +355,40 @@ unsafeSqlValue v = ERaw Never $ \_ -> (v, mempty)
 {-# INLINE unsafeSqlValue #-}
 
 
+-- | (Internal) A raw SQL function.  Once again, the same warning
+-- from 'unsafeSqlBinOp' applies to this function as well.
+unsafeSqlFunction :: UnsafeSqlFunctionArgument a =>
+                     TLB.Builder -> a -> SqlExpr (Value b)
+unsafeSqlFunction name arg =
+  ERaw Never $ \esc ->
+    let (argsTLB, argsVals) =
+          uncommas' $ map (\(ERaw _ f) -> f esc) $ toArgList arg
+    in (name <> parens argsTLB, argsVals)
+
+class UnsafeSqlFunctionArgument a where
+  toArgList :: a -> [SqlExpr (Value ())]
+instance (a ~ Value b) => UnsafeSqlFunctionArgument (SqlExpr a) where
+  toArgList = (:[]) . veryUnsafeCoerceSqlExprValue
+instance UnsafeSqlFunctionArgument a =>
+         UnsafeSqlFunctionArgument [a] where
+  toArgList = concatMap toArgList
+instance ( UnsafeSqlFunctionArgument a
+         , UnsafeSqlFunctionArgument b
+         ) => UnsafeSqlFunctionArgument (a, b) where
+  toArgList (a, b) = toArgList a ++ toArgList b
+instance ( UnsafeSqlFunctionArgument a
+         , UnsafeSqlFunctionArgument b
+         , UnsafeSqlFunctionArgument c
+         ) => UnsafeSqlFunctionArgument (a, b, c) where
+  toArgList = toArgList . from3
+instance ( UnsafeSqlFunctionArgument a
+         , UnsafeSqlFunctionArgument b
+         , UnsafeSqlFunctionArgument c
+         , UnsafeSqlFunctionArgument d
+         ) => UnsafeSqlFunctionArgument (a, b, c, d) where
+  toArgList = toArgList . from4
+
+
 -- | (Internal) Coerce a type of a 'SqlExpr (Value a)' into
 -- another 'SqlExpr (Value b)'.  You should /not/ use this
 -- function unless you know what you're doing!