From 5a0974f4c00deca408a1513c19480d6f0211e7e8 Mon Sep 17 00:00:00 2001
From: Felipe Lessa <felipe.lessa@gmail.com>
Date: Sun, 9 Sep 2012 12:20:15 -0300
Subject: [PATCH] New text-related functions like, (%), concat_ and (++.).

---
 src/Database/Esqueleto.hs                   |  1 +
 src/Database/Esqueleto/Internal/Language.hs | 23 ++++++++++++++++++++-
 src/Database/Esqueleto/Internal/Sql.hs      |  5 +++++
 test/Test.hs                                | 15 ++++++++++++++
 4 files changed, 43 insertions(+), 1 deletion(-)

diff --git a/src/Database/Esqueleto.hs b/src/Database/Esqueleto.hs
index a38dc11..e08d92a 100644
--- a/src/Database/Esqueleto.hs
+++ b/src/Database/Esqueleto.hs
@@ -23,6 +23,7 @@ module Database.Esqueleto
              , val, isNothing, just, nothing, countRows, not_
              , (==.), (>=.), (>.), (<=.), (<.), (!=.), (&&.), (||.)
              , (+.), (-.), (/.), (*.)
+             , like, (%), concat_, (++.)
              , set, (=.), (+=.), (-=.), (*=.), (/=.) )
   , from
   , Value(..)
diff --git a/src/Database/Esqueleto/Internal/Language.hs b/src/Database/Esqueleto/Internal/Language.hs
index cc365ff..89738bb 100644
--- a/src/Database/Esqueleto/Internal/Language.hs
+++ b/src/Database/Esqueleto/Internal/Language.hs
@@ -33,6 +33,7 @@ module Database.Esqueleto.Internal.Language
 
 import Control.Applicative (Applicative(..), (<$>))
 import Control.Exception (Exception)
+import Data.String (IsString)
 import Data.Typeable (Typeable)
 import Database.Persist.GenericSql
 import Database.Persist.Store
@@ -183,6 +184,25 @@ class (Functor query, Applicative query, Monad query) =>
   (/.)  :: PersistField a => expr (Value a) -> expr (Value a) -> expr (Value a)
   (*.)  :: PersistField a => expr (Value a) -> expr (Value a) -> expr (Value a)
 
+  -- | @LIKE@ operator.
+  like :: (PersistField s, IsString s) => expr (Value s) -> expr (Value s) -> expr (Value Bool)
+  -- | The string @'%'@.  May be useful while using 'like' and
+  -- concatenation ('concat_' or '++.', depending on your
+  -- database).  Note that you always to type the parenthesis,
+  -- for example:
+  --
+  -- @
+  -- name ``'like'`` (%) ++. val "John" ++. (%)
+  -- @
+  (%) :: (PersistField s, IsString s) => expr (Value s)
+  -- | The @CONCAT@ function with a variable number of
+  -- parameters.  Supported by MySQL and PostgreSQL.
+  concat_ :: (PersistField s, IsString s) => [expr (Value s)] -> expr (Value s)
+  -- | The @||@ string concatenation operator (named after
+  -- Haskell's '++' in order to avoid naming clash with '||.').
+  -- Supported by SQLite and PostgreSQL.
+  (++.) :: (PersistField s, IsString s) => expr (Value s) -> expr (Value s) -> expr (Value s)
+
   -- | @SET@ clause used on @UPDATE@s.  Note that while it's not
   -- a type error to use this function on a @SELECT@, it will
   -- most certainly result in a runtime error.
@@ -199,9 +219,10 @@ class (Functor query, Applicative query, Monad query) =>
 infixl 9 ^.
 infixl 7 *., /.
 infixl 6 +., -.
+infixr 5 ++.
 infix  4 ==., >=., >., <=., <., !=.
 infixr 3 &&., =., +=., -=., *=., /=.
-infixr 2 ||., `InnerJoin`, `CrossJoin`, `LeftOuterJoin`, `RightOuterJoin`, `FullOuterJoin`
+infixr 2 ||., `InnerJoin`, `CrossJoin`, `LeftOuterJoin`, `RightOuterJoin`, `FullOuterJoin`, `like`
 
 
 -- | A single value (as opposed to a whole entity).  You may use
diff --git a/src/Database/Esqueleto/Internal/Sql.hs b/src/Database/Esqueleto/Internal/Sql.hs
index 3c552af..d8ec2a5 100644
--- a/src/Database/Esqueleto/Internal/Sql.hs
+++ b/src/Database/Esqueleto/Internal/Sql.hs
@@ -294,6 +294,11 @@ instance Esqueleto SqlQuery SqlExpr SqlPersist where
   (/.)  = unsafeSqlBinOp " / "
   (*.)  = unsafeSqlBinOp " * "
 
+  like    = unsafeSqlBinOp    " LIKE "
+  (%)     = unsafeSqlValue    "'%'"
+  concat_ = unsafeSqlFunction "CONCAT"
+  (++.)   = unsafeSqlBinOp    " || "
+
   set ent upds = Q $ W.tell mempty { sdSetClause = map apply upds }
     where
       apply (ESet f) = SetClause (f ent)
diff --git a/test/Test.hs b/test/Test.hs
index 454d6f8..066ae76 100644
--- a/test/Test.hs
+++ b/test/Test.hs
@@ -344,6 +344,21 @@ main = do
                  return title
           liftIO $ ret `shouldBe` [ Value t1, Value t2, Value t3 ]
 
+    describe "text functions" $
+      it "like, (%) and (++.) work on a simple example" $
+         run $ do
+           [p1e, p2e, p3e, p4e] <- mapM insert' [p1, p2, p3, p4]
+           let nameContains t expected = do
+                 ret <- select $
+                        from $ \p -> do
+                        where_ (p ^. PersonName `like` (%) ++. val t ++. (%))
+                        orderBy [asc (p ^. PersonName)]
+                        return p
+                 liftIO $ ret `shouldBe` expected
+           nameContains "h"  [p1e, p2e]
+           nameContains "i"  [p4e, p3e]
+           nameContains "iv" [p4e]
+
     describe "delete" $
       it "works on a simple example" $
         run $ do