Remove entity specific constructors from SqlExpr

src/Database/Esqueleto/Experimental/From.hs

@@ -52,7 +52,7 @@ instance PersistEntity a => From (Table a) where
     runFrom e@Table = do
         let ed = entityDef $ getVal e
         ident <- newIdentFor (entityDB ed)
-        let entity = EEntity ident
+        let entity = unsafeSqlEntity ident
         pure $ (entity, FromStart ident ed)
           where
             getVal ::  Table ent -> Proxy ent

src/Database/Esqueleto/Experimental/ToAlias.hs

@@ -5,8 +5,7 @@
 module Database.Esqueleto.Experimental.ToAlias
     where
 
-import           Database.Esqueleto.Internal.Internal         hiding (From,
+import Database.Esqueleto.Internal.Internal hiding (From, from, on)
-                                                               from, on)
 import Database.Esqueleto.Internal.PersistentImport
 
 {-# DEPRECATED ToAliasT "This type alias doesn't do anything. Please delete it. Will be removed in the next release." #-}
@@ -17,22 +16,26 @@ class ToAlias a where
     toAlias :: a -> SqlQuery a
 
 instance ToAlias (SqlExpr (Value a)) where
-    toAlias (ERaw m f)
+    toAlias (ERaw m f) =
-      | Nothing <- sqlExprMetaAlias m = do
+        case sqlExprMetaAlias m of
+            Just _ -> pure $ ERaw m f
+            Nothing -> do
                 ident <- newIdentFor (DBName "v")
                 pure $ ERaw noMeta{sqlExprMetaAlias = Just ident} $ \_ info ->
                     let (b, v) = f Never info
                     in (b <> " AS " <> useIdent info ident, [])
 
+
 instance ToAlias (SqlExpr (Entity a)) where
-    toAlias v@(EAliasedEntityReference _ _) = pure v
+    toAlias (ERaw m f) = do
-    toAlias v@(EAliasedEntity _ _) = pure v
-    toAlias (EEntity tableIdent) = do
        ident <- newIdentFor (DBName "v")
-       pure $ EAliasedEntity ident tableIdent
+       pure $ ERaw m{sqlExprMetaIsReference = False, sqlExprMetaAlias = Just ident} f
 
 instance ToAlias (SqlExpr (Maybe (Entity a))) where
-    toAlias (EMaybe e) = EMaybe <$> toAlias e
+    -- FIXME: Code duplication because the compiler doesnt like half final encoding
+    toAlias (ERaw m f) = do
+       ident <- newIdentFor (DBName "v")
+       pure $ ERaw m{sqlExprMetaIsReference = False, sqlExprMetaAlias = Just ident} f
 
 instance (ToAlias a, ToAlias b) => ToAlias (a,b) where
     toAlias (a,b) = (,) <$> toAlias a <*> toAlias b

src/Database/Esqueleto/Experimental/ToAliasReference.hs

@@ -6,8 +6,7 @@ module Database.Esqueleto.Experimental.ToAliasReference
     where
 
 import Database.Esqueleto.Experimental.ToAlias
-import           Database.Esqueleto.Internal.Internal         hiding (From,
+import Database.Esqueleto.Internal.Internal hiding (From, from, on)
-                                                               from, on)
 import Database.Esqueleto.Internal.PersistentImport
 
 {-# DEPRECATED ToAliasReferenceT "This type alias doesn't do anything. Please delete it. Will be removed in the next release." #-}
@@ -19,16 +18,24 @@ class ToAliasReference a where
 
 instance ToAliasReference (SqlExpr (Value a)) where
     toAliasReference aliasSource (ERaw m _)
-      | Just alias <- sqlExprMetaAlias m = pure $ ERaw noMeta $ \p info ->
+      | Just alias <- sqlExprMetaAlias m = pure $ ERaw m $ \_ info ->
             (useIdent info aliasSource <> "." <> useIdent info alias, [])
+    toAliasReference _ e = pure e
 
 instance ToAliasReference (SqlExpr (Entity a)) where
-    toAliasReference aliasSource (EAliasedEntity ident _) = pure $ EAliasedEntityReference aliasSource ident
+    toAliasReference aliasSource (ERaw m _)
-    toAliasReference _ e@(EEntity _) = toAlias e
+      | Just _ <- sqlExprMetaAlias m, False <- sqlExprMetaIsReference m =
-    toAliasReference s   (EAliasedEntityReference _ b) = pure $ EAliasedEntityReference s b
+          pure $ ERaw m{sqlExprMetaIsReference = True} $ \_ info ->
+              (useIdent info aliasSource, [])
+    toAliasReference _ e = pure e
 
 instance ToAliasReference (SqlExpr (Maybe (Entity a))) where
-    toAliasReference s (EMaybe e) = EMaybe <$> toAliasReference s e
+    -- FIXME: Code duplication because the compiler doesnt like half final encoding
+    toAliasReference aliasSource (ERaw m f)
+      | Just _ <- sqlExprMetaAlias m, False <- sqlExprMetaIsReference m =
+          pure $ ERaw m{sqlExprMetaIsReference = True} $ \_ info ->
+              (useIdent info aliasSource, [])
+    toAliasReference s e = pure e
 
 
 instance (ToAliasReference a, ToAliasReference b) => ToAliasReference (a, b) where

src/Database/Esqueleto/Experimental/ToMaybe.hs

@@ -21,7 +21,7 @@ instance ToMaybe (SqlExpr (Maybe a)) where
 
 instance ToMaybe (SqlExpr (Entity a)) where
     type ToMaybeT (SqlExpr (Entity a)) = SqlExpr (Maybe (Entity a))
-    toMaybe = EMaybe
+    toMaybe (ERaw f m) = (ERaw f m)
 
 instance ToMaybe (SqlExpr (Value a)) where
     type ToMaybeT (SqlExpr (Value a)) = SqlExpr (Value (Maybe (Nullable a)))

src/Database/Esqueleto/Internal/Internal.hs

@@ -88,7 +88,7 @@ fromStart
 fromStart = do
     let ed = entityDef (Proxy :: Proxy a)
     ident <- newIdentFor (entityDB ed)
-    let ret = EEntity ident
+    let ret = unsafeSqlEntity ident 
         f' = FromStart ident ed
     return (EPreprocessedFrom ret f')
 
@@ -103,7 +103,7 @@ fromStartMaybe = maybelize <$> fromStart
     maybelize
         :: SqlExpr (PreprocessedFrom (SqlExpr (Entity a)))
         -> SqlExpr (PreprocessedFrom (SqlExpr (Maybe (Entity a))))
-    maybelize (EPreprocessedFrom ret f') = EPreprocessedFrom (EMaybe ret) f'
+    maybelize (EPreprocessedFrom (ERaw m f) f') = EPreprocessedFrom (ERaw m f) f'
 
 -- | (Internal) Do a @JOIN@.
 fromJoin
@@ -527,9 +527,12 @@ subSelectUnsafe = sub SELECT
     => SqlExpr (Entity val)
     -> EntityField val typ
     -> SqlExpr (Value typ)
-(EAliasedEntityReference source base) ^. field =
+e ^. field
+    | isIdField field = idFieldValue
+    | ERaw m f <- e, Just alias <- sqlExprMetaAlias m =
         ERaw noMeta $ \_ info -> 
-        (useIdent info source <> "." <> useIdent info (aliasedEntityColumnIdent base fieldDef), [])
+            f Never info <> ("." <> useIdent info (aliasedEntityColumnIdent alias fieldDef), [])
+    | otherwise = ERaw noMeta $ \_ info -> (dot info $ persistFieldDef field, [])
   where
     fieldDef =
         if isIdField field then
@@ -537,13 +540,6 @@ subSelectUnsafe = sub SELECT
             head $ entityKeyFields ed
         else
             persistFieldDef field
-
-    ed = entityDef $ getEntityVal (Proxy :: Proxy (SqlExpr (Entity val)))
-
-e ^. field
-    | isIdField field = idFieldValue
-    | otherwise = ERaw noMeta $ \_ info -> (dot info $ persistFieldDef field, [])
-  where
     idFieldValue =
         case entityKeyFields ed of
             idField:[] ->
@@ -558,29 +554,19 @@ e ^. field
     ed = entityDef $ getEntityVal (Proxy :: Proxy (SqlExpr (Entity val)))
 
     dot info fieldDef =
-        useIdent info sourceIdent <> "." <> fieldIdent
+        sourceIdent info <> "." <> fieldIdent
       where
         sourceIdent =
             case e of
-                EEntity ident -> ident
+                ERaw _ f -> fmap fst $ f Never
-                EAliasedEntity baseI _ -> baseI
-                EAliasedEntityReference a b ->
-                    error $ unwords
-                        [ "Used (^.) with an EAliasedEntityReference."
-                        , "Please file this as an Esqueleto bug."
-                        , "EAliasedEntityReference", show a, show b
-                        ]
         fieldIdent =
             case e of
-                EEntity _ -> fromDBName info (fieldDB fieldDef)
+                ERaw m f -> 
-                EAliasedEntity baseI _ -> useIdent info $ aliasedEntityColumnIdent baseI fieldDef
+                    case sqlExprMetaAlias m of
-                EAliasedEntityReference a b ->
+                      Just baseI -> 
-                    error $ unwords
+                          useIdent info $ aliasedEntityColumnIdent baseI fieldDef
-                        [ "Used (^.) with an EAliasedEntityReference."
+                      Nothing ->
-                        , "Please file this as an Esqueleto bug."
+                         fromDBName info (fieldDB fieldDef)
-                        , "EAliasedEntityReference", show a, show b
-                        ]
-
 
 -- | Project an SqlExpression that may be null, guarding against null cases.
 withNonNull
@@ -598,7 +584,7 @@ withNonNull field f = do
     => SqlExpr (Maybe (Entity val))
     -> EntityField val typ
     -> SqlExpr (Value (Maybe typ))
-EMaybe r ?. field = just (r ^. field)
+ERaw m f ?. field = just (ERaw m f ^. field)
 
 -- | Lift a constant value from Haskell-land to the query.
 val  :: PersistField typ => typ -> SqlExpr (Value typ)
@@ -2012,12 +1998,14 @@ useIdent info (I ident) = fromDBName info $ DBName ident
 data SqlExprMeta = SqlExprMeta
     { sqlExprMetaCompositeFields :: Maybe (IdentInfo -> [TLB.Builder])
     , sqlExprMetaAlias :: Maybe Ident
+    , sqlExprMetaIsReference :: Bool
     } 
 
 noMeta :: SqlExprMeta
 noMeta = SqlExprMeta 
     { sqlExprMetaCompositeFields = Nothing
     , sqlExprMetaAlias = Nothing
+    , sqlExprMetaIsReference = False
     }
 
 hasCompositeKeyMeta :: SqlExprMeta -> Bool
@@ -2028,16 +2016,6 @@ hasCompositeKeyMeta = Maybe.isJust . sqlExprMetaCompositeFields
 -- There are many comments describing the constructors of this
 -- data type.  However, Haddock doesn't like GADTs, so you'll have to read them by hitting \"Source\".
 data SqlExpr a where
-    -- An entity, created by 'from' (cf. 'fromStart').
-    EEntity  :: Ident -> SqlExpr (Entity val)
-    --                Base     Table
-    EAliasedEntity :: Ident -> Ident -> SqlExpr (Entity val)
-    --                         Source   Base
-    EAliasedEntityReference :: Ident -> Ident -> SqlExpr (Entity val)
-
-    -- Just a tag stating that something is nullable.
-    EMaybe   :: SqlExpr a -> SqlExpr (Maybe a)
-
     -- Raw expression: states whether parenthesis are needed
     -- around this expression, and takes information about the SQL
     -- connection (mainly for escaping names) and returns both an
@@ -2270,6 +2248,10 @@ unsafeSqlValue :: TLB.Builder -> SqlExpr (Value a)
 unsafeSqlValue v = ERaw noMeta $ \_ _ -> (v, mempty)
 {-# INLINE unsafeSqlValue #-}
 
+unsafeSqlEntity :: PersistEntity ent => Ident -> SqlExpr (Entity ent)
+unsafeSqlEntity ident = ERaw noMeta $ \_ info ->
+    (useIdent info ident, [])
+
 valueToFunctionArg :: IdentInfo -> SqlExpr (Value a) -> (TLB.Builder, [PersistValue])
 valueToFunctionArg info v =
     case v of
@@ -3035,9 +3017,24 @@ unescapedColumnNames ent =
 
 -- | You may return an 'Entity' from a 'select' query.
 instance PersistEntity a => SqlSelect (SqlExpr (Entity a)) (Entity a) where
-    sqlSelectCols info expr@(EEntity ident) = ret
+    sqlSelectCols info expr@(ERaw m f) 
-      where
+      | Just baseIdent <- sqlExprMetaAlias m, False <- sqlExprMetaIsReference m = 
-        process ed = uncommas $
+          let process ed = uncommas $
+                           map ((name <>) . aliasName) $
+                           unescapedColumnNames ed
+              aliasName columnName = (fromDBName info columnName) <> " AS " <> aliasedColumnName baseIdent info (unDBName columnName)
+              name = fst (f Never info) <> "."
+              ed = entityDef $ getEntityVal $ return expr
+          in (process ed, mempty)
+      | Just baseIdent <- sqlExprMetaAlias m, True <- sqlExprMetaIsReference m = 
+          let process ed = uncommas $
+                           map ((name <>) . aliasedColumnName baseIdent info . unDBName) $
+                           unescapedColumnNames ed
+              name = fst (f Never info) <> "."
+              ed = entityDef $ getEntityVal $ return expr
+          in (process ed, mempty)
+      | otherwise =
+          let process ed = uncommas $
                          map ((name <>) . TLB.fromText) $
                          entityColumnNames ed (fst info)
               -- 'name' is the biggest difference between 'RawSql' and
@@ -3046,26 +3043,10 @@ instance PersistEntity a => SqlSelect (SqlExpr (Entity a)) (Entity a) where
               -- clause), while 'rawSql' assumes that it's just the
               -- name of the table (which doesn't allow self-joins, for
               -- example).
-        name = useIdent info ident <> "."
+              name = fst (f Never info) <> "."
-        ret = let ed = entityDef $ getEntityVal $ return expr
+              ed = entityDef $ getEntityVal $ return expr
-              in (process ed, mempty)
-    sqlSelectCols info expr@(EAliasedEntity aliasIdent tableIdent) = ret
-      where
-        process ed = uncommas $
-                     map ((name <>) . aliasName) $
-                     unescapedColumnNames ed
-        aliasName columnName = (fromDBName info columnName) <> " AS " <> aliasedColumnName aliasIdent info (unDBName columnName)
-        name = useIdent info tableIdent <> "."
-        ret = let ed = entityDef $ getEntityVal $ return expr
-              in (process ed, mempty)
-    sqlSelectCols info expr@(EAliasedEntityReference sourceIdent baseIdent) = ret
-      where
-        process ed = uncommas $
-                     map ((name <>) . aliasedColumnName baseIdent info . unDBName) $
-                     unescapedColumnNames ed
-        name = useIdent info sourceIdent <> "."
-        ret = let ed = entityDef $ getEntityVal $ return expr
           in (process ed, mempty)
+
     sqlSelectColCount = entityColumnCount . entityDef . getEntityVal
     sqlSelectProcessRow = parseEntityValues ed
       where
@@ -3076,7 +3057,7 @@ getEntityVal = const Proxy
 
 -- | You may return a possibly-@NULL@ 'Entity' from a 'select' query.
 instance PersistEntity a => SqlSelect (SqlExpr (Maybe (Entity a))) (Maybe (Entity a)) where
-    sqlSelectCols info (EMaybe ent) = sqlSelectCols info ent
+    sqlSelectCols info (ERaw m f) = sqlSelectCols info (ERaw m f :: SqlExpr (Entity a)) 
     sqlSelectColCount = sqlSelectColCount . fromEMaybe
       where
         fromEMaybe :: Proxy (SqlExpr (Maybe e)) -> Proxy (SqlExpr e)

src/Database/Esqueleto/Internal/Sql.hs

@@ -38,6 +38,7 @@ module Database.Esqueleto.Internal.Sql
     , unsafeSqlCase
     , unsafeSqlBinOp
     , unsafeSqlValue
+    , unsafeSqlEntity
     , unsafeSqlCastAs
     , unsafeSqlFunction
     , unsafeSqlExtractSubField

src/Database/Esqueleto/PostgreSQL.hs

@@ -36,17 +36,16 @@ import           Data.Semigroup
 import Control.Arrow (first, (***))
 import Control.Exception (throw)
 import Control.Monad (void)
-import           Control.Monad.IO.Class                       (MonadIO (..))
+import Control.Monad.IO.Class (MonadIO(..))
 import qualified Control.Monad.Trans.Reader as R
 import Data.Int (Int64)
-import           Data.List.NonEmpty                           (NonEmpty ((:|)))
+import Data.List.NonEmpty (NonEmpty((:|)))
 import qualified Data.List.NonEmpty as NonEmpty
-import           Data.Proxy                                   (Proxy (..))
+import Data.Proxy (Proxy(..))
 import qualified Data.Text.Internal.Builder as TLB
 import Data.Time.Clock (UTCTime)
 import Database.Esqueleto.Internal.Internal hiding (random_)
-import           Database.Esqueleto.Internal.PersistentImport hiding (upsert,
+import Database.Esqueleto.Internal.PersistentImport hiding (upsert, upsertBy)
-                                                               upsertBy)
 import Database.Persist.Class (OnlyOneUniqueKey)
 
 -- | (@random()@) Split out into database specific modules
@@ -306,9 +305,9 @@ insertSelectWithConflictCount unique query conflictQuery = do
     proxy = Proxy
     updates = conflictQuery entCurrent entExcluded
     combine (tlb1,vals1) (tlb2,vals2) = (builderToText (tlb1 `mappend` tlb2), vals1 ++ vals2)
-    entExcluded = EEntity $ I "excluded"
+    entExcluded = unsafeSqlEntity (I "excluded")
     tableName = unDBName . entityDB . entityDef
-    entCurrent = EEntity $ I (tableName proxy)
+    entCurrent = unsafeSqlEntity (I (tableName proxy))
     uniqueDef = toUniqueDef unique
     constraint = TLB.fromText . unDBName . uniqueDBName $ uniqueDef
     renderedUpdates :: (BackendCompatible SqlBackend backend) => backend -> (TLB.Builder, [PersistValue])

test/Common/Test.hs

@@ -62,8 +62,7 @@ module Common.Test
     , Key(..)
     ) where
 
-import           Control.Monad                          (forM_, replicateM,
+import Control.Monad (forM_, replicateM, replicateM_, void)
-                                                         replicateM_, void)
 import Control.Monad.Catch (MonadCatch)
 import Control.Monad.Reader (ask)
 import Data.Either
@@ -71,10 +70,8 @@ import           Data.Time
 #if __GLASGOW_HASKELL__ >= 806
 import Control.Monad.Fail (MonadFail)
 #endif
-import           Control.Monad.IO.Class                 (MonadIO (liftIO))
+import Control.Monad.IO.Class (MonadIO(liftIO))
-import           Control.Monad.Logger                   (MonadLogger (..),
+import Control.Monad.Logger (MonadLogger(..), NoLoggingT, runNoLoggingT)
-                                                         NoLoggingT,
-                                                         runNoLoggingT)
 import Control.Monad.Trans.Reader (ReaderT)
 import qualified Data.Attoparsec.Text as AP
 import Data.Char (toLower, toUpper)
@@ -86,8 +83,7 @@ import           Database.Persist.TH
 import Test.Hspec
 import UnliftIO
 
-import           Data.Conduit                           (ConduitT, runConduit,
+import Data.Conduit (ConduitT, runConduit, (.|))
-                                                         (.|))
 import qualified Data.Conduit.List as CL
 import qualified Data.List as L
 import qualified Data.Set as S
@@ -390,7 +386,6 @@ testSubSelect run = do
 
     describe "subSelectList" $ do
         it "is safe on empty databases as well as good databases" $ run $ do
-            liftIO $ putStrLn "hello"
             let query =
                     from $ \n -> do
                     where_ $ n ^. NumbersInt `in_` do
@@ -399,10 +394,7 @@ testSubSelect run = do
                             where_ $ n' ^. NumbersInt >=. val 3
                             pure (n' ^. NumbersInt)
                     pure n
-            empty <- do
+            empty <- select query
-                liftIO . print =<<  renderQuerySelect query
-                select query
-            liftIO $ putStrLn "goodbye"
 
             full <- do
                 setup
@@ -895,12 +887,15 @@ testSelectSubQuery run = describe "select subquery" $ do
         l1Deeds <- mapM (\k -> insert' $ Deed k (entityKey l1e)) (map show [1..3 :: Int])
         let l1WithDeeds = do d <- l1Deeds
                              pure (l1e, Just d)
-        ret <- select $ Experimental.from $ do
+        let q = Experimental.from $ do
                   (lords :& deeds) <-
                       Experimental.from $ Table @Lord
                       `LeftOuterJoin` Table @Deed
                       `Experimental.on` (\(l :& d) -> just (l ^. LordId) ==. d ?. DeedOwnerId)
                   pure (lords, deeds)
+
+        liftIO . print =<< renderQuerySelect q
+        ret <- select q
         liftIO $ ret `shouldMatchList` ((l3e, Nothing) : l1WithDeeds)
 
     it "lets you order by alias" $ run $ do
@@ -1847,9 +1842,10 @@ testRenderSql run = do
       (c, expr) <- run $ do
         conn <- ask
         let Right c = P.mkEscapeChar conn
+        let user = EI.unsafeSqlEntity (EI.I "user")
+            blogPost = EI.unsafeSqlEntity (EI.I "blog_post")
         pure $ (,) c $ EI.renderExpr conn $
-          EI.EEntity (EI.I "user") ^. PersonId
+          user ^. PersonId ==. blogPost ^. BlogPostAuthorId
-          ==. EI.EEntity (EI.I "blog_post") ^. BlogPostAuthorId
       expr
         `shouldBe`
           Text.intercalate (Text.singleton c) ["", "user", ".", "id", ""]
@@ -1861,23 +1857,6 @@ testRenderSql run = do
       expr <- run $ ask >>= \c -> pure $ EI.renderExpr c (val (PersonKey 0) ==. val (PersonKey 1))
       expr `shouldBe` "? = ?"
 
-  describe "EEntity Ident behavior" $ do
-      let render :: SqlExpr (Entity val) -> Text.Text
-          render (EI.EEntity (EI.I ident)) = ident
-          render _ = error "guess we gotta handle this in the test suite now"
-      it "renders sensibly" $ run $ do
-          _ <- insert $ Foo 2
-          _ <- insert $ Foo 3
-          _ <- insert $ Person "hello" Nothing Nothing 3
-          results <- select $
-              from $ \(a `LeftOuterJoin` b) -> do
-              on $ a ^. FooName ==. b ^. PersonFavNum
-              pure (val (render a), val (render b))
-          liftIO $
-              head results
-              `shouldBe`
-              (Value "Foo", Value "Person")
-
   describe "ExprParser" $ do
     let parse parser = AP.parseOnly (parser '#')
     describe "parseEscapedChars" $ do