This commit is contained in:
parsonsmatt 2021-03-26 16:03:24 -06:00
parent 9ac73d93dc
commit 4a546d2698
12 changed files with 73 additions and 59 deletions

View File

@ -23,7 +23,7 @@ jobs:
MYSQL_DATABASE: esqutest
## map the "external" 33306 port with the "internal" 3306
ports:
- 33306:3306
- 3306:3306
# Set health checks to wait until mysql database has started (it takes some seconds to start)
options: >-
--health-cmd="mysqladmin ping"

View File

@ -1,3 +1,9 @@
3.5.0.0
=======
- @parsonsmatt
- [#???]()
- Support `persistent-2.12`
3.4.1.0
=======
- @arthurxavierx

View File

@ -53,7 +53,7 @@ library
, conduit >=1.3
, containers
, monad-logger
, persistent >=2.10.0 && <2.12
, persistent >=2.12 && <2.13
, resourcet >=1.2
, tagged >=0.2
, text >=0.11 && <1.3

View File

@ -227,6 +227,7 @@ import qualified Data.Text.Lazy.Builder as TLB
import Database.Esqueleto.Internal.Internal hiding (From, from, on)
import Database.Esqueleto.Internal.PersistentImport
import GHC.TypeLits
import Database.Persist (EntityNameDB(..))
-- $setup
--
@ -1040,7 +1041,7 @@ from parts = do
runFrom :: From a -> SqlQuery (a, FromClause)
runFrom e@Table = do
let ed = entityDef $ getVal e
ident <- newIdentFor (entityDB ed)
ident <- newIdentFor . DBName . unEntityNameDB $ entityDB ed
let entity = EEntity ident
pure $ (entity, FromStart ident ed)
where

View File

@ -43,7 +43,7 @@ parseOnExpr sqlBackend text = do
-- with postgresql, mysql, and sqlite backends.
mkEscapeChar :: SqlBackend -> Either String Char
mkEscapeChar sqlBackend =
case Text.uncons (connEscapeName sqlBackend (DBName "")) of
case Text.uncons (connEscapeRawName sqlBackend "") of
Nothing ->
Left "Failed to get an escape character from the SQL backend."
Just (c, _) ->

View File

@ -56,6 +56,7 @@ import Data.Typeable (Typeable)
import Database.Esqueleto.Internal.ExprParser (TableAccess(..), parseOnExpr)
import Database.Esqueleto.Internal.PersistentImport
import qualified Database.Persist
import Database.Persist (FieldNameDB(..), EntityNameDB(..))
import Database.Persist.Sql.Util
( entityColumnCount
, entityColumnNames
@ -64,6 +65,7 @@ import Database.Persist.Sql.Util
, parseEntityValues
)
import Text.Blaze.Html (Html)
import Data.Coerce (coerce)
-- | (Internal) Start a 'from' query with an entity. 'from'
-- does two kinds of magic using 'fromStart', 'fromJoin' and
@ -86,11 +88,14 @@ fromStart
=> SqlQuery (SqlExpr (PreprocessedFrom (SqlExpr (Entity a))))
fromStart = do
let ed = entityDef (Proxy :: Proxy a)
ident <- newIdentFor (entityDB ed)
ident <- newIdentFor (coerce $ entityDB ed)
let ret = EEntity ident
f' = FromStart ident ed
return (EPreprocessedFrom ret f')
-- | Copied from @persistent@
newtype DBName = DBName { unDBName :: T.Text }
-- | (Internal) Same as 'fromStart', but entity may be missing.
fromStartMaybe
:: ( PersistEntity a
@ -568,7 +573,7 @@ e ^. field
]
fieldIdent =
case e of
EEntity _ -> fromDBName info (fieldDB fieldDef)
EEntity _ -> fromDBName info (coerce $ fieldDB fieldDef)
EAliasedEntity baseI _ -> useIdent info $ aliasedEntityColumnIdent baseI fieldDef
EAliasedEntityReference a b ->
error $ unwords
@ -1805,7 +1810,7 @@ instance Show FromClause where
where
dummy = SqlBackend
{ connEscapeName = \(DBName x) -> x
{ connEscapeRawName = id
}
render' = T.unpack . renderExpr dummy
@ -2124,7 +2129,7 @@ instance ToSomeValues (SqlExpr (Value a)) where
fieldName
:: (PersistEntity val, PersistField typ)
=> IdentInfo -> EntityField val typ -> TLB.Builder
fieldName info = fromDBName info . fieldDB . persistFieldDef
fieldName info = fromDBName info . coerce . fieldDB . persistFieldDef
-- FIXME: Composite/non-id pKS not supported on set
setAux
@ -2140,7 +2145,7 @@ sub :: PersistField a => Mode -> SqlQuery (SqlExpr (Value a)) -> SqlExpr (Value
sub mode query = ERaw Parens $ \info -> toRawSql mode info query
fromDBName :: IdentInfo -> DBName -> TLB.Builder
fromDBName (conn, _) = TLB.fromText . connEscapeName conn
fromDBName (conn, _) = TLB.fromText . connEscapeRawName conn . unDBName
existsHelper :: SqlQuery () -> SqlExpr (Value Bool)
existsHelper = sub SELECT . (>> return true)
@ -2900,7 +2905,7 @@ makeFrom info mode fs = ret
(useIdent info ident, mempty)
base ident@(I identText) def =
let db@(DBName dbText) = entityDB def
let db@(DBName dbText) = coerce $ entityDB def
in ( fromDBName info db <>
if dbText == identText
then mempty
@ -3030,7 +3035,7 @@ valueReferenceToRawSql sourceIdent columnIdentF info =
aliasedEntityColumnIdent :: Ident -> FieldDef -> Ident
aliasedEntityColumnIdent (I baseIdent) field =
I (baseIdent <> "_" <> (unDBName $ fieldDB field))
I (baseIdent <> "_" <> (unDBName $ coerce $ fieldDB field))
aliasedColumnName :: Ident -> IdentInfo -> T.Text -> TLB.Builder
aliasedColumnName (I baseIdent) info columnName =
@ -3064,11 +3069,11 @@ instance SqlSelect (SqlExpr InsertFinal) InsertFinal where
sqlInsertInto info (EInsertFinal (EInsert p _)) =
let fields =
uncommas $
map (fromDBName info . fieldDB) $
map (fromDBName info . coerce . fieldDB) $
entityFields $
entityDef p
table =
fromDBName info . entityDB . entityDef $ p
fromDBName info . DBName . coerce . entityDB . entityDef $ p
in
("INSERT INTO " <> table <> parens fields <> "\n", [])
sqlSelectCols info (EInsertFinal (EInsert _ f)) = f info
@ -3084,8 +3089,8 @@ instance SqlSelect () () where
unescapedColumnNames :: EntityDef -> [DBName]
unescapedColumnNames ent =
(if hasCompositeKey ent then id else ( fieldDB (entityId ent) :))
$ map fieldDB (entityFields ent)
(if hasCompositeKey ent then id else ( coerce (fieldDB (entityId ent)) :))
$ map (coerce . fieldDB) (entityFields ent)
-- | You may return an 'Entity' from a 'select' query.
instance PersistEntity a => SqlSelect (SqlExpr (Entity a)) (Entity a) where

View File

@ -53,7 +53,6 @@ module Database.Esqueleto.Internal.PersistentImport
rawQuery,
rawQueryRes,
rawSql,
askLogFunc,
close',
createSqlPool,
liftSqlPersistMPool,
@ -118,7 +117,6 @@ module Database.Esqueleto.Internal.PersistentImport
Attr,
Checkmark(..),
CompositeDef(..),
DBName(..),
EmbedEntityDef(..),
EmbedFieldDef(..),
EntityDef(..),
@ -127,7 +125,6 @@ module Database.Esqueleto.Internal.PersistentImport
FieldType(..),
ForeignDef(..),
ForeignFieldDef,
HaskellName(..),
IsNullable(..),
OnlyUniqueException(..),
PersistException(..),

View File

@ -47,6 +47,7 @@ import Data.Time.Clock (UTCTime)
import Database.Esqueleto.Internal.Internal hiding (random_)
import Database.Esqueleto.Internal.PersistentImport hiding (upsert, upsertBy)
import Database.Persist.Class (OnlyOneUniqueKey)
import Database.Persist (ConstraintNameDB(..), EntityNameDB(..))
-- | (@random()@) Split out into database specific modules
-- because MySQL uses `rand()`.
@ -306,10 +307,10 @@ insertSelectWithConflictCount unique query conflictQuery = do
updates = conflictQuery entCurrent entExcluded
combine (tlb1,vals1) (tlb2,vals2) = (builderToText (tlb1 `mappend` tlb2), vals1 ++ vals2)
entExcluded = EEntity $ I "excluded"
tableName = unDBName . entityDB . entityDef
tableName = unEntityNameDB . entityDB . entityDef
entCurrent = EEntity $ I (tableName proxy)
uniqueDef = toUniqueDef unique
constraint = TLB.fromText . unDBName . uniqueDBName $ uniqueDef
constraint = TLB.fromText . unConstraintNameDB . uniqueDBName $ uniqueDef
renderedUpdates :: (BackendCompatible SqlBackend backend) => backend -> (TLB.Builder, [PersistValue])
renderedUpdates conn = renderUpdates conn updates
conflict conn = (mconcat ([

View File

@ -87,7 +87,7 @@ instance IsString JSONAccessor where
-- | @since 3.1.0
instance (FromJSON a, ToJSON a) => PersistField (JSONB a) where
toPersistValue = PersistDbSpecific . BSL.toStrict . encode . unJSONB
toPersistValue = PersistLiteralEscaped . BSL.toStrict . encode . unJSONB
fromPersistValue pVal = fmap JSONB $ case pVal of
PersistByteString bs -> first (badParse $ TE.decodeUtf8 bs) $ eitherDecodeStrict bs
PersistText t -> first (badParse t) $ eitherDecodeStrict (TE.encodeUtf8 t)

View File

@ -5,8 +5,11 @@ packages:
- 'examples'
extra-deps:
- persistent-2.11.0.0
- persistent-template-2.9.1.0
- persistent-mysql-2.10.3
- persistent-postgresql-2.11.0.0
- persistent-sqlite-2.11.0.0
- git: https://www.github.com/yesodweb/persistent
commit: 03e794f618b9b8daa5ae9c3a4edfe792642df55c
subdirs:
- persistent
- persistent-template
- persistent-mysql
- persistent-postgresql
- persistent-sqlite

View File

@ -71,7 +71,7 @@ import Data.Time
import Control.Monad.Fail (MonadFail)
#endif
import Control.Monad.IO.Class (MonadIO(liftIO))
import Control.Monad.Logger (MonadLogger(..), NoLoggingT, runNoLoggingT)
import Control.Monad.Logger (MonadLoggerIO(..), MonadLogger(..), NoLoggingT, runNoLoggingT)
import Control.Monad.Trans.Reader (ReaderT)
import qualified Data.Attoparsec.Text as AP
import Data.Char (toLower, toUpper)
@ -2507,6 +2507,7 @@ insert' v = flip Entity v <$> insert v
type RunDbMonad m = ( MonadUnliftIO m
, MonadIO m
, MonadLoggerIO m
, MonadLogger m
, MonadCatch m )

View File

@ -619,14 +619,14 @@ testArrowJSONB =
createSaneSQL @JSONValue
(jsonbVal (object ["a" .= True]) ->. "a")
"SELECT (? -> ?)\nFROM \"Json\"\n"
[ PersistDbSpecific "{\"a\":true}"
[ PersistLiteralEscaped "{\"a\":true}"
, PersistText "a" ]
it "creates sane SQL (chained)" $ do
let obj = object ["a" .= [1 :: Int,2,3]]
createSaneSQL @JSONValue
(jsonbVal obj ->. "a" ->. 1)
"SELECT ((? -> ?) -> ?)\nFROM \"Json\"\n"
[ PersistDbSpecific "{\"a\":[1,2,3]}"
[ PersistLiteralEscaped "{\"a\":[1,2,3]}"
, PersistText "a"
, PersistInt64 1 ]
it "works as expected" $ run $ do
@ -644,14 +644,14 @@ testArrowText =
createSaneSQL
(jsonbVal (object ["a" .= True]) ->>. "a")
"SELECT (? ->> ?)\nFROM \"Json\"\n"
[ PersistDbSpecific "{\"a\":true}"
[ PersistLiteralEscaped "{\"a\":true}"
, PersistText "a" ]
it "creates sane SQL (chained)" $ do
let obj = object ["a" .= [1 :: Int,2,3]]
createSaneSQL
(jsonbVal obj ->. "a" ->>. 1)
"SELECT ((? -> ?) ->> ?)\nFROM \"Json\"\n"
[ PersistDbSpecific "{\"a\":[1,2,3]}"
[ PersistLiteralEscaped "{\"a\":[1,2,3]}"
, PersistText "a"
, PersistInt64 1 ]
it "works as expected" $ run $ do
@ -670,14 +670,14 @@ testHashArrowJSONB =
createSaneSQL @JSONValue
(jsonbVal (object ["a" .= True]) #>. list)
"SELECT (? #> ?)\nFROM \"Json\"\n"
[ PersistDbSpecific "{\"a\":true}"
[ PersistLiteralEscaped "{\"a\":true}"
, persistTextArray list ]
it "creates sane SQL (chained)" $ do
let obj = object ["a" .= [object ["b" .= True]]]
createSaneSQL @JSONValue
(jsonbVal obj #>. ["a","1"] #>. ["b"])
"SELECT ((? #> ?) #> ?)\nFROM \"Json\"\n"
[ PersistDbSpecific "{\"a\":[{\"b\":true}]}"
[ PersistLiteralEscaped "{\"a\":[{\"b\":true}]}"
, persistTextArray ["a","1"]
, persistTextArray ["b"] ]
it "works as expected" $ run $ do
@ -696,14 +696,14 @@ testHashArrowText =
createSaneSQL
(jsonbVal (object ["a" .= True]) #>>. list)
"SELECT (? #>> ?)\nFROM \"Json\"\n"
[ PersistDbSpecific "{\"a\":true}"
[ PersistLiteralEscaped "{\"a\":true}"
, persistTextArray list ]
it "creates sane SQL (chained)" $ do
let obj = object ["a" .= [object ["b" .= True]]]
createSaneSQL
(jsonbVal obj #>. ["a","1"] #>>. ["b"])
"SELECT ((? #> ?) #>> ?)\nFROM \"Json\"\n"
[ PersistDbSpecific "{\"a\":[{\"b\":true}]}"
[ PersistLiteralEscaped "{\"a\":[{\"b\":true}]}"
, persistTextArray ["a","1"]
, persistTextArray ["b"] ]
it "works as expected" $ run $ do
@ -730,16 +730,16 @@ testInclusion = do
createSaneSQL
(jsonbVal (object ["a" .= False, "b" .= True]) @>. jsonbVal (object ["a" .= False]))
"SELECT (? @> ?)\nFROM \"Json\"\n"
[ PersistDbSpecific "{\"a\":false,\"b\":true}"
, PersistDbSpecific "{\"a\":false}" ]
[ PersistLiteralEscaped "{\"a\":false,\"b\":true}"
, PersistLiteralEscaped "{\"a\":false}" ]
it "creates sane SQL (chained)" $ do
let obj = object ["a" .= [object ["b" .= True]]]
createSaneSQL
(jsonbVal obj ->. "a" @>. jsonbVal (object ["b" .= True]))
"SELECT ((? -> ?) @> ?)\nFROM \"Json\"\n"
[ PersistDbSpecific "{\"a\":[{\"b\":true}]}"
[ PersistLiteralEscaped "{\"a\":[{\"b\":true}]}"
, PersistText "a"
, PersistDbSpecific "{\"b\":true}" ]
, PersistLiteralEscaped "{\"b\":true}" ]
it "works as expected" $ run $ do
x <- selectJSONwhere $ \v -> v @>. jsonbVal (Number 1)
y <- selectJSONwhere $ \v -> v @>. jsonbVal (toJSON [object ["a" .= Number 3.14]])
@ -752,16 +752,16 @@ testInclusion = do
createSaneSQL
(jsonbVal (object ["a" .= False]) <@. jsonbVal (object ["a" .= False, "b" .= True]))
"SELECT (? <@ ?)\nFROM \"Json\"\n"
[ PersistDbSpecific "{\"a\":false}"
, PersistDbSpecific "{\"a\":false,\"b\":true}" ]
[ PersistLiteralEscaped "{\"a\":false}"
, PersistLiteralEscaped "{\"a\":false,\"b\":true}" ]
it "creates sane SQL (chained)" $ do
let obj = object ["a" .= [object ["b" .= True]]]
createSaneSQL
(jsonbVal obj ->. "a" <@. jsonbVal (object ["b" .= True, "c" .= Null]))
"SELECT ((? -> ?) <@ ?)\nFROM \"Json\"\n"
[ PersistDbSpecific "{\"a\":[{\"b\":true}]}"
[ PersistLiteralEscaped "{\"a\":[{\"b\":true}]}"
, PersistText "a"
, PersistDbSpecific "{\"b\":true,\"c\":null}" ]
, PersistLiteralEscaped "{\"b\":true,\"c\":null}" ]
it "works as expected" $ run $ do
x <- selectJSONwhere $ \v -> v <@. jsonbVal (toJSON [Number 1])
y <- selectJSONwhere $ \v -> v <@. jsonbVal (object ["a" .= (1 :: Int), "b" .= False, "c" .= Null])
@ -777,14 +777,14 @@ testQMark =
createSaneSQL
(jsonbVal (object ["a" .= False, "b" .= True]) JSON.?. "a")
"SELECT (? ?? ?)\nFROM \"Json\"\n"
[ PersistDbSpecific "{\"a\":false,\"b\":true}"
[ PersistLiteralEscaped "{\"a\":false,\"b\":true}"
, PersistText "a" ]
it "creates sane SQL (chained)" $ do
let obj = object ["a" .= [object ["b" .= True]]]
createSaneSQL
(jsonbVal obj #>. ["a","0"] JSON.?. "b")
"SELECT ((? #> ?) ?? ?)\nFROM \"Json\"\n"
[ PersistDbSpecific "{\"a\":[{\"b\":true}]}"
[ PersistLiteralEscaped "{\"a\":[{\"b\":true}]}"
, persistTextArray ["a","0"]
, PersistText "b" ]
it "works as expected" $ run $ do
@ -802,14 +802,14 @@ testQMarkAny =
createSaneSQL
(jsonbVal (object ["a" .= False, "b" .= True]) ?|. ["a","c"])
"SELECT (? ??| ?)\nFROM \"Json\"\n"
[ PersistDbSpecific "{\"a\":false,\"b\":true}"
[ PersistLiteralEscaped "{\"a\":false,\"b\":true}"
, persistTextArray ["a","c"] ]
it "creates sane SQL (chained)" $ do
let obj = object ["a" .= [object ["b" .= True]]]
createSaneSQL
(jsonbVal obj #>. ["a","0"] ?|. ["b","c"])
"SELECT ((? #> ?) ??| ?)\nFROM \"Json\"\n"
[ PersistDbSpecific "{\"a\":[{\"b\":true}]}"
[ PersistLiteralEscaped "{\"a\":[{\"b\":true}]}"
, persistTextArray ["a","0"]
, persistTextArray ["b","c"] ]
it "works as expected" $ run $ do
@ -829,14 +829,14 @@ testQMarkAll =
createSaneSQL
(jsonbVal (object ["a" .= False, "b" .= True]) ?&. ["a","c"])
"SELECT (? ??& ?)\nFROM \"Json\"\n"
[ PersistDbSpecific "{\"a\":false,\"b\":true}"
[ PersistLiteralEscaped "{\"a\":false,\"b\":true}"
, persistTextArray ["a","c"] ]
it "creates sane SQL (chained)" $ do
let obj = object ["a" .= [object ["b" .= True]]]
createSaneSQL
(jsonbVal obj #>. ["a","0"] ?&. ["b","c"])
"SELECT ((? #> ?) ??& ?)\nFROM \"Json\"\n"
[ PersistDbSpecific "{\"a\":[{\"b\":true}]}"
[ PersistLiteralEscaped "{\"a\":[{\"b\":true}]}"
, persistTextArray ["a","0"]
, persistTextArray ["b","c"] ]
it "works as expected" $ run $ do
@ -866,16 +866,16 @@ testConcatenationOperator =
(jsonbVal (object ["a" .= False, "b" .= True])
JSON.||. jsonbVal (object ["c" .= Null]))
"SELECT (? || ?)\nFROM \"Json\"\n"
[ PersistDbSpecific "{\"a\":false,\"b\":true}"
, PersistDbSpecific "{\"c\":null}" ]
[ PersistLiteralEscaped "{\"a\":false,\"b\":true}"
, PersistLiteralEscaped "{\"c\":null}" ]
it "creates sane SQL (chained)" $ do
let obj = object ["a" .= [object ["b" .= True]]]
createSaneSQL @JSONValue
(jsonbVal obj ->. "a" JSON.||. jsonbVal (toJSON [Null]))
"SELECT ((? -> ?) || ?)\nFROM \"Json\"\n"
[ PersistDbSpecific "{\"a\":[{\"b\":true}]}"
[ PersistLiteralEscaped "{\"a\":[{\"b\":true}]}"
, PersistText "a"
, PersistDbSpecific "[null]" ]
, PersistLiteralEscaped "[null]" ]
it "works as expected" $ run $ do
x <- selectJSON $ \v -> do
where_ $ v @>. jsonbVal (object [])
@ -905,14 +905,14 @@ testMinusOperator =
createSaneSQL @JSONValue
(jsonbVal (object ["a" .= False, "b" .= True]) JSON.-. "a")
"SELECT (? - ?)\nFROM \"Json\"\n"
[ PersistDbSpecific "{\"a\":false,\"b\":true}"
[ PersistLiteralEscaped "{\"a\":false,\"b\":true}"
, PersistText "a" ]
it "creates sane SQL (chained)" $ do
let obj = object ["a" .= [object ["b" .= True]]]
createSaneSQL @JSONValue
(jsonbVal obj ->. "a" JSON.-. 0)
"SELECT ((? -> ?) - ?)\nFROM \"Json\"\n"
[ PersistDbSpecific "{\"a\":[{\"b\":true}]}"
[ PersistLiteralEscaped "{\"a\":[{\"b\":true}]}"
, PersistText "a"
, PersistInt64 0 ]
it "works as expected" $ run $ do
@ -943,14 +943,14 @@ testMinusOperatorV10 =
createSaneSQL @JSONValue
(jsonbVal (object ["a" .= False, "b" .= True]) --. ["a","b"])
"SELECT (? - ?)\nFROM \"Json\"\n"
[ PersistDbSpecific "{\"a\":false,\"b\":true}"
[ PersistLiteralEscaped "{\"a\":false,\"b\":true}"
, persistTextArray ["a","b"] ]
it "creates sane SQL (chained)" $ do
let obj = object ["a" .= [object ["b" .= True]]]
createSaneSQL @JSONValue
(jsonbVal obj #>. ["a","0"] --. ["b"])
"SELECT ((? #> ?) - ?)\nFROM \"Json\"\n"
[ PersistDbSpecific "{\"a\":[{\"b\":true}]}"
[ PersistLiteralEscaped "{\"a\":[{\"b\":true}]}"
, persistTextArray ["a","0"]
, persistTextArray ["b"] ]
it "works as expected" $ run $ do
@ -981,14 +981,14 @@ testHashMinusOperator =
createSaneSQL @JSONValue
(jsonbVal (object ["a" .= False, "b" .= True]) #-. ["a"])
"SELECT (? #- ?)\nFROM \"Json\"\n"
[ PersistDbSpecific "{\"a\":false,\"b\":true}"
[ PersistLiteralEscaped (encode [])
, persistTextArray ["a"] ]
it "creates sane SQL (chained)" $ do
let obj = object ["a" .= [object ["b" .= True]]]
createSaneSQL @JSONValue
(jsonbVal obj ->. "a" #-. ["0","b"])
"SELECT ((? -> ?) #- ?)\nFROM \"Json\"\n"
[ PersistDbSpecific "{\"a\":[{\"b\":true}]}"
[ PersistLiteralEscaped (encode obj)
, PersistText "a"
, persistTextArray ["0","b"] ]
it "works as expected" $ run $ do