From 970deabfc2fb192fb3c0657b39ee5eca8d818f90 Mon Sep 17 00:00:00 2001 From: Eric Easley Date: Fri, 5 Feb 2016 15:32:19 -0800 Subject: [PATCH 1/3] Add `ToBaseId` --- src/Database/Esqueleto.hs | 2 +- src/Database/Esqueleto/Internal/Language.hs | 43 +++++++++++++++++++++ src/Database/Esqueleto/Internal/Sql.hs | 2 + 3 files changed, 46 insertions(+), 1 deletion(-) diff --git a/src/Database/Esqueleto.hs b/src/Database/Esqueleto.hs index 33085ec..413c76c 100644 --- a/src/Database/Esqueleto.hs +++ b/src/Database/Esqueleto.hs @@ -52,7 +52,7 @@ module Database.Esqueleto , subList_select, subList_selectDistinct, valList, justList , in_, notIn, exists, notExists , set, (=.), (+=.), (-=.), (*=.), (/=.) - , case_ ) + , case_, toBaseId) , when_ , then_ , else_ diff --git a/src/Database/Esqueleto/Internal/Language.hs b/src/Database/Esqueleto/Internal/Language.hs index 9b8a56c..ff42e3d 100644 --- a/src/Database/Esqueleto/Internal/Language.hs +++ b/src/Database/Esqueleto/Internal/Language.hs @@ -32,6 +32,7 @@ module Database.Esqueleto.Internal.Language , Insertion , LockingKind(..) , SqlString + , ToBaseId(..) -- * The guts , JoinKind(..) , IsJoinKind(..) @@ -555,6 +556,42 @@ class (Functor query, Applicative query, Monad query) => -- /Since: 2.1.2/ case_ :: PersistField a => [(expr (Value Bool), expr (Value a))] -> expr (Value a) -> expr (Value a) + -- | Convert an entity's key into another entity's. + -- + -- This function is to be used when you change an entity's @Id@ to be + -- that of another entity. For example: + -- + -- @ + -- Bar + -- barNum Int + -- Foo + -- Id BarId + -- fooNum Int + -- @ + -- + -- For this example, declare: + -- + -- @ + -- instance ToBaseId Foo where + -- type BaseEnt Foo = Bar + -- toBaseIdWitness = FooKey + -- @ + -- + -- Now you're able to write queries such as: + -- + -- @ + -- 'select' $ + -- 'from' $ \(bar `'InnerJoin`` foo) -> do + -- 'on' ('toBaseId' (foo '^.' FooId) '==.' bar '^.' BarId) + -- return (bar, foo) + -- @ + -- + -- Note: this function may be unsafe to use in conditions not like the + -- one of the example above. + -- + -- /Since: 2.4.3/ + toBaseId :: ToBaseId ent => expr (Value (Key ent)) -> expr (Value (Key (BaseEnt ent))) + {-# DEPRECATED sub_selectDistinct "Since 2.2.4: use 'sub_select' and 'distinct'." #-} {-# DEPRECATED subList_selectDistinct "Since 2.2.4: use 'subList_select' and 'distinct'." #-} @@ -837,6 +874,12 @@ instance SqlString Html where -- | /Since: 2.4.0/ instance SqlString a => SqlString (Maybe a) where +-- | Class that enables one to use 'toBaseId' to convert an entity's +-- key on a query into another (cf. 'toBaseId'). +class ToBaseId ent where + type BaseEnt ent :: * + toBaseIdWitness :: Key (BaseEnt ent) -> Key ent + -- | @FROM@ clause: bring entities into scope. -- diff --git a/src/Database/Esqueleto/Internal/Sql.hs b/src/Database/Esqueleto/Internal/Sql.hs index 04867a0..aa1f793 100644 --- a/src/Database/Esqueleto/Internal/Sql.hs +++ b/src/Database/Esqueleto/Internal/Sql.hs @@ -524,6 +524,8 @@ instance Esqueleto SqlQuery SqlExpr SqlBackend where (EInsert _ _) <&> (ECompositeKey _) = unexpectedCompositeKeyError "(<&>)" case_ = unsafeSqlCase + toBaseId = veryUnsafeCoerceSqlExprValue + instance ToSomeValues SqlExpr (SqlExpr (Value a)) where toSomeValues a = [SomeValue a] From a104b30da2494b9258f5575c62b2d43957be41b1 Mon Sep 17 00:00:00 2001 From: Eric Easley Date: Mon, 8 Feb 2016 10:54:29 -0800 Subject: [PATCH 2/3] Fix pedantic errors --- src/Database/Esqueleto/Internal/Language.hs | 2 -- src/Database/Esqueleto/Internal/Sql.hs | 6 +++--- test/Test.hs | 21 +++++++-------------- 3 files changed, 10 insertions(+), 19 deletions(-) diff --git a/src/Database/Esqueleto/Internal/Language.hs b/src/Database/Esqueleto/Internal/Language.hs index ff42e3d..ef0bc15 100644 --- a/src/Database/Esqueleto/Internal/Language.hs +++ b/src/Database/Esqueleto/Internal/Language.hs @@ -44,7 +44,6 @@ module Database.Esqueleto.Internal.Language , else_ ) where -import Control.Applicative (Applicative(..), (<$>)) import Control.Exception (Exception) import Data.Int (Int64) import Data.Typeable (Typeable) @@ -52,7 +51,6 @@ import Database.Esqueleto.Internal.PersistentImport import Text.Blaze.Html (Html) import qualified Data.ByteString as B -import qualified Data.ByteString.Lazy as BL import qualified Data.Text as T import qualified Data.Text.Lazy as TL diff --git a/src/Database/Esqueleto/Internal/Sql.hs b/src/Database/Esqueleto/Internal/Sql.hs index aa1f793..dba8129 100644 --- a/src/Database/Esqueleto/Internal/Sql.hs +++ b/src/Database/Esqueleto/Internal/Sql.hs @@ -50,7 +50,6 @@ module Database.Esqueleto.Internal.Sql , veryUnsafeCoerceSqlExprValueList ) where -import Control.Applicative (Applicative(..), (<$>), (<$)) import Control.Arrow ((***), first) import Control.Exception (throw, throwIO) import Control.Monad (ap, MonadPlus(..), liftM) @@ -60,7 +59,7 @@ import Control.Monad.Trans.Resource (MonadResource) import Data.Acquire (with, allocateAcquire, Acquire) import Data.Int (Int64) import Data.List (intersperse) -import Data.Monoid (Last(..), Monoid(..), (<>)) +import Data.Monoid (Last(..), (<>)) import Data.Proxy (Proxy(..)) import Database.Esqueleto.Internal.PersistentImport import Database.Persist.Sql.Util (entityColumnNames, entityColumnCount, parseEntityValues, isIdField, hasCompositeKey) @@ -417,6 +416,7 @@ instance Esqueleto SqlQuery SqlExpr SqlBackend where where toDistinctOn :: SqlExpr OrderBy -> SqlExpr DistinctOn toDistinctOn (EOrderBy _ f) = EDistinctOn f + toDistinctOn EOrderRandom = error "toDistinctOn get an EOrderRandom but expect an EOrderBy" sub_select = sub SELECT sub_selectDistinct = sub_select . distinct @@ -647,7 +647,7 @@ unsafeSqlBinOpComposite op sep a b = ERaw Parens $ compose (listify a) (listify deconstruct :: (TLB.Builder, [PersistValue]) -> ([TLB.Builder], [PersistValue]) deconstruct ("?", [PersistList vals]) = (replicate (length vals) "?", vals) - deconstruct (b, []) = (TLB.fromLazyText <$> TL.splitOn "," (TLB.toLazyText b), []) + deconstruct (b', []) = (TLB.fromLazyText <$> TL.splitOn "," (TLB.toLazyText b'), []) deconstruct x = err $ "cannot deconstruct " ++ show x ++ "." compose f1 f2 info diff --git a/test/Test.hs b/test/Test.hs index 80c6784..2a57761 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -18,21 +18,17 @@ #-} module Main (main) where -import Control.Applicative ((<$>)) -import Control.Arrow ((&&&)) -import Control.Exception (IOException) import Control.Monad (forM_, replicateM, replicateM_, void) import Control.Monad.IO.Class (MonadIO(liftIO)) import Control.Monad.Logger (MonadLogger(..), runStderrLoggingT, runNoLoggingT) import Control.Monad.Trans.Control (MonadBaseControl(..)) import Control.Monad.Trans.Reader (ReaderT) import Data.Char (toLower, toUpper) -import Data.List (sortBy) import Data.Monoid ((<>)) -import Data.Ord (comparing) import Database.Esqueleto #if defined (WITH_POSTGRESQL) import Database.Persist.Postgresql (withPostgresqlConn) +import qualified Database.Esqueleto.PostgreSQL as EP #elif defined (WITH_MYSQL) import Database.Persist.MySQL ( withMySQLConn , connectHost @@ -53,7 +49,6 @@ import qualified Control.Monad.Trans.Resource as R import qualified Data.List as L import qualified Data.Set as S import qualified Data.Text.Lazy.Builder as TLB -import qualified Database.Esqueleto.PostgreSQL as EP import qualified Database.Esqueleto.Internal.Sql as EI @@ -808,8 +803,6 @@ main = do orderBy [asc title] return title liftIO $ ret `shouldBe` [ Value t1, Value t2, Value t3 ] - it "works on a simple example (selectDistinct)" $ - selDistTest selectDistinct it "works on a simple example (select . distinct)" $ selDistTest (select . distinct) @@ -1307,15 +1300,15 @@ main = do -- reaction to the clause. let sanityCheck kind syntax = do let complexQuery = - from $ \(p1 `InnerJoin` p2) -> do - on (p1 ^. PersonName ==. p2 ^. PersonName) - where_ (p1 ^. PersonFavNum >. val 2) - orderBy [desc (p2 ^. PersonAge)] + from $ \(pl `InnerJoin` pr) -> do + on (pl ^. PersonName ==. pr ^. PersonName) + where_ (pl ^. PersonFavNum >. val 2) + orderBy [desc (pr ^. PersonAge)] limit 3 offset 9 - groupBy (p1 ^. PersonId) + groupBy (pl ^. PersonId) having (countRows <. val (0 :: Int)) - return (p1, p2) + return (pl, pr) queryWithClause1 = do r <- complexQuery locking kind From dc72d1bcd8fb76020160e033e539c5cf470ce557 Mon Sep 17 00:00:00 2001 From: Eric Easley Date: Tue, 9 Feb 2016 12:04:01 -0800 Subject: [PATCH 3/3] Export ToBaseId --- src/Database/Esqueleto.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Database/Esqueleto.hs b/src/Database/Esqueleto.hs index 413c76c..eb135c2 100644 --- a/src/Database/Esqueleto.hs +++ b/src/Database/Esqueleto.hs @@ -53,6 +53,7 @@ module Database.Esqueleto , in_, notIn, exists, notExists , set, (=.), (+=.), (-=.), (*=.), (/=.) , case_, toBaseId) + , ToBaseId(..) , when_ , then_ , else_