Fixed up some mysql kinks and split out test function. Added new test format to travis yaml.

.travis.yml

@@ -30,9 +30,9 @@ script:
   - stack setup
   - stack update
   - stack build
-  - stack test --flag esqueleto:postgresql
+  - stack test -- esqueleto:postgresql
-  - stack test --flag esqueleto:-mysql
+  - stack test -- esqueleto:mysql
-  - stack test
+  - stack test -- esqueleto:sqlite
 
 cache:
   directories:

test/Common/Test.hs

@@ -87,14 +87,14 @@ share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistUpperCase|
     deriving Eq Show
 
   Lord
-    county String
+    county String maxlen=100
     dogs Int Maybe
     Primary county
     deriving Show
 
   Deed
-    contract String
+    contract String maxlen=100
-    ownerId LordId
+    ownerId LordId maxlen=100
     Primary contract
     deriving Show
 
@@ -117,12 +117,12 @@ share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistUpperCase|
     Foreign Frontcover fkfrontcover frontcoverNumber
     deriving Eq Show
   Tag
-    name String
+    name String maxlen=100
     Primary name
     deriving Eq Show
   ArticleTag
     articleId ArticleId
-    tagId     TagId
+    tagId     TagId maxlen=100
     Primary   articleId tagId
     deriving Eq Show
   Article2
@@ -155,6 +155,13 @@ share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistUpperCase|
 sameElementsAs :: Eq a => [a] -> [a] -> Bool
 sameElementsAs l1 l2 = null (l1 L.\\ l2)
 
+-- | Helper for rounding to a specific digit
+--   Prelude> map (flip roundTo 12.3456) [0..5]
+--   [12.0, 12.3, 12.35, 12.346, 12.3456, 12.3456]
+roundTo :: (Fractional a, RealFrac a1, Integral b) => b -> a1 -> a
+roundTo n f =
+  (fromInteger $ round $ f * (10^n)) / (10.0^^n)
+
 p1 :: Person
 p1 = Person "John"   (Just 36) Nothing   1
 
@@ -633,7 +640,12 @@ testSelectWhere run = do
         ret <- select $
                from $ \p->
                return $ joinV $ avg_ (p ^. PersonAge)
-        liftIO $ ret `shouldBe` [ Value $ Just ((36 + 17 + 17) / 3 :: Double) ]
+        let testV :: Double
+            testV = roundTo 4 $ (36 + 17 + 17) / 3
+
+            retV :: [Value (Maybe Double)]
+            retV = map (Value . fmap (roundTo 4) . unValue) (ret :: [Value (Maybe Double)])
+        liftIO $ retV `shouldBe` [ Value $ Just testV ]
 
     it "works with min_" $
       run $ do
@@ -933,27 +945,6 @@ testCoasleceDefault run = do
 -------------------------------------------------------------------------------
 
 
-testTextFunctions :: Run -> Spec
-testTextFunctions run = do
-  describe "text functions" $ do
-    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]
-
-
--------------------------------------------------------------------------------
-
-
 testDelete :: Run -> Spec
 testDelete run = do
   describe "delete" $
@@ -1403,7 +1394,6 @@ tests run = do
     testSelectOrderBy run
     testSelectDistinct run
     testCoasleceDefault run
-    testTextFunctions run
     testDelete run
     testUpdate run
     testListOfValues run

test/MySQL/Test.hs

@@ -1,14 +1,15 @@
 {-# LANGUAGE ScopedTypeVariables
            , FlexibleContexts
            , RankNTypes
+           , TypeFamilies
 #-}
 
 module Main (main) where
 
 import Control.Monad (void)
 import Control.Monad.IO.Class (MonadIO(liftIO))
-import Control.Monad.Logger (MonadLogger(..), runStderrLoggingT, runNoLoggingT)
+import Control.Monad.Logger (runStderrLoggingT, runNoLoggingT)
-import Control.Monad.Trans.Control (MonadBaseControl(..))
+import Control.Monad.Trans.Reader (ReaderT)
 import Database.Persist.MySQL ( withMySQLConn
                               , connectHost
                               , connectDatabase
@@ -133,6 +134,40 @@ testMysqlUpdate = do
 -------------------------------------------------------------------------------
 
 
+nameContains :: (BaseBackend backend ~ SqlBackend,
+                 Esqueleto query expr backend, MonadIO m, SqlString s,
+                 IsPersistBackend backend, PersistQueryRead backend,
+                 PersistUniqueRead backend)
+             => (SqlExpr (Value [Char])
+             -> expr (Value s)
+             -> SqlExpr (Value Bool))
+             -> s
+             -> [Entity Person]
+             -> ReaderT backend m ()
+nameContains f t expected = do
+  ret <- select $
+         from $ \p -> do
+         where_ (f
+                  (p ^. PersonName)
+                  (concat_ [(%), val t, (%)]))
+         orderBy [asc (p ^. PersonName)]
+         return p
+  liftIO $ ret `shouldBe` expected
+
+
+testMysqlTextFunctions :: Spec
+testMysqlTextFunctions = do
+  describe "text functions" $ do
+    it "like, (%) and (++.) work on a simple example" $
+       run $ do
+         [p1e, p2e, p3e, p4e] <- mapM insert' [p1, p2, p3, p4]
+         nameContains like "h"  [p1e, p2e]
+         nameContains like "i"  [p4e, p3e]
+         nameContains like "iv" [p4e]
+
+
+-------------------------------------------------------------------------------
+
 main :: IO ()
 main = do
   hspec $ do
@@ -148,6 +183,7 @@ main = do
       testMysqlOneAscOneDesc
       testMysqlCoalesce
       testMysqlUpdate
+      testMysqlTextFunctions
 
 
 -------------------------------------------------------------------------------

test/PostgreSQL/Test.hs

@@ -1,25 +1,16 @@
 {-# OPTIONS_GHC -fno-warn-unused-binds  #-}
-{-# LANGUAGE ConstraintKinds
+{-# LANGUAGE ScopedTypeVariables
-           , EmptyDataDecls
            , FlexibleContexts
-           , FlexibleInstances
+           , RankNTypes
-           , DeriveGeneric
-           , GADTs
-           , GeneralizedNewtypeDeriving
-           , MultiParamTypeClasses
-           , OverloadedStrings
-           , QuasiQuotes
-           , Rank2Types
-           , TemplateHaskell
            , TypeFamilies
-           , ScopedTypeVariables
+           , OverloadedStrings
-           , TypeSynonymInstances
  #-}
 module Main (main) where
 
 import Control.Monad (void)
 import Control.Monad.IO.Class (MonadIO(liftIO))
 import Control.Monad.Logger (runStderrLoggingT, runNoLoggingT)
+import Control.Monad.Trans.Reader (ReaderT)
 import Database.Esqueleto
 import Database.Persist.Postgresql (withPostgresqlConn)
 import Data.Ord (comparing)
@@ -49,20 +40,49 @@ testPostgresqlCoalesce = do
 -------------------------------------------------------------------------------
 
 
-testPostgresqlTextFunction :: Spec
+nameContains :: (BaseBackend backend ~ SqlBackend,
-testPostgresqlTextFunction = do
+                 Esqueleto query expr backend, MonadIO m, SqlString s,
-  it "ilike, (%) and (++.) work on a simple example on PostgreSQL" $
+                 IsPersistBackend backend, PersistQueryRead backend,
-    run $ do
+                 PersistUniqueRead backend)
-      [p1e, _, p3e, _, p5e] <- mapM insert' [p1, p2, p3, p4, p5]
+             => (SqlExpr (Value [Char])
-      let nameContains t expected = do
+             -> expr (Value s)
-            ret <- select $
+             -> SqlExpr (Value Bool))
-                   from $ \p -> do
+             -> s
-                   where_ (p ^. PersonName `ilike` (%) ++. val t ++. (%))
+             -> [Entity Person]
-                   orderBy [asc (p ^. PersonName)]
+             -> ReaderT backend m ()
-                   return p
+nameContains f t expected = do
-            liftIO $ ret `shouldBe` expected
+  ret <- select $
-      nameContains "mi" [p3e, p5e]
+         from $ \p -> do
-      nameContains "JOHN" [p1e]
+         where_ (f
+                  (p ^. PersonName)
+                  ((%) ++. val t ++. (%)))
+         orderBy [asc (p ^. PersonName)]
+         return p
+  liftIO $ ret `shouldBe` expected
+
+
+testPostgresqlTextFunctions :: Spec
+testPostgresqlTextFunctions = do
+  describe "text functions" $ do
+    it "like, (%) and (++.) work on a simple example" $
+       run $ do
+         [p1e, p2e, p3e, p4e] <- mapM insert' [p1, p2, p3, p4]
+         nameContains like "h"  [p1e, p2e]
+         nameContains like "i"  [p4e, p3e]
+         nameContains like "iv" [p4e]
+
+    it "ilike, (%) and (++.) work on a simple example on PostgreSQL" $
+      run $ do
+        [p1e, _, p3e, _, p5e] <- mapM insert' [p1, p2, p3, p4, p5]
+        let nameContains t expected = do
+              ret <- select $
+                     from $ \p -> do
+                     where_ (p ^. PersonName `ilike` (%) ++. val t ++. (%))
+                     orderBy [asc (p ^. PersonName)]
+                     return p
+              liftIO $ ret `shouldBe` expected
+        nameContains "mi" [p3e, p5e]
+        nameContains "JOHN" [p1e]
 
 
 -------------------------------------------------------------------------------
@@ -276,8 +296,8 @@ main = do
       testPostgresqlSum
       testPostgresqlRandom
       testPostgresqlUpdate
-      testPostgresqlTextFunction
       testPostgresqlCoalesce
+      testPostgresqlTextFunctions
 
 
 -------------------------------------------------------------------------------

test/SQLite/Test.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE ScopedTypeVariables
            , FlexibleContexts
            , RankNTypes
+           , TypeFamilies
            , OverloadedStrings
 #-}
 
@@ -9,6 +10,7 @@ module Main (main) where
 import Control.Monad (void)
 import Control.Monad.IO.Class (MonadIO(liftIO))
 import Control.Monad.Logger (runStderrLoggingT, runNoLoggingT)
+import Control.Monad.Trans.Reader (ReaderT)
 import Database.Persist.Sqlite (withSqliteConn)
 import Database.Sqlite (SqliteException)
 import Database.Esqueleto
@@ -127,6 +129,40 @@ testSqliteUpdate = do
 -------------------------------------------------------------------------------
 
 
+nameContains :: (BaseBackend backend ~ SqlBackend,
+                 Esqueleto query expr backend, MonadIO m, SqlString s,
+                 IsPersistBackend backend, PersistQueryRead backend,
+                 PersistUniqueRead backend)
+             => (SqlExpr (Value [Char])
+             -> expr (Value s)
+             -> SqlExpr (Value Bool))
+             -> s
+             -> [Entity Person]
+             -> ReaderT backend m ()
+nameContains f t expected = do
+  ret <- select $
+         from $ \p -> do
+         where_ (f
+                  (p ^. PersonName)
+                  ((%) ++. val t ++. (%)))
+         orderBy [asc (p ^. PersonName)]
+         return p
+  liftIO $ ret `shouldBe` expected
+
+testSqliteTextFunctions :: Spec
+testSqliteTextFunctions = do
+  describe "text functions" $ do
+    it "like, (%) and (++.) work on a simple example" $
+       run $ do
+         [p1e, p2e, p3e, p4e] <- mapM insert' [p1, p2, p3, p4]
+         nameContains like "h"  [p1e, p2e]
+         nameContains like "i"  [p4e, p3e]
+         nameContains like "iv" [p4e]
+
+
+-------------------------------------------------------------------------------
+
+
 main :: IO ()
 main = do
   hspec $ do
@@ -142,6 +178,7 @@ main = do
       testSqliteOneAscOneDesc
       testSqliteCoalesce
       testSqliteUpdate
+      testSqliteTextFunctions
 
 
 -------------------------------------------------------------------------------