Bugfix rollup: Fix issue with extra characters in generated SQL; Fix ToAliasReference for already referenced values; Fix Alias/Reference for Maybe Entity (#191)

* Fix issue with extra characters. Extra parens in valueList caused issues in mysql. Extra backticks in value reference names * update changelog and bump version number * Fix issue caused by toAliasReference failing to reindex an alias reference by its new alias source * Add support for SqlExpr (Maybe (Entity a))) to aliasing in Experimental. Fix #193 * Update changelog with new PR name. Fix name shadowing in test. * Fix binary operations(i.e. ==.) on aliased values. * no need for version bump since 3.3.3.3 hasnt been released yet Co-authored-by: Matt Parsons <parsonsmatt@gmail.com>
2020-08-30 14:16:37 -05:00 · 2020-08-30 14:16:37 -05:00 · f9a8088170
commit f9a8088170
parent 2b5b561f6e
4 changed files with 73 additions and 29 deletions
--- a/changelog.md
+++ b/changelog.md
@ -1,5 +1,10 @@
 3.3.3.3
-========
+=======
+- @belevy
+  - [#191](https://github.com/bitemyapp/esqueleto/pull/191) - Bugfix rollup: 
+    Fix issue with extra characters in generated SQL;
+    Fix ToAliasReference for already referenced values; 
+    Fix Alias/Reference for Maybe Entity 
 - @maxgabriel
  - [#203](https://github.com/bitemyapp/esqueleto/pull/203) Document `isNothing`
 - @sestrella
--- a/src/Database/Esqueleto/Experimental.hs
+++ b/src/Database/Esqueleto/Experimental.hs
@ -702,6 +702,7 @@ from parts = do
 type family ToAliasT a where
  ToAliasT (SqlExpr (Value a)) = SqlExpr (Value a)
  ToAliasT (SqlExpr (Entity a)) = SqlExpr (Entity a)
+  ToAliasT (SqlExpr (Maybe (Entity a))) = SqlExpr (Maybe (Entity a))
  ToAliasT (a, b) = (ToAliasT a, ToAliasT b)
  ToAliasT (a, b, c) = (ToAliasT a, ToAliasT b, ToAliasT c)
  ToAliasT (a, b, c, d) = (ToAliasT a, ToAliasT b, ToAliasT c, ToAliasT d)
@ -727,6 +728,9 @@ instance ToAlias (SqlExpr (Entity a)) where
    ident <- newIdentFor (DBName "v")
    pure $ EAliasedEntity ident tableIdent

+instance ToAlias (SqlExpr (Maybe (Entity a))) where
+  toAlias (EMaybe e) = EMaybe <$> toAlias e
+
 instance (ToAlias a, ToAlias b) => ToAlias (a,b) where
  toAlias (a,b) = (,) <$> toAlias a <*> toAlias b

@ -785,6 +789,7 @@ instance ( ToAlias a
 type family ToAliasReferenceT a where
  ToAliasReferenceT (SqlExpr (Value a)) = SqlExpr (Value a)
  ToAliasReferenceT (SqlExpr (Entity a)) = SqlExpr (Entity a)
+  ToAliasReferenceT (SqlExpr (Maybe (Entity a))) = SqlExpr (Maybe (Entity a))
  ToAliasReferenceT (a,b) = (ToAliasReferenceT a, ToAliasReferenceT b)
  ToAliasReferenceT (a,b,c) = (ToAliasReferenceT a, ToAliasReferenceT b, ToAliasReferenceT c)
  ToAliasReferenceT (a, b, c, d) = (ToAliasReferenceT a, ToAliasReferenceT b, ToAliasReferenceT c, ToAliasReferenceT d)
@ -801,13 +806,15 @@ instance ToAliasReference (SqlExpr (Value a)) where
  toAliasReference aliasSource (EAliasedValue aliasIdent _) = pure $ EValueReference aliasSource (\_ -> aliasIdent)
  toAliasReference _           v@(ERaw _ _)                 = toAlias v
  toAliasReference _           v@(ECompositeKey _)          = toAlias v
-  toAliasReference _           v@(EValueReference _ _)      = pure v
+  toAliasReference s             (EValueReference _ b)      = pure $ EValueReference s b

 instance ToAliasReference (SqlExpr (Entity a)) where
  toAliasReference aliasSource (EAliasedEntity ident _) = pure $ EAliasedEntityReference aliasSource ident
  toAliasReference _ e@(EEntity _) = toAlias e
-  toAliasReference _ e@(EAliasedEntityReference _ _) = pure e
+  toAliasReference s   (EAliasedEntityReference _ b) = pure $ EAliasedEntityReference s b

+instance ToAliasReference (SqlExpr (Maybe (Entity a))) where
+  toAliasReference s (EMaybe e) = EMaybe <$> toAliasReference s e
 instance (ToAliasReference a, ToAliasReference b) => ToAliasReference (a, b) where
  toAliasReference ident (a,b) = (,) <$> (toAliasReference ident a) <*> (toAliasReference ident b)

--- a/src/Database/Esqueleto/Internal/Internal.hs
+++ b/src/Database/Esqueleto/Internal/Internal.hs
@ -522,7 +522,7 @@ subSelectUnsafe = sub SELECT
  -> EntityField val typ
  -> SqlExpr (Value typ)
 (EAliasedEntityReference source base) ^. field =
-  EValueReference source (aliasedEntityColumnIdent base fieldDef)
+  EValueReference source (\_ -> aliasedEntityColumnIdent base fieldDef)
    where
      fieldDef =
        if isIdField field then
@ -558,7 +558,7 @@ e ^. field
          fieldIdent =
            case e of
              EEntity _ -> fromDBName info (fieldDB fieldDef)
-              EAliasedEntity baseI _ -> useIdent info $ aliasedEntityColumnIdent baseI fieldDef info
+              EAliasedEntity baseI _ -> useIdent info $ aliasedEntityColumnIdent baseI fieldDef

 -- | Project an SqlExpression that may be null, guarding against null cases.
 withNonNull :: PersistField typ
@ -2139,7 +2139,7 @@ unsafeSqlBinOp op (ERaw p1 f1) (ERaw p2 f2) = ERaw Parens f
                , vals1 <> vals2 )
 unsafeSqlBinOp op a b = unsafeSqlBinOp op (construct a) (construct b)
    where construct :: SqlExpr (Value a) -> SqlExpr (Value a)
-          construct (ERaw p f)        = ERaw Parens $ \info ->
+          construct (ERaw p f)        = ERaw (if p == Never then Parens else Never) $ \info ->
            let (b1, vals) = f info
                build ("?", [PersistList vals']) =
                  (uncommas $ replicate (length vals') "?", vals')
@ -2180,9 +2180,14 @@ unsafeSqlBinOp op a b = unsafeSqlBinOp op (construct a) (construct b)
 --   a foreign (composite or not) key, so we enforce that it has
 --   no placeholders and split it on the commas.
 unsafeSqlBinOpComposite :: TLB.Builder -> TLB.Builder -> SqlExpr (Value a) -> SqlExpr (Value b) -> SqlExpr (Value c)
-unsafeSqlBinOpComposite op _ a@(ERaw _ _) b@(ERaw _ _) = unsafeSqlBinOp op a b
-unsafeSqlBinOpComposite op sep a b = ERaw Parens $ compose (listify a) (listify b)
+unsafeSqlBinOpComposite op sep a b 
+    | isCompositeKey a || isCompositeKey b = ERaw Parens $ compose (listify a) (listify b)
+    | otherwise = unsafeSqlBinOp op a b
  where
+    isCompositeKey :: SqlExpr (Value x) -> Bool
+    isCompositeKey (ECompositeKey _) = True
+    isCompositeKey _ = False
+
    listify :: SqlExpr (Value x) -> IdentInfo -> ([TLB.Builder], [PersistValue])
    listify (ECompositeKey f)      = flip (,) [] . f
    listify (ERaw _ f)             = deconstruct . f
@ -2210,6 +2215,13 @@ unsafeSqlValue :: TLB.Builder -> SqlExpr (Value a)
 unsafeSqlValue v = ERaw Never $ const (v, mempty)
 {-# INLINE unsafeSqlValue #-}

+valueToFunctionArg :: IdentInfo -> SqlExpr (Value a) -> (TLB.Builder, [PersistValue])
+valueToFunctionArg info v =
+    case v of
+      ERaw _ f             -> f info
+      EAliasedValue i _    -> aliasedValueIdentToRawSql i info
+      EValueReference i i' -> valueReferenceToRawSql i i' info
+      ECompositeKey _      -> throw (CompositeKeyErr SqlFunctionError)

 -- | (Internal) A raw SQL function.  Once again, the same warning
 -- from 'unsafeSqlBinOp' applies to this function as well.
@ -2217,15 +2229,8 @@ unsafeSqlFunction :: UnsafeSqlFunctionArgument a =>
                     TLB.Builder -> a -> SqlExpr (Value b)
 unsafeSqlFunction name arg =
  ERaw Never $ \info ->
-    let
-      valueToFunctionArg v =
-        case v of
-          ERaw _ f             -> f info
-          EAliasedValue i _    -> aliasedValueIdentToRawSql i info
-          EValueReference i i' -> valueReferenceToRawSql i i' info
-          ECompositeKey _      -> throw (CompositeKeyErr SqlFunctionError)
-      (argsTLB, argsVals) =
-          uncommas' $ map valueToFunctionArg $ toArgList arg
+    let (argsTLB, argsVals) =
+          uncommas' $ map (valueToFunctionArg info) $ toArgList arg
    in (name <> parens argsTLB, argsVals)

 -- | (Internal) An unsafe SQL function to extract a subfield from a compound
@ -2237,7 +2242,7 @@ unsafeSqlExtractSubField :: UnsafeSqlFunctionArgument a =>
 unsafeSqlExtractSubField subField arg =
  ERaw Never $ \info ->
    let (argsTLB, argsVals) =
-          uncommas' $ map (\(ERaw _ f) -> f info) $ toArgList arg
+          uncommas' $ map (valueToFunctionArg info) $ toArgList arg
    in ("EXTRACT" <> parens (subField <> " FROM " <> argsTLB), argsVals)

 -- | (Internal) A raw SQL function. Preserves parentheses around arguments.
@ -2246,8 +2251,15 @@ unsafeSqlFunctionParens :: UnsafeSqlFunctionArgument a =>
                           TLB.Builder -> a -> SqlExpr (Value b)
 unsafeSqlFunctionParens name arg =
  ERaw Never $ \info ->
-    let (argsTLB, argsVals) =
-          uncommas' $ map (\(ERaw p f) -> first (parensM p) (f info)) $ toArgList arg
+    let
+      valueToFunctionArgParens v =
+        case v of
+          ERaw p f             -> first (parensM p) (f info)
+          EAliasedValue i _    -> aliasedValueIdentToRawSql i info
+          EValueReference i i' -> valueReferenceToRawSql i i' info
+          ECompositeKey _      -> throw (CompositeKeyErr SqlFunctionError)
+      (argsTLB, argsVals) =
+          uncommas' $ map valueToFunctionArgParens $ toArgList arg
    in (name <> parens argsTLB, argsVals)

 -- | (Internal) An explicit SQL type cast using CAST(value as type).
@ -2886,12 +2898,12 @@ valueReferenceToRawSql ::  Ident -> (IdentInfo -> Ident) -> IdentInfo -> (TLB.Bu
 valueReferenceToRawSql sourceIdent columnIdentF info =
  (useIdent info sourceIdent <> "." <> useIdent info (columnIdentF info), mempty)

-aliasedEntityColumnIdent :: Ident -> FieldDef -> IdentInfo -> Ident
-aliasedEntityColumnIdent (I baseIdent) field info =
-  I (baseIdent <> "_" <> (builderToText $ fromDBName info $ fieldDB field))
+aliasedEntityColumnIdent :: Ident -> FieldDef -> Ident
+aliasedEntityColumnIdent (I baseIdent) field =
+  I (baseIdent <> "_" <> (unDBName $ fieldDB field))

-aliasedColumnName :: Ident -> IdentInfo -> T.Text -> TLB.Builder
-aliasedColumnName (I baseIdent) info columnName =
+aliasedColumnName :: Ident -> IdentInfo -> T.Text -> TLB.Builder 
+aliasedColumnName (I baseIdent) info columnName = 
  useIdent info (I (baseIdent <> "_" <> columnName))

 ----------------------------------------------------------------------
@ -2941,6 +2953,11 @@ instance SqlSelect () () where
  sqlSelectColCount _ = 1
  sqlSelectProcessRow _ = Right ()

+unescapedColumnNames :: EntityDef -> [DBName]
+unescapedColumnNames ent =
+     (if hasCompositeKey ent
+      then [] else [fieldDB (entityId ent)])
+   <> map fieldDB (entityFields ent)

 -- | You may return an 'Entity' from a 'select' query.
 instance PersistEntity a => SqlSelect (SqlExpr (Entity a)) (Entity a) where
@ -2962,16 +2979,16 @@ instance PersistEntity a => SqlSelect (SqlExpr (Entity a)) (Entity a) where
      where
        process ed = uncommas $
                     map ((name <>) . aliasName) $
-                     entityColumnNames ed (fst info)
-        aliasName columnName = (TLB.fromText columnName) <> " AS " <> aliasedColumnName aliasIdent info columnName
+                     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) $
-                     entityColumnNames ed (fst info)
+                     map ((name <>) . aliasedColumnName baseIdent info . unDBName) $
+                     unescapedColumnNames ed 
        name = useIdent info sourceIdent <> "."
        ret = let ed = entityDef $ getEntityVal $ return expr
              in (process ed, mempty)
--- a/test/Common/Test.hs
+++ b/test/Common/Test.hs
@ -894,6 +894,21 @@ testSelectSubQuery run = do
        ret <- select $ Experimental.from $ SelectQuery q
        liftIO $ ret `shouldBe` [ (Value $ personName p1, Value $ personAge p1) ]

+    it "supports sub-selecting Maybe entities" $ do
+      run $ do
+        l1e <- insert' l1
+        l3e <- insert' l3
+        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 $ SelectQuery $ do
+          (lords :& deeds) <-
+              Experimental.from $ Table @Lord
+              `LeftOuterJoin` Table @Deed
+              `Experimental.on` (\(l :& d) -> just (l ^. LordId) ==. d ?. DeedOwnerId)
+          pure (lords, deeds)
+        liftIO $ ret `shouldMatchList` ((l3e, Nothing) : l1WithDeeds)
+
    it "lets you order by alias" $ do
      run $ do
        _ <- insert' p1