esqueleto 3.4.2.0 → 3.4.2.1

raw patch · 8 files changed

+227/−177 lines, 8 filesdep ~persistentPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: persistent

API changes (from Hackage documentation)

Files

• changelog.md +6/−0
• esqueleto.cabal +3/−3
• src/Database/Esqueleto/Experimental.hs +1/−1
• src/Database/Esqueleto/Internal/ExprParser.hs +4/−3
• src/Database/Esqueleto/Internal/Internal.hs +71/−20
• src/Database/Esqueleto/Internal/PersistentImport.hs +137/−134
• src/Database/Esqueleto/PostgreSQL.hs +4/−3
• test/SQLite/Test.hs +1/−13

@@ -1,3 +1,9 @@+3.4.2.1+=======+- @parsonsmatt+  - [#245](https://github.com/bitemyapp/esqueleto/pull/245)+    - Support `persistent-2.13`+ 3.4.2.0 ======= - @parsonsmatt

@@ -1,7 +1,7 @@ cabal-version: 1.12  name:           esqueleto-version:        3.4.2.0+version:        3.4.2.1 synopsis:       Type-safe EDSL for SQL queries on persistent backends. description:    @esqueleto@ is a bare bones, type-safe EDSL for SQL queries that works with unmodified @persistent@ SQL backends.  Its 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.                 .@@ -53,7 +53,7 @@       , conduit >=1.3       , containers       , monad-logger-      , persistent >=2.12 && <2.13+      , persistent >=2.13 && <3       , resourcet >=1.2       , tagged >=0.2       , text >=0.11 && <1.3@@ -154,7 +154,7 @@         Paths_esqueleto     hs-source-dirs:         test-    ghc-options: -Wall+    ghc-options: -Wall -threaded     build-depends:         base >=4.8 && <5.0       , attoparsec

@@ -1041,7 +1041,7 @@     runFrom :: From a -> SqlQuery (a, FromClause)     runFrom e@Table = do         let ed = entityDef $ getVal e-        ident <- newIdentFor . DBName . unEntityNameDB $ entityDB ed+        ident <- newIdentFor . DBName . unEntityNameDB $ getEntityDBName ed         let entity = EEntity ident         pure $ (entity, FromStart ident ed)           where

@@ -16,6 +16,7 @@ import Data.Text (Text) import qualified Data.Text as Text import Database.Persist.Sql+import Database.Persist.SqlBackend  -- | A type representing the access of a table value. In Esqueleto, we get -- a guarantee that the access will look something like:@@ -43,7 +44,7 @@ -- with postgresql, mysql, and sqlite backends. mkEscapeChar :: SqlBackend -> Either String Char mkEscapeChar sqlBackend =-    case Text.uncons (connEscapeRawName sqlBackend "") of+    case Text.uncons (getEscapedRawName "" sqlBackend) of         Nothing ->             Left "Failed to get an escape character from the SQL backend."         Just (c, _) ->@@ -63,9 +64,9 @@  parseEscapedIdentifier :: ExprParser [Char] parseEscapedIdentifier escapeChar = do-    char escapeChar+    _ <- char escapeChar     str <- parseEscapedChars escapeChar-    char escapeChar+    _ <- char escapeChar     pure str  parseTableAccess :: ExprParser TableAccess

@@ -15,6 +15,8 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}+ -- | This is an internal module, anything exported by this module -- may change without a major version bump.  Please use only -- "Database.Esqueleto" if possible.@@ -23,6 +25,8 @@ -- tracker so we can safely support it. module Database.Esqueleto.Internal.Internal where +import Data.List.NonEmpty (NonEmpty(..))+import qualified Data.List.NonEmpty as NEL import Control.Applicative ((<|>)) import Control.Arrow (first, (***)) import Control.Exception (Exception, throw, throwIO)@@ -55,12 +59,13 @@ import Data.Typeable (Typeable) import Database.Esqueleto.Internal.ExprParser (TableAccess(..), parseOnExpr) import Database.Esqueleto.Internal.PersistentImport+import Database.Persist.SqlBackend import qualified Database.Persist import Database.Persist (FieldNameDB(..), EntityNameDB(..)) import Database.Persist.Sql.Util        ( entityColumnCount-       , entityColumnNames-       , hasCompositeKey+       , keyAndEntityColumnNames+       , hasNaturalKey        , isIdField        , parseEntityValues        )@@ -88,7 +93,7 @@     => SqlQuery (SqlExpr (PreprocessedFrom (SqlExpr (Entity a)))) fromStart = do     let ed = entityDef (Proxy :: Proxy a)-    ident <- newIdentFor (coerce $ entityDB ed)+    ident <- newIdentFor (coerce $ getEntityDBName ed)     let ret = EEntity ident         f' = FromStart ident ed     return (EPreprocessedFrom ret f')@@ -537,7 +542,7 @@     fieldDef =         if isIdField field then             -- TODO what about composite natural keys in a join this will ignore them-            head $ entityKeyFields ed+            NEL.head $ getEntityKeyFields ed         else             persistFieldDef field @@ -548,12 +553,12 @@     | otherwise = ERaw Never $ \info -> (dot info $ persistFieldDef field, [])   where     idFieldValue =-        case entityKeyFields ed of-            idField:[] ->+        case getEntityKeyFields ed of+            idField :| [] ->                 ERaw Never    $ \info -> (dot info idField, [])              idFields ->-                ECompositeKey $ \info ->  dot info <$> idFields+                ECompositeKey $ \info ->  NEL.toList $ dot info <$> idFields       ed = entityDef $ getEntityVal (Proxy :: Proxy (SqlExpr (Entity val)))@@ -1287,7 +1292,7 @@     unique = finalR uniqueConstructor     -- there must be a better way to get the constrain name from a unique, make this not a list search     filterF = (==) (persistUniqueToFieldNames unique) . uniqueFields-    uniqueDef = head . filter filterF . entityUniques . entityDef $ proxy+    uniqueDef = head . filter filterF . getEntityUniques . entityDef $ proxy  -- | Render updates to be use in a SET clause for a given sql backend. --@@ -1809,7 +1814,7 @@             "(FromIdent " <> show ident <> ")"        where-        dummy = SqlBackend+        dummy = mkSqlBackend MkSqlBackendArgs             { connEscapeRawName = id             }         render' = T.unpack . renderExpr dummy@@ -2018,6 +2023,43 @@ useIdent :: IdentInfo -> Ident -> TLB.Builder useIdent info (I ident) = fromDBName info $ DBName ident +entityAsValue+    :: SqlExpr (Entity val)+    -> SqlExpr (Value (Entity val))+entityAsValue eent =+    case eent of+        EEntity ident ->+            identToRaw ident+        EAliasedEntity ident _ ->+            identToRaw ident+        EAliasedEntityReference _ ident ->+            identToRaw ident+  where+    identToRaw ident =+        ERaw Never $ \identInfo ->+            ( useIdent identInfo ident+            , []+            )++entityAsValueMaybe+    :: SqlExpr (Maybe (Entity val))+    -> SqlExpr (Value (Maybe (Entity val)))+entityAsValueMaybe (EMaybe eent) =+    case eent of+        EEntity ident ->+            identToRaw ident+        EAliasedEntity ident _ ->+            identToRaw ident+        EAliasedEntityReference _ ident ->+            identToRaw ident+  where+    identToRaw ident =+        ERaw Never $ \identInfo ->+            ( useIdent identInfo ident+            , []+            )++ -- | An expression on the SQL backend. -- -- There are many comments describing the constructors of this@@ -2145,7 +2187,7 @@ sub mode query = ERaw Parens $ \info -> toRawSql mode info query  fromDBName :: IdentInfo -> DBName -> TLB.Builder-fromDBName (conn, _) = TLB.fromText . connEscapeRawName conn . unDBName+fromDBName (conn, _) = TLB.fromText . flip getEscapedRawName conn . unDBName  existsHelper :: SqlQuery () -> SqlExpr (Value Bool) existsHelper = sub SELECT . (>> return true)@@ -2905,7 +2947,7 @@         (useIdent info ident, mempty)      base ident@(I identText) def =-        let db@(DBName dbText) = coerce $ entityDB def+        let db@(DBName dbText) = coerce $ getEntityDBName def         in ( fromDBName info db <>                  if dbText == identText                  then mempty@@ -3010,8 +3052,7 @@  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)+    let limitRaw = getConnLimitOffset (v ml, v mo) "\n" conn         v = maybe 0 fromIntegral     in (TLB.fromText limitRaw, mempty) @@ -3070,10 +3111,10 @@         let fields =                 uncommas $                 map (fromDBName info . coerce . fieldDB) $-                entityFields $+                getEntityFields $                 entityDef p             table  =-                fromDBName info . DBName . coerce . entityDB . entityDef $ p+                fromDBName info . DBName . coerce . getEntityDBName . entityDef $ p         in             ("INSERT INTO " <> table <> parens fields <> "\n", [])     sqlSelectCols info (EInsertFinal (EInsert _ f)) = f info@@ -3089,16 +3130,26 @@  unescapedColumnNames :: EntityDef -> [DBName] unescapedColumnNames ent =-    (if hasCompositeKey ent then id else ( coerce (fieldDB (entityId ent)) :))-    $ map (coerce . fieldDB) (entityFields ent)+    addIdColumn rest+  where+    rest =+        map (coerce . fieldDB) (getEntityFields ent)+    addIdColumn =+        case getEntityId ent of+            EntityIdField fd ->+                (:) (coerce (fieldDB fd))+            EntityIdNaturalKey _ ->+                id  -- | 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       where-        process ed = uncommas $-                     map ((name <>) . TLB.fromText) $-                     entityColumnNames ed (fst info)+        process ed =+            uncommas+            $ map ((name <>) . TLB.fromText)+            $ NEL.toList+            $ keyAndEntityColumnNames ed (fst info)         -- 'name' is the biggest difference between 'RawSql' and         -- 'SqlSelect'.  We automatically create names for tables         -- (since it's not the user who's writing the FROM

@@ -3,139 +3,142 @@ module Database.Esqueleto.Internal.PersistentImport -- NOTE: switch back to a module export once https://gitlab.haskell.org/ghc/ghc/merge_requests/276 -- has been merged. See https://github.com/bitemyapp/esqueleto/issues/110 for more details-    ( toJsonText,-    entityIdFromJSON,-    entityIdToJSON,-    entityValues,-    fromPersistValueJSON,-    keyValueEntityFromJSON,-    keyValueEntityToJSON,-    toPersistValueJSON,-    selectKeys,-    belongsTo,-    belongsToJust,-    getEntity,-    getJust,-    getJustEntity,-    insertEntity,-    insertRecord,-    liftPersist,-    checkUnique,-    getByValue,-    insertBy,-    insertUniqueEntity,-    onlyUnique,-    replaceUnique,-    transactionSave,-    transactionUndo,-    defaultAttribute,-    mkColumns,-    getMigration,-    migrate,-    parseMigration,-    parseMigration',-    printMigration,-    runMigration,-    runMigrationSilent,-    runMigrationUnsafe,-    showMigration,-    decorateSQLWithLimitOffset,-    fieldDBName,-    fromSqlKey,-    getFieldName,-    getTableName,-    tableDBName,-    toSqlKey,-    withRawQuery,-    getStmtConn,-    rawExecute,-    rawExecuteCount,-    rawQuery,-    rawQueryRes,-    rawSql,-    close',-    createSqlPool,-    liftSqlPersistMPool,-    runSqlConn,-    runSqlPersistM,-    runSqlPersistMPool,-    runSqlPool,-    withSqlConn,-    withSqlPool,-    readToUnknown,-    readToWrite,-    writeToUnknown,-    entityKeyFields,-    entityPrimary,-    fromPersistValueText,-    keyAndEntityFields,-    toEmbedEntityDef,-    PersistStore,-    PersistUnique,-    DeleteCascade(..),-    PersistConfig(..),-    BackendSpecificUpdate,-    Entity(..),-    PersistEntity(..),-    PersistField(..),-    SomePersistField(..),-    PersistQueryRead(..),-    PersistQueryWrite(..),-    BackendCompatible(..),-    BackendKey(..),-    HasPersistBackend(..),-    IsPersistBackend,-    PersistCore(..),-    PersistRecordBackend,-    PersistStoreRead(..),-    PersistStoreWrite(..),-    ToBackendKey(..),-    PersistUniqueRead(..),-    PersistUniqueWrite(..),-    PersistFieldSql(..),-    RawSql(..),-    CautiousMigration,-    Column(..),-    ConnectionPool,-    Migration,-    PersistentSqlException(..),-    Single(..),-    Sql,-    SqlPersistM,-    SqlPersistT,-    InsertSqlResult(..),-    IsSqlBackend,-    LogFunc,-    SqlBackend(..),-    SqlBackendCanRead,-    SqlBackendCanWrite,-    SqlReadBackend(..),-    SqlReadT,-    SqlWriteBackend(..),-    SqlWriteT,-    Statement(..),-    Attr,-    Checkmark(..),-    CompositeDef(..),-    EmbedEntityDef(..),-    EmbedFieldDef(..),-    EntityDef(..),-    ExtraLine,-    FieldDef(..),-    FieldType(..),-    ForeignDef(..),-    ForeignFieldDef,-    IsNullable(..),-    OnlyUniqueException(..),-    PersistException(..),-    PersistFilter(..),-    PersistUpdate(..),-    PersistValue(..),-    ReferenceDef(..),-    SqlType(..),-    UniqueDef(..),-    UpdateException(..),-    WhyNullable(..)+    ( toJsonText+    , entityIdFromJSON+    , entityIdToJSON+    , entityValues+    , fromPersistValueJSON+    , keyValueEntityFromJSON+    , keyValueEntityToJSON+    , toPersistValueJSON+    , selectKeys+    , belongsTo+    , belongsToJust+    , getEntity+    , getJust+    , getJustEntity+    , insertEntity+    , insertRecord+    , liftPersist+    , checkUnique+    , getByValue+    , insertBy+    , insertUniqueEntity+    , onlyUnique+    , replaceUnique+    , transactionSave+    , transactionUndo+    , defaultAttribute+    , mkColumns+    , getMigration+    , migrate+    , parseMigration+    , parseMigration'+    , printMigration+    , runMigration+    , runMigrationSilent+    , runMigrationUnsafe+    , showMigration+    , decorateSQLWithLimitOffset+    , fieldDBName+    , fromSqlKey+    , getFieldName+    , getTableName+    , tableDBName+    , toSqlKey+    , withRawQuery+    , getStmtConn+    , rawExecute+    , rawExecuteCount+    , rawQuery+    , rawQueryRes+    , rawSql+    , close'+    , createSqlPool+    , liftSqlPersistMPool+    , runSqlConn+    , runSqlPersistM+    , runSqlPersistMPool+    , runSqlPool+    , withSqlConn+    , withSqlPool+    , readToUnknown+    , readToWrite+    , writeToUnknown+    , getEntityKeyFields+    , entityPrimary+    , keyAndEntityFields+    , PersistStore+    , PersistUnique+    , DeleteCascade(..)+    , PersistConfig(..)+    , BackendSpecificUpdate+    , Entity(..)+    , PersistEntity(..)+    , PersistField(..)+    , SomePersistField(..)+    , PersistQueryRead(..)+    , PersistQueryWrite(..)+    , BackendCompatible(..)+    , BackendKey(..)+    , HasPersistBackend(..)+    , IsPersistBackend+    , PersistCore(..)+    , PersistRecordBackend+    , PersistStoreRead(..)+    , PersistStoreWrite(..)+    , ToBackendKey(..)+    , PersistUniqueRead(..)+    , PersistUniqueWrite(..)+    , PersistFieldSql(..)+    , RawSql(..)+    , CautiousMigration+    , Column(..)+    , ConnectionPool+    , Migration+    , PersistentSqlException(..)+    , Single(..)+    , Sql+    , SqlPersistM+    , SqlPersistT+    , InsertSqlResult(..)+    , IsSqlBackend+    , LogFunc+    , SqlBackend+    , SqlBackendCanRead+    , SqlBackendCanWrite+    , SqlReadBackend(..)+    , SqlReadT+    , SqlWriteBackend(..)+    , SqlWriteT+    , Statement(..)+    , Attr+    , Checkmark(..)+    , CompositeDef(..)+    , EmbedEntityDef(..)+    , EmbedFieldDef(..)+    , EntityDef+    , EntityIdDef(..)+    , ExtraLine+    , FieldDef(..)+    , FieldType(..)+    , ForeignDef(..)+    , ForeignFieldDef+    , IsNullable(..)+    , PersistException(..)+    , PersistFilter(..)+    , PersistUpdate(..)+    , PersistValue(..)+    , ReferenceDef(..)+    , SqlType(..)+    , UniqueDef(..)+    , UpdateException(..)+    , WhyNullable(..)+    , getEntityFields+    , getEntityId+    , getEntityDBName+    , getEntityUniques+    , getEntityDBName     ) where  import Database.Persist.Sql hiding@@ -148,6 +151,7 @@        , delete        , deleteCascadeWhere        , deleteWhereCount+       , exists        , getPersistMap        , limitOffsetOrder        , listToJSON@@ -171,5 +175,4 @@        , (>.)        , (>=.)        , (||.)-       , exists        )

@@ -48,6 +48,7 @@ import Database.Esqueleto.Internal.PersistentImport hiding (upsert, upsertBy) import Database.Persist.Class (OnlyOneUniqueKey) import Database.Persist (ConstraintNameDB(..), EntityNameDB(..))+import Database.Persist.SqlBackend  -- | (@random()@) Split out into database specific modules -- because MySQL uses `rand()`.@@ -207,7 +208,7 @@     -- ^ the record in the database after the operation upsertBy uniqueKey record updates = do     sqlB <- R.ask-    case connUpsertSql sqlB of+    case getConnUpsertSql sqlB of         Nothing ->             -- Postgres backend should have connUpsertSql, if this error is             -- thrown, check changes on persistent@@ -219,7 +220,7 @@     entDef = entityDef (Just record)     updatesText conn = first builderToText $ renderUpdates conn updates #if MIN_VERSION_persistent(2,11,0)-    uniqueFields = NonEmpty.fromList (persistUniqueToFieldNames uniqueKey)+    uniqueFields = persistUniqueToFieldNames uniqueKey     handler sqlB upsertSql = do         let (updateText, updateVals) =                 updatesText sqlB@@ -307,7 +308,7 @@     updates = conflictQuery entCurrent entExcluded     combine (tlb1,vals1) (tlb2,vals2) = (builderToText (tlb1 `mappend` tlb2), vals1 ++ vals2)     entExcluded = EEntity $ I "excluded"-    tableName = unEntityNameDB . entityDB . entityDef+    tableName = unEntityNameDB . getEntityDBName . entityDef     entCurrent = EEntity $ I (tableName proxy)     uniqueDef = toUniqueDef unique     constraint = TLB.fromText . unConstraintNameDB . uniqueDBName $ uniqueDef

@@ -161,10 +161,6 @@          nameContains like "i"  [p4e, p3e]          nameContains like "iv" [p4e] ---- main :: IO () main = do   hspec $ do@@ -173,7 +169,7 @@     describe "Test SQLite locking" $ do       testLocking withConn -    describe "SQLite specific tests" $ do+    fdescribe "SQLite specific tests" $ do       testAscRandom random_ run       testRandomMath run       testSqliteRandom@@ -184,10 +180,6 @@       testSqliteUpdate       testSqliteTextFunctions ---- run, runSilent, runVerbose :: Run runSilent  act = runNoLoggingT     $ run_worker act runVerbose act = runStderrLoggingT $ run_worker act@@ -196,19 +188,15 @@   then runVerbose   else runSilent - verbose :: Bool verbose = False - run_worker :: RunDbMonad m => SqlPersistT (R.ResourceT m) a -> m a run_worker act = withConn $ runSqlConn (migrateIt >> act) - migrateIt :: RunDbMonad m => SqlPersistT (R.ResourceT m) () migrateIt = do   void $ runMigrationSilent migrateAll-  withConn :: RunDbMonad m => (SqlBackend -> R.ResourceT m a) -> m a withConn =