From f32c98c4128d5d477a264822f0af2e86af88b931 Mon Sep 17 00:00:00 2001
From: Felipe Lessa <felipe.lessa@gmail.com>
Date: Wed, 15 Jul 2015 14:20:13 -0300
Subject: [PATCH] New functions castNum and castNumM.

---
 src/Database/Esqueleto.hs                   |  4 ++--
 src/Database/Esqueleto/Internal/Language.hs | 23 +++++++++++++++++++++
 src/Database/Esqueleto/Internal/Sql.hs      |  3 +++
 test/Test.hs                                | 18 ++++++++++++++--
 4 files changed, 44 insertions(+), 4 deletions(-)

diff --git a/src/Database/Esqueleto.hs b/src/Database/Esqueleto.hs
index e8fcf18..a5ab442 100644
--- a/src/Database/Esqueleto.hs
+++ b/src/Database/Esqueleto.hs
@@ -45,9 +45,9 @@ module Database.Esqueleto
              , (==.), (>=.), (>.), (<=.), (<.), (!=.), (&&.), (||.)
              , (+.), (-.), (/.), (*.)
              , random_, round_, ceiling_, floor_
-             , min_, max_, sum_, avg_, lower_
+             , min_, max_, sum_, avg_, castNum, castNumM
              , coalesce, coalesceDefault
-             , like, ilike, (%), concat_, (++.)
+             , lower_, like, ilike, (%), concat_, (++.)
              , subList_select, subList_selectDistinct, valList
              , in_, notIn, exists, notExists
              , set, (=.), (+=.), (-=.), (*=.), (/=.)
diff --git a/src/Database/Esqueleto/Internal/Language.hs b/src/Database/Esqueleto/Internal/Language.hs
index 12c3af8..6a13397 100644
--- a/src/Database/Esqueleto/Internal/Language.hs
+++ b/src/Database/Esqueleto/Internal/Language.hs
@@ -351,6 +351,29 @@ 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))
 
+  -- | Allow a number of one type to be used as one of another
+  -- type via an implicit cast.  An explicit cast is not made,
+  -- this function changes only the types on the Haskell side.
+  --
+  -- /Caveat/: Trying to use @castNum@ from @Double@ to @Int@
+  -- will not result in an integer, the original fractional
+  -- number will still be used!  Use 'round_', 'ceiling_' or
+  -- 'floor_' instead.
+  --
+  -- /Safety/: This operation is mostly safe due to the 'Num'
+  -- constraint between the types and the fact that RDBMSs
+  -- usually allow numbers of different types to be used
+  -- interchangeably.  However, there may still be issues with
+  -- the query not being accepted by the RDBMS or @persistent@
+  -- not being able to parse it.
+  --
+  -- /Since: 2.2.9/
+  castNum :: (Num a, Num b) => expr (Value a) -> expr (Value b)
+  -- | Same as 'castNum', but for nullable values.
+  --
+  -- /Since: 2.2.9/
+  castNumM :: (Num a, Num b) => expr (Value (Maybe 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
diff --git a/src/Database/Esqueleto/Internal/Sql.hs b/src/Database/Esqueleto/Internal/Sql.hs
index 3e186cc..cd158dc 100644
--- a/src/Database/Esqueleto/Internal/Sql.hs
+++ b/src/Database/Esqueleto/Internal/Sql.hs
@@ -476,6 +476,9 @@ instance Esqueleto SqlQuery SqlExpr SqlBackend where
   max_     = unsafeSqlFunction "MAX"
   avg_     = unsafeSqlFunction "AVG"
 
+  castNum  = veryUnsafeCoerceSqlExprValue
+  castNumM = veryUnsafeCoerceSqlExprValue
+
   coalesce              = unsafeSqlFunctionParens "COALESCE"
   coalesceDefault exprs = unsafeSqlFunctionParens "COALESCE" . (exprs ++) . return . just
 
diff --git a/test/Test.hs b/test/Test.hs
index 18eb96f..17740cb 100644
--- a/test/Test.hs
+++ b/test/Test.hs
@@ -118,6 +118,9 @@ share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistUpperCase|
     name String
     Foreign Point fkpoint centerX centerY
     deriving Eq Show
+  Numbers
+    int    Int
+    double Double
 |]
 
 -- | this could be achieved with S.fromList, but not all lists
@@ -1205,8 +1208,8 @@ main = do
           ret <- select $ from (\(_::(SqlExpr (Entity BlogPost))) -> return countRows)
           liftIO $ ret `shouldBe` [Value (3::Int)]
 
-    describe "rand works" $ do
-      it "returns result in random order" $
+    describe "Math-related functions" $ do
+      it "rand returns result in random order" $
         run $ do
           replicateM_ 20 $ do
             _ <- insert p1
@@ -1226,6 +1229,17 @@ main = do
 
           liftIO $ (ret1 == ret2) `shouldBe` False
 
+      it "castNum works for multiplying Int and Double" $
+        run $ do
+          mapM_ insert [Numbers 2 3.4, Numbers 7 1.1]
+          ret <-
+            select $
+            from $ \n -> do
+            let r = castNum (n ^. NumbersInt) *. n ^. NumbersDouble
+            orderBy [asc r]
+            return r
+          liftIO $ ret `shouldBe` [Value 6.8, Value 7.7]
+
     describe "case" $ do
       it "Works for a simple value based when - False" $
         run $ do