From 84f2f086feb2382064504a616d7c3defcc16b3ed Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20Crist=C3=B3v=C3=A3o?= Date: Wed, 11 Sep 2013 10:29:40 +0100 Subject: [PATCH 01/42] IN works for subList_select assumes ordering. Made ordering explicit. --- test/Test.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/test/Test.hs b/test/Test.hs index 3d92243..908afa1 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -643,7 +643,8 @@ main = do ret <- select $ from $ \p -> do let subquery = - from $ \bp -> + from $ \bp -> do + orderBy [ asc (bp ^. BlogPostAuthorId) ] return (bp ^. BlogPostAuthorId) where_ (p ^. PersonId `in_` subList_select subquery) return p From 161621cbd4e17de33ff395cbb25f2bdc34437680 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20Crist=C3=B3v=C3=A3o?= Date: Wed, 11 Sep 2013 10:48:12 +0100 Subject: [PATCH 02/42] sum_ result type may not be the same as the parameters type. --- src/Database/Esqueleto/Internal/Language.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Database/Esqueleto/Internal/Language.hs b/src/Database/Esqueleto/Internal/Language.hs index ebc220d..b245550 100644 --- a/src/Database/Esqueleto/Internal/Language.hs +++ b/src/Database/Esqueleto/Internal/Language.hs @@ -241,7 +241,7 @@ class (Functor query, Applicative query, Monad query) => ceiling_ :: (PersistField a, PersistField b) => expr (Value a) -> expr (Value b) floor_ :: (PersistField a, PersistField b) => expr (Value a) -> expr (Value b) - sum_ :: (PersistField a) => expr (Value a) -> expr (Value (Maybe a)) + sum_ :: (PersistField a, PersistField b) => expr (Value a) -> expr (Value (Maybe b)) min_ :: (PersistField a) => expr (Value a) -> expr (Value (Maybe a)) max_ :: (PersistField a) => expr (Value a) -> expr (Value (Maybe a)) avg_ :: (PersistField a, PersistField b) => expr (Value a) -> expr (Value (Maybe b)) From 753e4bccac569d3210013badb21bbbd98225c264 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20Crist=C3=B3v=C3=A3o?= Date: Thu, 19 Sep 2013 09:30:16 +0100 Subject: [PATCH 03/42] Added num class restriction to random, round_, floor_. --- src/Database/Esqueleto/Internal/Language.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Database/Esqueleto/Internal/Language.hs b/src/Database/Esqueleto/Internal/Language.hs index b737f77..48ad25b 100644 --- a/src/Database/Esqueleto/Internal/Language.hs +++ b/src/Database/Esqueleto/Internal/Language.hs @@ -237,10 +237,10 @@ class (Functor query, Applicative query, Monad query) => (*.) :: PersistField a => expr (Value a) -> expr (Value a) -> expr (Value a) - random_ :: PersistField a => expr (Value a) - round_ :: (PersistField a, PersistField b) => expr (Value a) -> expr (Value b) - ceiling_ :: (PersistField a, PersistField b) => expr (Value a) -> expr (Value b) - floor_ :: (PersistField a, PersistField b) => expr (Value a) -> expr (Value b) + random_ :: (PersistField a, Num a) => expr (Value a) + round_ :: (PersistField a, Num a, PersistField b, Num b) => expr (Value a) -> expr (Value b) + ceiling_ :: (PersistField a, Num a, PersistField b, Num b) => expr (Value a) -> expr (Value b) + floor_ :: (PersistField a, Num a, PersistField b, Num b) => expr (Value a) -> expr (Value b) sum_ :: (PersistField a, PersistField b) => expr (Value a) -> expr (Value (Maybe b)) min_ :: (PersistField a) => expr (Value a) -> expr (Value (Maybe a)) From 60e73c0a0ce3b887562cc6a3409bef3fef8469f4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20Crist=C3=B3v=C3=A3o?= Date: Thu, 19 Sep 2013 09:31:30 +0100 Subject: [PATCH 04/42] Sum returns different types on different backends. --- test/Test.hs | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/test/Test.hs b/test/Test.hs index b084802..35636ae 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -323,7 +323,13 @@ main = do ret <- select $ from $ \p-> return $ joinV $ sum_ (p ^. PersonAge) +#if defined(WITH_POSTGRESQL) + liftIO $ ret `shouldBe` [ Value $ Just (36 + 17 + 17 :: Rational ) ] +#elif defined(WITH_MYSQL) + liftIO $ ret `shouldBe` [ Value $ Just (36 + 17 + 17 :: Double ) ] +#else liftIO $ ret `shouldBe` [ Value $ Just (36 + 17 + 17 :: Int) ] +#endif it "works with avg_" $ run $ do From 0d5d427e0d1cc1955a9803e64385c1caa7b3f4a1 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Thu, 16 Jan 2014 16:03:53 +0200 Subject: [PATCH 05/42] Version bump --- esqueleto.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/esqueleto.cabal b/esqueleto.cabal index 93cbbe0..2d2af20 100644 --- a/esqueleto.cabal +++ b/esqueleto.cabal @@ -1,5 +1,5 @@ name: esqueleto -version: 1.3.4.2 +version: 1.3.4.3 synopsis: Bare bones, type-safe EDSL for SQL queries on persistent backends. homepage: https://github.com/meteficha/esqueleto license: BSD3 From 41cdd9af5884d1b967d7e84d49eca637712526a6 Mon Sep 17 00:00:00 2001 From: Oliver Charles Date: Sat, 25 Jan 2014 11:33:20 +0000 Subject: [PATCH 06/42] Increase upper bound on HSpec This allows tests to be built and run when packaging for NixOS. --- esqueleto.cabal | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/esqueleto.cabal b/esqueleto.cabal index 2d2af20..b987cb0 100644 --- a/esqueleto.cabal +++ b/esqueleto.cabal @@ -90,7 +90,7 @@ test-suite test , containers , HUnit , QuickCheck - , hspec >= 1.3 && < 1.8 + , hspec >= 1.3 && < 1.9 , persistent-sqlite >= 1.2 && < 1.4 , persistent-template >= 1.2 && < 1.4 , monad-control @@ -104,7 +104,7 @@ test-suite test postgresql-simple >= 0.2 , postgresql-libpq >= 0.6 , persistent-postgresql >= 1.2.0 - + cpp-options: -DWITH_POSTGRESQL if flag(mysql) @@ -114,4 +114,3 @@ test-suite test , persistent-mysql >= 1.2.0 cpp-options: -DWITH_MYSQL - From 20565af0b1b1a6b1580764a6b37103f562f51abc Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Sat, 25 Jan 2014 18:20:34 +0200 Subject: [PATCH 07/42] Version bump --- esqueleto.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/esqueleto.cabal b/esqueleto.cabal index b987cb0..4e6d005 100644 --- a/esqueleto.cabal +++ b/esqueleto.cabal @@ -1,5 +1,5 @@ name: esqueleto -version: 1.3.4.3 +version: 1.3.4.4 synopsis: Bare bones, type-safe EDSL for SQL queries on persistent backends. homepage: https://github.com/meteficha/esqueleto license: BSD3 From 7ffead2e40e632fb7020f202af8abec50aec24a2 Mon Sep 17 00:00:00 2001 From: Sergei Trofimovich Date: Sat, 25 Jan 2014 20:27:03 +0300 Subject: [PATCH 08/42] esqueleto.cabal: allow test-1.0 and text-1.1 Signed-off-by: Sergei Trofimovich --- esqueleto.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/esqueleto.cabal b/esqueleto.cabal index 4e6d005..146bc63 100644 --- a/esqueleto.cabal +++ b/esqueleto.cabal @@ -64,7 +64,7 @@ library Database.Esqueleto.Internal.PersistentImport build-depends: base >= 4.5 && < 4.7 - , text == 0.11.* + , text >= 0.11 , persistent >= 1.2 && < 1.4 , transformers >= 0.2 , unordered-containers >= 0.2 From b5ce7cd6440e109fb03ae79cdf6fa415b261c009 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Sun, 26 Jan 2014 07:37:30 +0200 Subject: [PATCH 09/42] Version bump --- esqueleto.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/esqueleto.cabal b/esqueleto.cabal index 146bc63..65f0064 100644 --- a/esqueleto.cabal +++ b/esqueleto.cabal @@ -1,5 +1,5 @@ name: esqueleto -version: 1.3.4.4 +version: 1.3.4.5 synopsis: Bare bones, type-safe EDSL for SQL queries on persistent backends. homepage: https://github.com/meteficha/esqueleto license: BSD3 From 2e6b0c7c2b372b1112d9827d9648f0730ad54606 Mon Sep 17 00:00:00 2001 From: Felipe Lessa Date: Mon, 3 Mar 2014 12:02:18 -0300 Subject: [PATCH 10/42] GHC 7.8. --- esqueleto.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/esqueleto.cabal b/esqueleto.cabal index 65f0064..52398cd 100644 --- a/esqueleto.cabal +++ b/esqueleto.cabal @@ -1,5 +1,5 @@ name: esqueleto -version: 1.3.4.5 +version: 1.3.4.6 synopsis: Bare bones, type-safe EDSL for SQL queries on persistent backends. homepage: https://github.com/meteficha/esqueleto license: BSD3 @@ -63,7 +63,7 @@ library other-modules: Database.Esqueleto.Internal.PersistentImport build-depends: - base >= 4.5 && < 4.7 + base >= 4.5 && < 4.8 , text >= 0.11 , persistent >= 1.2 && < 1.4 , transformers >= 0.2 From 714f33639a9cd1cceb0856bc426807b1edb61d30 Mon Sep 17 00:00:00 2001 From: Felipe Lessa Date: Tue, 4 Mar 2014 09:01:39 -0300 Subject: [PATCH 11/42] Ignore cabal sandboxes. --- .gitignore | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.gitignore b/.gitignore index 4e5c416..a64d82e 100644 --- a/.gitignore +++ b/.gitignore @@ -1,2 +1,4 @@ /dist* *~ +.cabal-sandbox/ +cabal.sandbox.config From f04e277a2dd121cedcd11aa51d25dfc9e37dc4b1 Mon Sep 17 00:00:00 2001 From: Felipe Lessa Date: Tue, 4 Mar 2014 09:02:18 -0300 Subject: [PATCH 12/42] Rewrite insertSelect so that it properly escapes names (fixes #47). --- src/Database/Esqueleto/Internal/Sql.hs | 139 ++++++++++++++----------- 1 file changed, 77 insertions(+), 62 deletions(-) diff --git a/src/Database/Esqueleto/Internal/Sql.hs b/src/Database/Esqueleto/Internal/Sql.hs index 660e409..a7865f7 100644 --- a/src/Database/Esqueleto/Internal/Sql.hs +++ b/src/Database/Esqueleto/Internal/Sql.hs @@ -1,4 +1,5 @@ {-# LANGUAGE ConstraintKinds + , EmptyDataDecls , FlexibleContexts , FlexibleInstances , FunctionalDependencies @@ -264,6 +265,10 @@ data SqlExpr a where -- Used by 'insertSelect'. EInsert :: Proxy a -> (IdentInfo -> (TLB.Builder, [PersistValue])) -> SqlExpr (Insertion a) + EInsertFinal :: PersistEntity a => SqlExpr (Insertion a) -> SqlExpr InsertFinal + +-- | Phantom type used to mark a @INSERT INTO@ query. +data InsertFinal data NeedParens = Parens | Never @@ -417,7 +422,7 @@ setAux field mkVal = ESet $ \ent -> unsafeSqlBinOp " = " name (mkVal ent) where name = ERaw Never $ \info -> (fieldName info field, mempty) sub :: PersistField a => Mode -> SqlQuery (SqlExpr (Value a)) -> SqlExpr (Value a) -sub mode query = ERaw Parens $ \info -> toRawSql mode pureQuery info query +sub mode query = ERaw Parens $ \info -> toRawSql mode info query fromDBName :: IdentInfo -> DBName -> TLB.Builder fromDBName (conn, _) = TLB.fromText . connEscapeName conn @@ -534,7 +539,7 @@ rawSelectSource mode query = src run conn = uncurry rawQuery $ first builderToText $ - toRawSql mode pureQuery (conn, initialIdentState) query + toRawSql mode (conn, initialIdentState) query massage = do mrow <- C.await @@ -638,15 +643,16 @@ runSource src = C.runResourceT $ src C.$$ CL.consume -- | (Internal) Execute an @esqueleto@ statement inside -- @persistent@'s 'SqlPersistT' monad. rawEsqueleto :: ( MonadLogger m - , MonadResourceBase m ) + , MonadResourceBase m + , SqlSelect a r ) => Mode - -> SqlQuery () + -> SqlQuery a -> SqlPersistT m Int64 rawEsqueleto mode query = do conn <- SqlPersistT R.ask uncurry rawExecuteCount $ first builderToText $ - toRawSql mode pureQuery (conn, initialIdentState) query + toRawSql mode (conn, initialIdentState) query -- | Execute an @esqueleto@ @DELETE@ query inside @persistent@'s @@ -715,6 +721,25 @@ updateCount :: ( MonadLogger m updateCount = rawEsqueleto UPDATE . from +-- | Insert a 'PersistField' for every selected value. +insertSelect :: ( MonadLogger m + , MonadResourceBase m + , PersistEntity a ) + => SqlQuery (SqlExpr (Insertion a)) -> SqlPersistT m () +insertSelect = + void . rawEsqueleto (INSERT_INTO SELECT) . fmap EInsertFinal + + +-- | Insert a 'PersistField' for every unique selected value. +insertSelectDistinct + :: ( MonadLogger m + , MonadResourceBase m + , PersistEntity a ) + => SqlQuery (SqlExpr (Insertion a)) -> SqlPersistT m () +insertSelectDistinct = + void . rawEsqueleto (INSERT_INTO SELECT_DISTINCT) . fmap EInsertFinal + + ---------------------------------------------------------------------- @@ -730,8 +755,8 @@ builderToText = TL.toStrict . TLB.toLazyTextWith defaultChunkSize -- @esqueleto@, instead of manually using this function (which is -- possible but tedious), you may just turn on query logging of -- @persistent@. -toRawSql :: SqlSelect a r => Mode -> QueryType a -> IdentInfo -> SqlQuery a -> (TLB.Builder, [PersistValue]) -toRawSql mode qt (conn, firstIdentState) query = +toRawSql :: SqlSelect a r => Mode -> IdentInfo -> SqlQuery a -> (TLB.Builder, [PersistValue]) +toRawSql mode (conn, firstIdentState) query = let ((ret, sd), finalIdentState) = flip S.runState firstIdentState $ W.runWriterT $ @@ -749,36 +774,27 @@ toRawSql mode qt (conn, firstIdentState) query = -- appear on the expressions below. info = (conn, finalIdentState) in mconcat - [ makeInsert qt ret - , makeSelect info mode ret - , makeFrom info mode fromClauses - , makeSet info setClauses - , makeWhere info whereClauses - , makeGroupBy info groupByClause - , makeHaving info havingClause - , makeOrderBy info orderByClauses - , makeLimit info limitClause + [ makeInsertInto info mode ret + , makeSelect info mode ret + , makeFrom info mode fromClauses + , makeSet info setClauses + , makeWhere info whereClauses + , makeGroupBy info groupByClause + , makeHaving info havingClause + , makeOrderBy info orderByClauses + , makeLimit info limitClause ] -- | (Internal) Mode of query being converted by 'toRawSql'. -data Mode = SELECT | SELECT_DISTINCT | DELETE | UPDATE +data Mode = + SELECT + | SELECT_DISTINCT + | DELETE + | UPDATE + | INSERT_INTO Mode + -- ^ 'Mode' should be either 'SELECT' or 'SELECT_DISTINCT'. -newtype QueryType a = QueryType { unQueryType :: a -> TLB.Builder } - -pureQuery :: QueryType a -pureQuery = QueryType (const mempty) - -insertQuery :: PersistEntity a => QueryType (SqlExpr (Insertion a)) -insertQuery = QueryType $ \(EInsert p _)-> - let def = entityDef p - unName = TLB.fromText . unDBName - fields = uncommas $ map (unName . fieldDB) (entityFields def) - table = unName . entityDB . entityDef $ p - in "INSERT INTO " <> table <> parens fields <> "\n" - -makeInsert :: QueryType a -> a -> (TLB.Builder, [PersistValue]) -makeInsert q a = (unQueryType q a, []) uncommas :: [TLB.Builder] -> TLB.Builder uncommas = mconcat . intersperse ", " . filter (/= mempty) @@ -787,14 +803,21 @@ uncommas' :: Monoid a => [(TLB.Builder, a)] -> (TLB.Builder, a) uncommas' = (uncommas *** mconcat) . unzip +makeInsertInto :: SqlSelect a r => IdentInfo -> Mode -> a -> (TLB.Builder, [PersistValue]) +makeInsertInto info (INSERT_INTO _) ret = sqlInsertInto info ret +makeInsertInto _ _ _ = mempty + + makeSelect :: SqlSelect a r => IdentInfo -> Mode -> a -> (TLB.Builder, [PersistValue]) -makeSelect info mode ret = - case mode of - SELECT -> withCols "SELECT " - SELECT_DISTINCT -> withCols "SELECT DISTINCT " - DELETE -> plain "DELETE " - UPDATE -> plain "UPDATE " +makeSelect info mode_ ret = process mode_ where + process mode = + case mode of + SELECT -> withCols "SELECT " + SELECT_DISTINCT -> withCols "SELECT DISTINCT " + DELETE -> plain "DELETE " + UPDATE -> plain "UPDATE " + INSERT_INTO mode' -> process mode' withCols v = first (v <>) (sqlSelectCols info ret) plain v = (v, []) @@ -914,14 +937,25 @@ class SqlSelect a r | a -> r, r -> a where -- | Transform a row of the result into the data type. sqlSelectProcessRow :: [PersistValue] -> Either T.Text r + -- | Create @INSERT INTO@ clause instead. + sqlInsertInto :: IdentInfo -> a -> (TLB.Builder, [PersistValue]) + sqlInsertInto = error "Type does not support sqlInsertInto." --- | You may return an insertion of some PersistEntity -instance PersistEntity a => SqlSelect (SqlExpr (Insertion a)) (Insertion a) where - sqlSelectCols info (EInsert _ f) = f info - sqlSelectColCount = const 0 + +-- | @INSERT INTO@ hack. +instance SqlSelect (SqlExpr InsertFinal) InsertFinal where + sqlInsertInto info (EInsertFinal (EInsert p _)) = + let fields = uncommas $ + map (fromDBName info . fieldDB) $ + entityFields $ + entityDef p + table = fromDBName info . entityDB . entityDef $ p + in ("INSERT INTO " <> table <> parens fields <> "\n", []) + sqlSelectCols info (EInsertFinal (EInsert _ f)) = f info + sqlSelectColCount = const 0 sqlSelectProcessRow = const (Right (error msg)) where - msg = "sqlSelectProcessRow/SqlSelect (SqlExpr (Insertion a)) (Insertion a): never here" + msg = "sqlSelectProcessRow/SqlSelect/InsertionFinal: never here" -- | Not useful for 'select', but used for 'update' and 'delete'. @@ -1470,22 +1504,3 @@ from16P = const Proxy to16 :: ((a,b),(c,d),(e,f),(g,h),(i,j),(k,l),(m,n),(o,p)) -> (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p) to16 ((a,b),(c,d),(e,f),(g,h),(i,j),(k,l),(m,n),(o,p)) = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p) - - --- | Insert a 'PersistField' for every selected value. -insertSelect :: (MonadLogger m, MonadResourceBase m, SqlSelect (SqlExpr (Insertion a)) r, PersistEntity a) => - SqlQuery (SqlExpr (Insertion a)) -> SqlPersistT m () -insertSelect = insertGeneralSelect SELECT - - --- | Insert a 'PersistField' for every unique selected value. -insertSelectDistinct :: (MonadLogger m, MonadResourceBase m, SqlSelect (SqlExpr (Insertion a)) r, PersistEntity a) => - SqlQuery (SqlExpr (Insertion a)) -> SqlPersistT m () -insertSelectDistinct = insertGeneralSelect SELECT_DISTINCT - - -insertGeneralSelect :: (MonadLogger m, MonadResourceBase m, SqlSelect (SqlExpr (Insertion a)) r, PersistEntity a) => - Mode -> SqlQuery (SqlExpr (Insertion a)) -> SqlPersistT m () -insertGeneralSelect mode query = do - conn <- SqlPersistT R.ask - uncurry rawExecute $ first builderToText $ toRawSql mode insertQuery (conn, initialIdentState) query From 030423da5495e1b09609a0dd981a8cc97bd0bfc8 Mon Sep 17 00:00:00 2001 From: Felipe Lessa Date: Tue, 4 Mar 2014 09:11:01 -0300 Subject: [PATCH 13/42] Avoid warning when compiling tests for PostgreSQL or MySQL. --- test/Test.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/test/Test.hs b/test/Test.hs index 35636ae..1790839 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -20,7 +20,6 @@ import Control.Monad.IO.Class (MonadIO(liftIO)) import Control.Monad.Logger (MonadLogger(..), runStderrLoggingT, runNoLoggingT) import Control.Monad.Trans.Control (MonadBaseControl(..)) import Database.Esqueleto -import Database.Persist.Sqlite (withSqliteConn) #if defined (WITH_POSTGRESQL) import Database.Persist.Postgresql (withPostgresqlConn) #elif defined (WITH_MYSQL) @@ -30,6 +29,8 @@ import Database.Persist.MySQL ( withMySQLConn , connectUser , connectPassword , defaultConnectInfo) +#else +import Database.Persist.Sqlite (withSqliteConn) #endif import Database.Persist.TH import Test.Hspec From 0de82426345870921d8a7725885ac3d092350638 Mon Sep 17 00:00:00 2001 From: Felipe Lessa Date: Tue, 4 Mar 2014 09:25:14 -0300 Subject: [PATCH 14/42] Use persistent 1.3+ new limit/offset func (closes #35). This code was actually written by @gbwey and it's being manually merged with some changes by me. --- esqueleto.cabal | 2 +- src/Database/Esqueleto/Internal/Sql.hs | 25 +++++++------------------ 2 files changed, 8 insertions(+), 19 deletions(-) diff --git a/esqueleto.cabal b/esqueleto.cabal index 52398cd..86b7dbe 100644 --- a/esqueleto.cabal +++ b/esqueleto.cabal @@ -65,7 +65,7 @@ library build-depends: base >= 4.5 && < 4.8 , text >= 0.11 - , persistent >= 1.2 && < 1.4 + , persistent >= 1.3 && < 1.4 , transformers >= 0.2 , unordered-containers >= 0.2 , tagged >= 0.2 diff --git a/src/Database/Esqueleto/Internal/Sql.hs b/src/Database/Esqueleto/Internal/Sql.hs index a7865f7..cdde68d 100644 --- a/src/Database/Esqueleto/Internal/Sql.hs +++ b/src/Database/Esqueleto/Internal/Sql.hs @@ -65,7 +65,6 @@ import qualified Data.HashSet as HS import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Builder as TLB -import qualified Data.Text.Lazy.Builder.Int as TLBI import Database.Esqueleto.Internal.Language @@ -782,7 +781,7 @@ toRawSql mode (conn, firstIdentState) query = , makeGroupBy info groupByClause , makeHaving info havingClause , makeOrderBy info orderByClauses - , makeLimit info limitClause + , makeLimit info limitClause orderByClauses ] @@ -894,22 +893,12 @@ makeOrderBy info os = first ("\nORDER BY " <>) $ uncommas' (map mk os) orderByType DESC = " DESC" -makeLimit :: IdentInfo -> LimitClause -> (TLB.Builder, [PersistValue]) -makeLimit _ (Limit Nothing Nothing) = mempty -makeLimit _ (Limit Nothing (Just 0)) = mempty -makeLimit info (Limit ml mo) = (ret, mempty) - where - ret = TLB.singleton '\n' <> (limitTLB <> offsetTLB) - - limitTLB = - case ml of - Just l -> "LIMIT " <> TLBI.decimal l - Nothing -> TLB.fromText (connNoLimit $ fst info) - - offsetTLB = - case mo of - Just o -> " OFFSET " <> TLBI.decimal o - Nothing -> mempty +makeLimit :: IdentInfo -> LimitClause -> [OrderByClause] -> (TLB.Builder, [PersistValue]) +makeLimit (conn,_) (Limit ml mo) orderByClauses = + let limitRaw = connLimitOffset conn (v ml, v mo) hasOrderClause "\n" + hasOrderClause = not (null orderByClauses) + v = maybe 0 fromIntegral + in (TLB.fromText limitRaw, mempty) parens :: TLB.Builder -> TLB.Builder From c2b1750cd98e2f9c7e999a579747bec7fb5f8e91 Mon Sep 17 00:00:00 2001 From: Felipe Lessa Date: Tue, 4 Mar 2014 09:26:50 -0300 Subject: [PATCH 15/42] Bump version to 1.3.5. --- esqueleto.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/esqueleto.cabal b/esqueleto.cabal index 86b7dbe..82f313e 100644 --- a/esqueleto.cabal +++ b/esqueleto.cabal @@ -1,12 +1,12 @@ name: esqueleto -version: 1.3.4.6 +version: 1.3.5 synopsis: Bare bones, type-safe EDSL for SQL queries on persistent backends. homepage: https://github.com/meteficha/esqueleto license: BSD3 license-file: LICENSE author: Felipe Lessa maintainer: felipe.lessa@gmail.com -copyright: (c) 2012 Felipe Almeida Lessa +copyright: (c) 2012-2014 Felipe Almeida Lessa category: Database build-type: Simple cabal-version: >=1.8 From 5192a2b98e17edf65bf9b26f86614810058ea37c Mon Sep 17 00:00:00 2001 From: Felipe Lessa Date: Tue, 4 Mar 2014 09:51:50 -0300 Subject: [PATCH 16/42] Fix typo on doc (closes #36). --- src/Database/Esqueleto.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Database/Esqueleto.hs b/src/Database/Esqueleto.hs index 65954c4..383f0d7 100644 --- a/src/Database/Esqueleto.hs +++ b/src/Database/Esqueleto.hs @@ -237,7 +237,7 @@ import qualified Database.Persist -- -- Since @age@ is an optional @Person@ field, we use 'just' lift -- @val 18 :: SqlExpr (Value Int)@ into @just (val 18) :: --- SqlExpr (Value (Just Int))@. +-- SqlExpr (Value (Maybe Int))@. -- -- Implicit joins are represented by tuples. For example, to get -- the list of all blog posts and their authors, we could write: From 69b4be6e370cb256a50daf7417678e042b20d4c1 Mon Sep 17 00:00:00 2001 From: Tero Laitinen Date: Wed, 2 Apr 2014 17:30:28 +0300 Subject: [PATCH 17/42] unsafeSqlExtractSubField to support EXTRACT subfield FROM field-syntax --- src/Database/Esqueleto/Internal/Sql.hs | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/src/Database/Esqueleto/Internal/Sql.hs b/src/Database/Esqueleto/Internal/Sql.hs index 660e409..7eba11f 100644 --- a/src/Database/Esqueleto/Internal/Sql.hs +++ b/src/Database/Esqueleto/Internal/Sql.hs @@ -29,6 +29,7 @@ module Database.Esqueleto.Internal.Sql , unsafeSqlBinOp , unsafeSqlValue , unsafeSqlFunction + , unsafeSqlExtractSubField , UnsafeSqlFunctionArgument , rawSelectSource , runSource @@ -475,6 +476,17 @@ unsafeSqlFunction name arg = uncommas' $ map (\(ERaw _ f) -> f info) $ toArgList arg in (name <> parens argsTLB, argsVals) +-- | (Internal) An unsafe SQL function to extract a subfield from a compound +-- field, e.g. datetime. See 'unsafeSqlBinOp' for warnings. +unsafeSqlExtractSubField :: UnsafeSqlFunctionArgument a => + TLB.Builder -> a -> SqlExpr (Value b) +unsafeSqlExtractSubField subField arg = + ERaw Never $ \info -> + let (argsTLB, argsVals) = + uncommas' $ map (\(ERaw _ f) -> f info) $ toArgList arg + in ("EXTRACT" <> parens (subField <> " FROM " <> argsTLB), argsVals) + + class UnsafeSqlFunctionArgument a where toArgList :: a -> [SqlExpr (Value ())] instance (a ~ Value b) => UnsafeSqlFunctionArgument (SqlExpr a) where @@ -499,6 +511,7 @@ instance ( UnsafeSqlFunctionArgument a toArgList = toArgList . from4 + -- | (Internal) Coerce a value's type from 'SqlExpr (Value a)' to -- 'SqlExpr (Value b)'. You should /not/ use this function -- unless you know what you're doing! From 67522cecbcabe200a9d1205600878af0c3a6152c Mon Sep 17 00:00:00 2001 From: Felipe Lessa Date: Wed, 2 Apr 2014 11:45:32 -0300 Subject: [PATCH 18/42] Bump version to 1.3.6. --- esqueleto.cabal | 2 +- src/Database/Esqueleto/Internal/Sql.hs | 2 ++ 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/esqueleto.cabal b/esqueleto.cabal index 82f313e..bf85a04 100644 --- a/esqueleto.cabal +++ b/esqueleto.cabal @@ -1,5 +1,5 @@ name: esqueleto -version: 1.3.5 +version: 1.3.6 synopsis: Bare bones, type-safe EDSL for SQL queries on persistent backends. homepage: https://github.com/meteficha/esqueleto license: BSD3 diff --git a/src/Database/Esqueleto/Internal/Sql.hs b/src/Database/Esqueleto/Internal/Sql.hs index f276882..0882571 100644 --- a/src/Database/Esqueleto/Internal/Sql.hs +++ b/src/Database/Esqueleto/Internal/Sql.hs @@ -482,6 +482,8 @@ unsafeSqlFunction name arg = -- | (Internal) An unsafe SQL function to extract a subfield from a compound -- field, e.g. datetime. See 'unsafeSqlBinOp' for warnings. +-- +-- Since: 1.3.6. unsafeSqlExtractSubField :: UnsafeSqlFunctionArgument a => TLB.Builder -> a -> SqlExpr (Value b) unsafeSqlExtractSubField subField arg = From a21e930259311b0a94b9f168c2088e881d05c327 Mon Sep 17 00:00:00 2001 From: David McBride Date: Wed, 2 Apr 2014 11:52:23 -0400 Subject: [PATCH 19/42] Conduit no longer exports resourcet related functions. --- src/Database/Esqueleto/Internal/Sql.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/Database/Esqueleto/Internal/Sql.hs b/src/Database/Esqueleto/Internal/Sql.hs index 0882571..dbea46c 100644 --- a/src/Database/Esqueleto/Internal/Sql.hs +++ b/src/Database/Esqueleto/Internal/Sql.hs @@ -51,7 +51,7 @@ import Control.Monad ((>=>), ap, void, MonadPlus(..)) import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.Logger (MonadLogger) import Control.Monad.Trans.Class (lift) -import Control.Monad.Trans.Resource (MonadResourceBase) +import Control.Monad.Trans.Resource (runResourceT, ResourceT, MonadResourceBase) import Data.Int (Int64) import Data.List (intersperse) import Data.Monoid (Monoid(..), (<>)) @@ -543,7 +543,7 @@ rawSelectSource :: ( SqlSelect a r , MonadResourceBase m ) => Mode -> SqlQuery a - -> SqlPersistT m (C.Source (C.ResourceT (SqlPersistT m)) r) + -> SqlPersistT m (C.Source (ResourceT (SqlPersistT m)) r) rawSelectSource mode query = src where src = do @@ -571,7 +571,7 @@ selectSource :: ( SqlSelect a r , MonadLogger m , MonadResourceBase m ) => SqlQuery a - -> SqlPersistT m (C.Source (C.ResourceT (SqlPersistT m)) r) + -> SqlPersistT m (C.Source (ResourceT (SqlPersistT m)) r) selectSource = rawSelectSource SELECT @@ -631,7 +631,7 @@ selectDistinctSource , MonadLogger m , MonadResourceBase m ) => SqlQuery a - -> SqlPersistT m (C.Source (C.ResourceT (SqlPersistT m)) r) + -> SqlPersistT m (C.Source (ResourceT (SqlPersistT m)) r) selectDistinctSource = rawSelectSource SELECT_DISTINCT @@ -646,9 +646,9 @@ selectDistinct = selectDistinctSource >=> runSource -- | (Internal) Run a 'C.Source' of rows. runSource :: MonadResourceBase m => - C.Source (C.ResourceT (SqlPersistT m)) r + C.Source (ResourceT (SqlPersistT m)) r -> SqlPersistT m [r] -runSource src = C.runResourceT $ src C.$$ CL.consume +runSource src = runResourceT $ src C.$$ CL.consume ---------------------------------------------------------------------- From c642b71b9910c33dab83fcb9ec40754a76f06ec8 Mon Sep 17 00:00:00 2001 From: Felipe Lessa Date: Wed, 2 Apr 2014 13:25:21 -0300 Subject: [PATCH 20/42] Bump version to 1.3.7. --- esqueleto.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/esqueleto.cabal b/esqueleto.cabal index bf85a04..7a1e851 100644 --- a/esqueleto.cabal +++ b/esqueleto.cabal @@ -1,5 +1,5 @@ name: esqueleto -version: 1.3.6 +version: 1.3.7 synopsis: Bare bones, type-safe EDSL for SQL queries on persistent backends. homepage: https://github.com/meteficha/esqueleto license: BSD3 From 24bad8ba0b15c27de4f28902774fc967ed2f5591 Mon Sep 17 00:00:00 2001 From: Felipe Lessa Date: Wed, 2 Apr 2014 23:27:30 -0300 Subject: [PATCH 21/42] Update test deps. --- esqueleto.cabal | 5 +++-- test/Test.hs | 12 ++++++------ 2 files changed, 9 insertions(+), 8 deletions(-) diff --git a/esqueleto.cabal b/esqueleto.cabal index 7a1e851..9d44bdc 100644 --- a/esqueleto.cabal +++ b/esqueleto.cabal @@ -84,13 +84,14 @@ test-suite test build-depends: -- Library dependencies used on the tests. No need to -- specify versions since they'll use the same as above. - base, persistent, transformers, conduit, text + base, persistent, transformers, resourcet, text -- Test-only dependencies + , conduit >= 1.1 , containers , HUnit , QuickCheck - , hspec >= 1.3 && < 1.9 + , hspec >= 1.9 , persistent-sqlite >= 1.2 && < 1.4 , persistent-template >= 1.2 && < 1.4 , monad-control diff --git a/test/Test.hs b/test/Test.hs index 1790839..a7901ae 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -35,7 +35,7 @@ import Database.Persist.Sqlite (withSqliteConn) import Database.Persist.TH import Test.Hspec -import qualified Data.Conduit as C +import qualified Control.Monad.Trans.Resource as R import qualified Data.Set as S import qualified Data.List as L @@ -808,7 +808,7 @@ insert' v = flip Entity v <$> insert v type RunDbMonad m = ( MonadBaseControl IO m, MonadIO m, MonadLogger m - , C.MonadUnsafeIO m, C.MonadThrow m ) + , R.MonadThrow m ) #if defined (WITH_POSTGRESQL) || defined (WITH_MYSQL) -- With SQLite and in-memory databases, a separate connection implies a @@ -817,7 +817,7 @@ type RunDbMonad m = ( MonadBaseControl IO m, MonadIO m, MonadLogger m -- TODO: there is certainly a better way... cleanDB :: (forall m. RunDbMonad m - => SqlPersistT (C.ResourceT m) ()) + => SqlPersistT (R.ResourceT m) ()) cleanDB = do delete $ from $ \(blogpost :: SqlExpr (Entity BlogPost))-> return () delete $ from $ \(follow :: SqlExpr (Entity Follow)) -> return () @@ -825,7 +825,7 @@ cleanDB = do #endif -run, runSilent, runVerbose :: (forall m. RunDbMonad m => SqlPersistT (C.ResourceT m) a) -> IO a +run, runSilent, runVerbose :: (forall m. RunDbMonad m => SqlPersistT (R.ResourceT m) a) -> IO a runSilent act = runNoLoggingT $ run_worker act runVerbose act = runStderrLoggingT $ run_worker act run = @@ -838,9 +838,9 @@ verbose :: Bool verbose = True -run_worker :: RunDbMonad m => SqlPersistT (C.ResourceT m) a -> m a +run_worker :: RunDbMonad m => SqlPersistT (R.ResourceT m) a -> m a run_worker act = - C.runResourceT . + R.runResourceT . #if defined(WITH_POSTGRESQL) withPostgresqlConn "host=localhost port=5432 user=test dbname=test" . #elif defined (WITH_MYSQL) From 37b51d24c6a0a354dca7e54f3b3044062921b171 Mon Sep 17 00:00:00 2001 From: Felipe Lessa Date: Wed, 2 Apr 2014 23:27:52 -0300 Subject: [PATCH 22/42] Bump version to 1.3.8. --- esqueleto.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/esqueleto.cabal b/esqueleto.cabal index 9d44bdc..468e501 100644 --- a/esqueleto.cabal +++ b/esqueleto.cabal @@ -1,5 +1,5 @@ name: esqueleto -version: 1.3.7 +version: 1.3.8 synopsis: Bare bones, type-safe EDSL for SQL queries on persistent backends. homepage: https://github.com/meteficha/esqueleto license: BSD3 From f701df4a8dd1cf370c8d75d9dc4fec3851dafd73 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Thu, 3 Apr 2014 08:31:21 +0300 Subject: [PATCH 23/42] Allow hspec 1.8 --- esqueleto.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/esqueleto.cabal b/esqueleto.cabal index 468e501..a61ff5e 100644 --- a/esqueleto.cabal +++ b/esqueleto.cabal @@ -91,7 +91,7 @@ test-suite test , containers , HUnit , QuickCheck - , hspec >= 1.9 + , hspec >= 1.8 , persistent-sqlite >= 1.2 && < 1.4 , persistent-template >= 1.2 && < 1.4 , monad-control From a578719907484139b998816b18e91d53737f8a0d Mon Sep 17 00:00:00 2001 From: Felipe Lessa Date: Thu, 3 Apr 2014 08:47:54 -0300 Subject: [PATCH 24/42] Bump version to 1.3.9. --- esqueleto.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/esqueleto.cabal b/esqueleto.cabal index a61ff5e..2eaf47b 100644 --- a/esqueleto.cabal +++ b/esqueleto.cabal @@ -1,5 +1,5 @@ name: esqueleto -version: 1.3.8 +version: 1.3.9 synopsis: Bare bones, type-safe EDSL for SQL queries on persistent backends. homepage: https://github.com/meteficha/esqueleto license: BSD3 From 97afd44d1d6b8e46e9549a89719a5cf5b4014068 Mon Sep 17 00:00:00 2001 From: Erik de Castro Lopo Date: Sun, 17 Nov 2013 19:57:04 +1100 Subject: [PATCH 25/42] Silence 'Defined but not used' warnings in tests. --- test/Test.hs | 36 ++++++++++++++++++------------------ 1 file changed, 18 insertions(+), 18 deletions(-) diff --git a/test/Test.hs b/test/Test.hs index a7901ae..85e886c 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -122,8 +122,8 @@ main = do run $ do p1k <- insert p1 p2k <- insert p2 - f1k <- insert (Follow p1k p2k) - f2k <- insert (Follow p2k p1k) + _f1k <- insert (Follow p1k p2k) + _f2k <- insert (Follow p2k p1k) ret <- select $ from $ \followA -> do let subquery = @@ -138,8 +138,8 @@ main = do run $ do p1k <- insert p1 p2k <- insert p2 - f1k <- insert (Follow p1k p2k) - f2k <- insert (Follow p2k p1k) + _f1k <- insert (Follow p1k p2k) + _f2k <- insert (Follow p2k p1k) ret <- select $ from $ \followA -> do where_ $ exists $ @@ -368,9 +368,9 @@ main = do it "works with random_" $ run $ do #if defined(WITH_POSTGRESQL) || defined(WITH_MYSQL) - ret <- select $ return (random_ :: SqlExpr (Value Double)) + _ <- select $ return (random_ :: SqlExpr (Value Double)) #else - ret <- select $ return (random_ :: SqlExpr (Value Int)) + _ <- select $ return (random_ :: SqlExpr (Value Int)) #endif return () @@ -530,10 +530,10 @@ main = do it "works with asc random_" $ run $ do - p1e <- insert' p1 - p2e <- insert' p2 - p3e <- insert' p3 - p4e <- insert' p4 + _p1e <- insert' p1 + _p2e <- insert' p2 + _p3e <- insert' p3 + _p4e <- insert' p4 rets <- fmap S.fromList $ replicateM 11 $ @@ -680,7 +680,7 @@ main = do it "GROUP BY works with HAVING" $ run $ do p1k <- insert p1 - p2k <- insert p2 + _p2k <- insert p2 p3k <- insert p3 replicateM_ 3 (insert $ BlogPost "" p1k) replicateM_ 7 (insert $ BlogPost "" p3k) @@ -700,7 +700,7 @@ main = do run $ do p1k <- insert p1 p2k <- insert p2 - p3k <- insert p3 + _p3k <- insert p3 ret <- select $ from $ \p -> do where_ (p ^. PersonName `in_` valList (personName <$> [p1, p2])) @@ -710,9 +710,9 @@ main = do it "IN works for valList (null list)" $ run $ do - p1k <- insert p1 - p2k <- insert p2 - p3k <- insert p3 + _p1k <- insert p1 + _p2k <- insert p2 + _p3k <- insert p3 ret <- select $ from $ \p -> do where_ (p ^. PersonName `in_` valList []) @@ -722,7 +722,7 @@ main = do it "IN works for subList_select" $ run $ do p1k <- insert p1 - p2k <- insert p2 + _p2k <- insert p2 p3k <- insert p3 _ <- insert (BlogPost "" p1k) _ <- insert (BlogPost "" p3k) @@ -756,7 +756,7 @@ main = do it "EXISTS works for subList_select" $ run $ do p1k <- insert p1 - p2k <- insert p2 + _p2k <- insert p2 p3k <- insert p3 _ <- insert (BlogPost "" p1k) _ <- insert (BlogPost "" p3k) @@ -792,7 +792,7 @@ main = do _ <- insert p3 insertSelect $ from $ \p -> do return $ BlogPost <# val "FakePost" <&> (p ^. PersonId) - ret <- select $ from (\(b::(SqlExpr (Entity BlogPost))) -> return countRows) + ret <- select $ from (\(_::(SqlExpr (Entity BlogPost))) -> return countRows) liftIO $ ret `shouldBe` [Value (3::Int)] From 8df36fb9c7dcc9f2b695efbd257d9afcd9ec9a62 Mon Sep 17 00:00:00 2001 From: Erik de Castro Lopo Date: Tue, 8 Apr 2014 17:53:49 +1000 Subject: [PATCH 26/42] esqueleto.cabal : Relax constraint on conduit. --- esqueleto.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/esqueleto.cabal b/esqueleto.cabal index 2eaf47b..42fb46c 100644 --- a/esqueleto.cabal +++ b/esqueleto.cabal @@ -71,7 +71,7 @@ library , tagged >= 0.2 , monad-logger - , conduit + , conduit >= 1.1 , resourcet hs-source-dirs: src/ ghc-options: -Wall From d37331e04dd0f9916abef92fc6c3aa883f25e0a4 Mon Sep 17 00:00:00 2001 From: Erik de Castro Lopo Date: Tue, 8 Apr 2014 17:54:18 +1000 Subject: [PATCH 27/42] Implement orderBy[rand] modifier. --- src/Database/Esqueleto.hs | 2 +- src/Database/Esqueleto/Internal/Language.hs | 3 +++ src/Database/Esqueleto/Internal/Sql.hs | 5 +++++ 3 files changed, 9 insertions(+), 1 deletion(-) diff --git a/src/Database/Esqueleto.hs b/src/Database/Esqueleto.hs index 383f0d7..b9fa17b 100644 --- a/src/Database/Esqueleto.hs +++ b/src/Database/Esqueleto.hs @@ -38,7 +38,7 @@ module Database.Esqueleto -- $gettingstarted -- * @esqueleto@'s Language - Esqueleto( where_, on, groupBy, orderBy, asc, desc, limit, offset, having + Esqueleto( where_, on, groupBy, orderBy, rand, asc, desc, limit, offset, having , sub_select, sub_selectDistinct, (^.), (?.) , val, isNothing, just, nothing, joinV, countRows, count, not_ , (==.), (>=.), (>.), (<=.), (<.), (!=.), (&&.), (||.) diff --git a/src/Database/Esqueleto/Internal/Language.hs b/src/Database/Esqueleto/Internal/Language.hs index 48ad25b..4bfde9a 100644 --- a/src/Database/Esqueleto/Internal/Language.hs +++ b/src/Database/Esqueleto/Internal/Language.hs @@ -174,6 +174,9 @@ class (Functor query, Applicative query, Monad query) => -- | @OFFSET@. Usually used with 'limit'. offset :: Int64 -> query () + -- | @ORDER BY random()@ clause. + rand :: expr OrderBy + -- | @HAVING@. -- -- /Since: 1.2.2/ diff --git a/src/Database/Esqueleto/Internal/Sql.hs b/src/Database/Esqueleto/Internal/Sql.hs index dbea46c..3cff09f 100644 --- a/src/Database/Esqueleto/Internal/Sql.hs +++ b/src/Database/Esqueleto/Internal/Sql.hs @@ -256,6 +256,7 @@ data SqlExpr a where -- A 'SqlExpr' accepted only by 'orderBy'. EOrderBy :: OrderByType -> SqlExpr (Value a) -> SqlExpr OrderBy + EOrderRandom :: SqlExpr OrderBy -- A 'SqlExpr' accepted only by 'set'. ESet :: (SqlExpr (Entity val) -> SqlExpr (Value ())) -> SqlExpr (Update val) @@ -322,6 +323,8 @@ instance Esqueleto SqlQuery SqlExpr SqlBackend where asc = EOrderBy ASC desc = EOrderBy DESC + rand = EOrderRandom + limit n = Q $ W.tell mempty { sdLimitClause = Limit (Just n) Nothing } offset n = Q $ W.tell mempty { sdLimitClause = Limit Nothing (Just n) } @@ -903,7 +906,9 @@ makeOrderBy :: IdentInfo -> [OrderByClause] -> (TLB.Builder, [PersistValue]) makeOrderBy _ [] = mempty makeOrderBy info os = first ("\nORDER BY " <>) $ uncommas' (map mk os) where + mk :: OrderByClause -> (TLB.Builder, [PersistValue]) mk (EOrderBy t (ERaw p f)) = first ((<> orderByType t) . parensM p) (f info) + mk EOrderRandom = first ((<> "RANDOM()")) mempty orderByType ASC = " ASC" orderByType DESC = " DESC" From 60bc2b1a8b8354b6565793d2a40b8cc4287fc15c Mon Sep 17 00:00:00 2001 From: Erik de Castro Lopo Date: Tue, 8 Apr 2014 18:10:32 +1000 Subject: [PATCH 28/42] Add test for orderRandom. --- test/Test.hs | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/test/Test.hs b/test/Test.hs index 85e886c..e1f3152 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -795,6 +795,21 @@ 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" $ + run $ do + _ <- insert p1 + _ <- insert p2 + _ <- insert p3 + _ <- insert p4 + ret1 <- fmap (map unValue) $ select $ from $ \p -> do + orderBy [rand] + return (p ^. PersonId) + ret2 <- fmap (map unValue) $ select $ from $ \p -> do + orderBy [rand] + return (p ^. PersonId) + + liftIO $ (ret1 == ret2) `shouldBe` False ---------------------------------------------------------------------- @@ -859,3 +874,6 @@ run_worker act = #else (runMigrationSilent migrateAll >>) $ act #endif + +unValue :: Value a -> a +unValue (Value a) = a From 466de1f96b12940d2e88d9deb2823c53803b5d25 Mon Sep 17 00:00:00 2001 From: Felipe Lessa Date: Tue, 8 Apr 2014 19:31:51 -0300 Subject: [PATCH 29/42] Add "since" to rand's doc. --- src/Database/Esqueleto/Internal/Language.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/Database/Esqueleto/Internal/Language.hs b/src/Database/Esqueleto/Internal/Language.hs index 4bfde9a..4dfe66d 100644 --- a/src/Database/Esqueleto/Internal/Language.hs +++ b/src/Database/Esqueleto/Internal/Language.hs @@ -175,6 +175,8 @@ class (Functor query, Applicative query, Monad query) => offset :: Int64 -> query () -- | @ORDER BY random()@ clause. + -- + -- /Since: 1.3.10/ rand :: expr OrderBy -- | @HAVING@. From babca941fce52c272e085ea7d241f048e532e4f0 Mon Sep 17 00:00:00 2001 From: Felipe Lessa Date: Tue, 8 Apr 2014 19:32:11 -0300 Subject: [PATCH 30/42] Bump version to 1.3.10. --- esqueleto.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/esqueleto.cabal b/esqueleto.cabal index 42fb46c..0a14528 100644 --- a/esqueleto.cabal +++ b/esqueleto.cabal @@ -1,5 +1,5 @@ name: esqueleto -version: 1.3.9 +version: 1.3.10 synopsis: Bare bones, type-safe EDSL for SQL queries on persistent backends. homepage: https://github.com/meteficha/esqueleto license: BSD3 From d021a8184ce6244198435b276738b9cd824c6ad8 Mon Sep 17 00:00:00 2001 From: Erik de Castro Lopo Date: Fri, 11 Apr 2014 14:35:12 +1000 Subject: [PATCH 31/42] Test.hs : Reduce chance of 'orderBy [rand]' randomly failing. --- test/Test.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/test/Test.hs b/test/Test.hs index e1f3152..5cc2007 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -802,6 +802,10 @@ main = do _ <- insert p2 _ <- insert p3 _ <- insert p4 + _ <- insert $ Person "Jane" Nothing + _ <- insert $ Person "Mark" Nothing + _ <- insert $ Person "Sarah" Nothing + _ <- insert $ Person "Paul" Nothing ret1 <- fmap (map unValue) $ select $ from $ \p -> do orderBy [rand] return (p ^. PersonId) From 80d3e7c9cd6b2cf75ae76812d64fbe3f91927a06 Mon Sep 17 00:00:00 2001 From: Felipe Lessa Date: Sun, 13 Apr 2014 23:55:13 -0300 Subject: [PATCH 32/42] Lower the chance of false negatives even more. --- test/Test.hs | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/test/Test.hs b/test/Test.hs index 5cc2007..b6c0193 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -798,14 +798,15 @@ main = do describe "rand works" $ do it "returns result in random order" $ run $ do - _ <- insert p1 - _ <- insert p2 - _ <- insert p3 - _ <- insert p4 - _ <- insert $ Person "Jane" Nothing - _ <- insert $ Person "Mark" Nothing - _ <- insert $ Person "Sarah" Nothing - _ <- insert $ Person "Paul" Nothing + replicateM_ 20 $ do + _ <- insert p1 + _ <- insert p2 + _ <- insert p3 + _ <- insert p4 + _ <- insert $ Person "Jane" Nothing + _ <- insert $ Person "Mark" Nothing + _ <- insert $ Person "Sarah" Nothing + insert $ Person "Paul" Nothing ret1 <- fmap (map unValue) $ select $ from $ \p -> do orderBy [rand] return (p ^. PersonId) From a3d3ce0e1d42a9b7fd96893cf7e40ad2ef7ec8a9 Mon Sep 17 00:00:00 2001 From: Felipe Lessa Date: Sun, 13 Apr 2014 23:55:49 -0300 Subject: [PATCH 33/42] Bump version to 1.3.11. --- esqueleto.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/esqueleto.cabal b/esqueleto.cabal index 0a14528..d83342a 100644 --- a/esqueleto.cabal +++ b/esqueleto.cabal @@ -1,5 +1,5 @@ name: esqueleto -version: 1.3.10 +version: 1.3.11 synopsis: Bare bones, type-safe EDSL for SQL queries on persistent backends. homepage: https://github.com/meteficha/esqueleto license: BSD3 From ab9e57b2d0febfcfa99d51e0358f6d82c57b9a9c Mon Sep 17 00:00:00 2001 From: Felipe Lessa Date: Mon, 14 Apr 2014 14:57:48 -0300 Subject: [PATCH 34/42] Export veryUnsafeCoerceSqlExprValueList (fixes #62). --- src/Database/Esqueleto/Internal/Sql.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Database/Esqueleto/Internal/Sql.hs b/src/Database/Esqueleto/Internal/Sql.hs index 3cff09f..1c4fa1e 100644 --- a/src/Database/Esqueleto/Internal/Sql.hs +++ b/src/Database/Esqueleto/Internal/Sql.hs @@ -42,6 +42,7 @@ module Database.Esqueleto.Internal.Sql , IdentInfo , SqlSelect(..) , veryUnsafeCoerceSqlExprValue + , veryUnsafeCoerceSqlExprValueList ) where import Control.Applicative (Applicative(..), (<$>), (<$)) From 951f027d68c50b32725410fb6dada79ad3db7314 Mon Sep 17 00:00:00 2001 From: Felipe Lessa Date: Mon, 14 Apr 2014 14:58:26 -0300 Subject: [PATCH 35/42] Bump version to 1.3.12. --- esqueleto.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/esqueleto.cabal b/esqueleto.cabal index d83342a..a7c6573 100644 --- a/esqueleto.cabal +++ b/esqueleto.cabal @@ -1,5 +1,5 @@ name: esqueleto -version: 1.3.11 +version: 1.3.12 synopsis: Bare bones, type-safe EDSL for SQL queries on persistent backends. homepage: https://github.com/meteficha/esqueleto license: BSD3 From 3bd5c8506ac16399ec85f26ffdc27ea1ff45460b Mon Sep 17 00:00:00 2001 From: Felipe Lessa Date: Wed, 23 Apr 2014 11:42:07 -0300 Subject: [PATCH 36/42] Allow esqueleto's functions to be used on top of transformers. Instead of using SqlPersistT, now it uses MonadSqlPersist. --- src/Database/Esqueleto/Internal/Sql.hs | 88 +++++++++++++------------- 1 file changed, 43 insertions(+), 45 deletions(-) diff --git a/src/Database/Esqueleto/Internal/Sql.hs b/src/Database/Esqueleto/Internal/Sql.hs index 1c4fa1e..04f3e90 100644 --- a/src/Database/Esqueleto/Internal/Sql.hs +++ b/src/Database/Esqueleto/Internal/Sql.hs @@ -50,15 +50,13 @@ import Control.Arrow ((***), first) import Control.Exception (throw, throwIO) import Control.Monad ((>=>), ap, void, MonadPlus(..)) import Control.Monad.IO.Class (MonadIO(..)) -import Control.Monad.Logger (MonadLogger) import Control.Monad.Trans.Class (lift) -import Control.Monad.Trans.Resource (runResourceT, ResourceT, MonadResourceBase) +import Control.Monad.Trans.Resource (MonadResource) import Data.Int (Int64) import Data.List (intersperse) import Data.Monoid (Monoid(..), (<>)) import Data.Proxy (Proxy(..)) import Database.Esqueleto.Internal.PersistentImport -import qualified Control.Monad.Trans.Reader as R import qualified Control.Monad.Trans.State as S import qualified Control.Monad.Trans.Writer as W import qualified Data.Conduit as C @@ -543,15 +541,15 @@ veryUnsafeCoerceSqlExprValueList EEmptyList = -- | (Internal) Execute an @esqueleto@ @SELECT@ 'SqlQuery' inside -- @persistent@'s 'SqlPersistT' monad. rawSelectSource :: ( SqlSelect a r - , MonadLogger m - , MonadResourceBase m ) + , MonadResource m + , MonadSqlPersist m ) => Mode -> SqlQuery a - -> SqlPersistT m (C.Source (ResourceT (SqlPersistT m)) r) + -> m (C.Source m r) rawSelectSource mode query = src where src = do - conn <- SqlPersistT R.ask + conn <- askSqlConn return $ run conn C.$= massage run conn = @@ -572,10 +570,10 @@ rawSelectSource mode query = src -- | Execute an @esqueleto@ @SELECT@ query inside @persistent@'s -- 'SqlPersistT' monad and return a 'C.Source' of rows. selectSource :: ( SqlSelect a r - , MonadLogger m - , MonadResourceBase m ) + , MonadResource m + , MonadSqlPersist m ) => SqlQuery a - -> SqlPersistT m (C.Source (ResourceT (SqlPersistT m)) r) + -> m (C.Source m r) selectSource = rawSelectSource SELECT @@ -621,9 +619,9 @@ selectSource = rawSelectSource SELECT -- function composition that the @p@ inside the query is of type -- @SqlExpr (Entity Person)@. select :: ( SqlSelect a r - , MonadLogger m - , MonadResourceBase m ) - => SqlQuery a -> SqlPersistT m [r] + , MonadResource m + , MonadSqlPersist m ) + => SqlQuery a -> m [r] select = selectSource >=> runSource @@ -632,27 +630,27 @@ select = selectSource >=> runSource -- rows. selectDistinctSource :: ( SqlSelect a r - , MonadLogger m - , MonadResourceBase m ) + , MonadResource m + , MonadSqlPersist m ) => SqlQuery a - -> SqlPersistT m (C.Source (ResourceT (SqlPersistT m)) r) + -> m (C.Source m r) selectDistinctSource = rawSelectSource SELECT_DISTINCT -- | Execute an @esqueleto@ @SELECT DISTINCT@ query inside -- @persistent@'s 'SqlPersistT' monad and return a list of rows. selectDistinct :: ( SqlSelect a r - , MonadLogger m - , MonadResourceBase m ) - => SqlQuery a -> SqlPersistT m [r] + , MonadResource m + , MonadSqlPersist m ) + => SqlQuery a -> m [r] selectDistinct = selectDistinctSource >=> runSource -- | (Internal) Run a 'C.Source' of rows. -runSource :: MonadResourceBase m => - C.Source (ResourceT (SqlPersistT m)) r - -> SqlPersistT m [r] -runSource src = runResourceT $ src C.$$ CL.consume +runSource :: MonadResource m => + C.Source m r + -> m [r] +runSource src = src C.$$ CL.consume ---------------------------------------------------------------------- @@ -660,14 +658,14 @@ runSource src = runResourceT $ src C.$$ CL.consume -- | (Internal) Execute an @esqueleto@ statement inside -- @persistent@'s 'SqlPersistT' monad. -rawEsqueleto :: ( MonadLogger m - , MonadResourceBase m +rawEsqueleto :: ( MonadResource m + , MonadSqlPersist m , SqlSelect a r ) => Mode -> SqlQuery a - -> SqlPersistT m Int64 + -> m Int64 rawEsqueleto mode query = do - conn <- SqlPersistT R.ask + conn <- askSqlConn uncurry rawExecuteCount $ first builderToText $ toRawSql mode (conn, initialIdentState) query @@ -695,18 +693,18 @@ rawEsqueleto mode query = do -- from $ \\(appointment :: SqlExpr (Entity Appointment)) -> -- return () -- @ -delete :: ( MonadLogger m - , MonadResourceBase m ) +delete :: ( MonadResource m + , MonadSqlPersist m ) => SqlQuery () - -> SqlPersistT m () + -> m () delete = void . deleteCount -- | Same as 'delete', but returns the number of rows affected. -deleteCount :: ( MonadLogger m - , MonadResourceBase m ) +deleteCount :: ( MonadResource m + , MonadSqlPersist m ) => SqlQuery () - -> SqlPersistT m Int64 + -> m Int64 deleteCount = rawEsqueleto DELETE @@ -722,38 +720,38 @@ deleteCount = rawEsqueleto DELETE -- set p [ PersonAge =. just (val thisYear) -. p ^. PersonBorn ] -- where_ $ isNull (p ^. PersonAge) -- @ -update :: ( MonadLogger m - , MonadResourceBase m +update :: ( MonadResource m + , MonadSqlPersist m , SqlEntity val ) => (SqlExpr (Entity val) -> SqlQuery ()) - -> SqlPersistT m () + -> m () update = void . updateCount -- | Same as 'update', but returns the number of rows affected. -updateCount :: ( MonadLogger m - , MonadResourceBase m +updateCount :: ( MonadResource m + , MonadSqlPersist m , SqlEntity val ) => (SqlExpr (Entity val) -> SqlQuery ()) - -> SqlPersistT m Int64 + -> m Int64 updateCount = rawEsqueleto UPDATE . from -- | Insert a 'PersistField' for every selected value. -insertSelect :: ( MonadLogger m - , MonadResourceBase m +insertSelect :: ( MonadResource m + , MonadSqlPersist m , PersistEntity a ) - => SqlQuery (SqlExpr (Insertion a)) -> SqlPersistT m () + => SqlQuery (SqlExpr (Insertion a)) -> m () insertSelect = void . rawEsqueleto (INSERT_INTO SELECT) . fmap EInsertFinal -- | Insert a 'PersistField' for every unique selected value. insertSelectDistinct - :: ( MonadLogger m - , MonadResourceBase m + :: ( MonadResource m + , MonadSqlPersist m , PersistEntity a ) - => SqlQuery (SqlExpr (Insertion a)) -> SqlPersistT m () + => SqlQuery (SqlExpr (Insertion a)) -> m () insertSelectDistinct = void . rawEsqueleto (INSERT_INTO SELECT_DISTINCT) . fmap EInsertFinal From 8e52ef6b519ee00fb980742fc8c3281a5f9edaa3 Mon Sep 17 00:00:00 2001 From: Felipe Lessa Date: Wed, 23 Apr 2014 11:42:32 -0300 Subject: [PATCH 37/42] Major version bump to 1.4. Although most people's code won't break, this release generalizes many type signatures and changes the signatures of the conduit versions. --- esqueleto.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/esqueleto.cabal b/esqueleto.cabal index a7c6573..427b974 100644 --- a/esqueleto.cabal +++ b/esqueleto.cabal @@ -1,5 +1,5 @@ name: esqueleto -version: 1.3.12 +version: 1.4 synopsis: Bare bones, type-safe EDSL for SQL queries on persistent backends. homepage: https://github.com/meteficha/esqueleto license: BSD3 From b04be7d6159aaea776c332d185dba9944f00d9a7 Mon Sep 17 00:00:00 2001 From: Felipe Lessa Date: Thu, 8 May 2014 10:47:51 -0300 Subject: [PATCH 38/42] Small doc improvements. --- src/Database/Esqueleto/Internal/Language.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/Database/Esqueleto/Internal/Language.hs b/src/Database/Esqueleto/Internal/Language.hs index 4dfe66d..d6ca398 100644 --- a/src/Database/Esqueleto/Internal/Language.hs +++ b/src/Database/Esqueleto/Internal/Language.hs @@ -334,13 +334,15 @@ infixr 2 ||., `InnerJoin`, `CrossJoin`, `LeftOuterJoin`, `RightOuterJoin`, `Full -- @('^.')@ or @('?.')@ to get a 'Value' from an 'Entity'. data Value a = Value a deriving (Eq, Ord, Show, Typeable) -- Note: because of GHC bug #6124 we use @data@ instead of @newtype@. +-- --- | A list of single values. There's a limited set of funcitons +-- | A list of single values. There's a limited set of functions -- able to work with this data type (such as 'subList_select', -- 'valList', 'in_' and 'exists'). data ValueList a = ValueList a deriving (Eq, Ord, Show, Typeable) -- Note: because of GHC bug #6124 we use @data@ instead of @newtype@. +-- -- | A wrapper type for for any @expr (Value a)@ for all a. From 46fa0cafcfc74f854c473832722761618e44af5a Mon Sep 17 00:00:00 2001 From: Felipe Lessa Date: Thu, 8 May 2014 10:55:08 -0300 Subject: [PATCH 39/42] Export an unValue function. --- src/Database/Esqueleto.hs | 1 + src/Database/Esqueleto/Internal/Language.hs | 8 ++++++++ test/Test.hs | 3 --- 3 files changed, 9 insertions(+), 3 deletions(-) diff --git a/src/Database/Esqueleto.hs b/src/Database/Esqueleto.hs index b9fa17b..d91827c 100644 --- a/src/Database/Esqueleto.hs +++ b/src/Database/Esqueleto.hs @@ -51,6 +51,7 @@ module Database.Esqueleto , set, (=.), (+=.), (-=.), (*=.), (/=.) ) , from , Value(..) + , unValue , ValueList(..) , OrderBy -- ** Joins diff --git a/src/Database/Esqueleto/Internal/Language.hs b/src/Database/Esqueleto/Internal/Language.hs index d6ca398..b71f066 100644 --- a/src/Database/Esqueleto/Internal/Language.hs +++ b/src/Database/Esqueleto/Internal/Language.hs @@ -16,6 +16,7 @@ module Database.Esqueleto.Internal.Language Esqueleto(..) , from , Value(..) + , unValue , ValueList(..) , SomeValue(..) , ToSomeValues(..) @@ -337,6 +338,13 @@ data Value a = Value a deriving (Eq, Ord, Show, Typeable) -- +-- | Unwrap a 'Value'. +-- +-- /Since: 1.4.1/ +unValue :: Value a -> a +unValue (Value a) = a + + -- | A list of single values. There's a limited set of functions -- able to work with this data type (such as 'subList_select', -- 'valList', 'in_' and 'exists'). diff --git a/test/Test.hs b/test/Test.hs index b6c0193..dc16400 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -879,6 +879,3 @@ run_worker act = #else (runMigrationSilent migrateAll >>) $ act #endif - -unValue :: Value a -> a -unValue (Value a) = a From dbe4689cd7b7007c563e70416946d9b0ed583fe0 Mon Sep 17 00:00:00 2001 From: Felipe Lessa Date: Thu, 8 May 2014 10:55:24 -0300 Subject: [PATCH 40/42] Bump version to 1.4.1. --- esqueleto.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/esqueleto.cabal b/esqueleto.cabal index 427b974..c708f0d 100644 --- a/esqueleto.cabal +++ b/esqueleto.cabal @@ -1,5 +1,5 @@ name: esqueleto -version: 1.4 +version: 1.4.1 synopsis: Bare bones, type-safe EDSL for SQL queries on persistent backends. homepage: https://github.com/meteficha/esqueleto license: BSD3 From 2be1c1bc200ff243e23ed3fce186c28f487a9ff2 Mon Sep 17 00:00:00 2001 From: Felipe Lessa Date: Wed, 21 May 2014 14:16:26 -0300 Subject: [PATCH 41/42] Reword package description (fixes #65). --- esqueleto.cabal | 31 +++++++++++++++---------------- 1 file changed, 15 insertions(+), 16 deletions(-) diff --git a/esqueleto.cabal b/esqueleto.cabal index c708f0d..38b9fa8 100644 --- a/esqueleto.cabal +++ b/esqueleto.cabal @@ -1,6 +1,6 @@ name: esqueleto version: 1.4.1 -synopsis: Bare bones, type-safe EDSL for SQL queries on persistent backends. +synopsis: Type-safe EDSL for SQL queries on persistent backends. homepage: https://github.com/meteficha/esqueleto license: BSD3 license-file: LICENSE @@ -11,28 +11,27 @@ category: Database build-type: Simple cabal-version: >=1.8 description: - @persistent@ is a library for type-safe data serialization. It - has many kinds of backends, such as SQL backends - (@persistent-mysql@, @persistent-postgresql@, - @persistent-sqlite@) and NoSQL backends (@persistent-mongoDB@). - . - While @persistent@ is a nice library for storing and retrieving - records, currently it has a poor interface for SQL backends - compared to SQL itself. For example, it's extremely hard to do - a type-safe @JOIN@ on a many-to-one relation, and simply - impossible to do any other kinds of @JOIN@s (including for the - very common many-to-many relations). Users have the option of - writing raw SQL, but that's error prone and not type-checked. - . @esqueleto@ is a bare bones, type-safe EDSL for SQL queries that works with unmodified @persistent@ SQL backends. Its - language closely resembles SQL, so (a) you don't have to learn - new concepts, just new syntax, and (b) it's fairly easy to + language closely resembles SQL, so you don't have to learn + new concepts, just new syntax, and it's fairly easy to predict the generated SQL and optimize it for your backend. Most kinds of errors committed when writing SQL are caught as compile-time errors---although it is possible to write type-checked @esqueleto@ queries that fail at runtime. . + @persistent@ is a library for type-safe data serialization. It + has many kinds of backends, such as SQL backends + (@persistent-mysql@, @persistent-postgresql@, + @persistent-sqlite@) and NoSQL backends (@persistent-mongoDB@). + While @persistent@ is a nice library for storing and retrieving + records, including with filters, it does not try to support + some of the features that are specific to SQL backends. In + particular, @esqueleto@ is the recommended library for + type-safe @JOIN@s on @persistent@ SQL backends. (The + alternative is using raw SQL, but that's error prone and does + not offer any composability.) + . Currently, @SELECT@s, @UPDATE@s, @INSERT@s and @DELETE@s are supported. Not all SQL features are available, but most of them can be easily added (especially functions), so please open an issue or send a pull request if From f77ff7b1f787d5ca5ef919d1c24e1352257225d4 Mon Sep 17 00:00:00 2001 From: Felipe Lessa Date: Wed, 21 May 2014 14:19:59 -0300 Subject: [PATCH 42/42] Bump version to 1.4.1.2. --- esqueleto.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/esqueleto.cabal b/esqueleto.cabal index 38b9fa8..7121e8c 100644 --- a/esqueleto.cabal +++ b/esqueleto.cabal @@ -1,5 +1,5 @@ name: esqueleto -version: 1.4.1 +version: 1.4.1.2 synopsis: Type-safe EDSL for SQL queries on persistent backends. homepage: https://github.com/meteficha/esqueleto license: BSD3