Support upcoming persistent-2.13 (#245)
* stack-8.8.yaml now does GHC 8.8 * support ghc 8.10.4, upgrade to cabal 3.4 * do it * use stack 8.10 by default, support pers2.13 * sqlite tests are failing??? * build with cabal * gitignore * tidy up * work with persistent-2.13 * giddyup * keep cabal file in repo * fixx * changelog, vbump * update cache keys
This commit is contained in:
parent
9fba3e33e4
commit
cd16b2b22f
5
.github/workflows/haskell.yml
vendored
5
.github/workflows/haskell.yml
vendored
@ -32,8 +32,8 @@ jobs:
|
||||
--health-retries=3
|
||||
strategy:
|
||||
matrix:
|
||||
cabal: ["3.2"]
|
||||
ghc: ["8.6.5", "8.8.3", "8.10.1"]
|
||||
cabal: ["3.4"]
|
||||
ghc: ["8.6.5", "8.8.4", "8.10.4"]
|
||||
env:
|
||||
CONFIG: "--enable-tests --enable-benchmarks "
|
||||
steps:
|
||||
@ -68,6 +68,7 @@ jobs:
|
||||
dist-newstyle
|
||||
key: ${{ runner.os }}-${{ matrix.ghc }}-${{ hashFiles('cabal.project.freeze') }}
|
||||
restore-keys: |
|
||||
${{ runner.os }}-${{ matrix.ghc }}-${{ hashFiles('cabal.project.freeze') }}
|
||||
${{ runner.os }}-${{ matrix.ghc }}-
|
||||
- run: cabal v2-build --disable-optimization -j $CONFIG
|
||||
- run: cabal v2-test --disable-optimization -j $CONFIG
|
||||
|
||||
2
.gitignore
vendored
2
.gitignore
vendored
@ -1,7 +1,9 @@
|
||||
.stack-work
|
||||
stack.yaml.lock
|
||||
*.yaml.lock
|
||||
/dist*
|
||||
*~
|
||||
.cabal-sandbox/
|
||||
cabal.sandbox.config
|
||||
.hspec-failures
|
||||
cabal.project.freeze
|
||||
|
||||
@ -1 +1,5 @@
|
||||
packages: .
|
||||
-- Generated by stackage-to-hackage
|
||||
|
||||
packages:
|
||||
./
|
||||
, examples/
|
||||
|
||||
@ -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 @@ library
|
||||
, 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 @@ test-suite sqlite
|
||||
Paths_esqueleto
|
||||
hs-source-dirs:
|
||||
test
|
||||
ghc-options: -Wall
|
||||
ghc-options: -Wall -threaded
|
||||
build-depends:
|
||||
base >=4.8 && <5.0
|
||||
, attoparsec
|
||||
|
||||
1
examples/.gitignore
vendored
1
examples/.gitignore
vendored
@ -1 +0,0 @@
|
||||
*.cabal
|
||||
49
examples/esqueleto-examples.cabal
Normal file
49
examples/esqueleto-examples.cabal
Normal file
@ -0,0 +1,49 @@
|
||||
cabal-version: 1.12
|
||||
|
||||
-- This file has been generated from package.yaml by hpack version 0.34.4.
|
||||
--
|
||||
-- see: https://github.com/sol/hpack
|
||||
--
|
||||
-- hash: d5fddaf37d0c2f27fb2446f5038899d766102efd74ccfe4c7bcd02c61837e6b6
|
||||
|
||||
name: esqueleto-examples
|
||||
version: 0.0.0.0
|
||||
category: Database
|
||||
homepage: https://github.com/bitemyapp/esqueleto#readme
|
||||
bug-reports: https://github.com/bitemyapp/esqueleto/issues
|
||||
author: Fintan Halpenny
|
||||
maintainer: cma@bitemyapp.com
|
||||
copyright: 2019, Chris Allen
|
||||
license: BSD3
|
||||
license-file: LICENSE
|
||||
build-type: Simple
|
||||
extra-source-files:
|
||||
README.md
|
||||
|
||||
source-repository head
|
||||
type: git
|
||||
location: https://github.com/bitemyapp/esqueleto
|
||||
|
||||
flag werror
|
||||
description: Treat warnings as errors
|
||||
manual: True
|
||||
default: False
|
||||
|
||||
executable blog-example
|
||||
main-is: Main.hs
|
||||
other-modules:
|
||||
Blog
|
||||
ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N
|
||||
build-depends:
|
||||
base
|
||||
, esqueleto
|
||||
, monad-control
|
||||
, monad-logger
|
||||
, mtl
|
||||
, persistent >=2.12
|
||||
, persistent-postgresql
|
||||
, transformers-base
|
||||
, unliftio-core
|
||||
if flag(werror)
|
||||
ghc-options: -Werror
|
||||
default-language: Haskell2010
|
||||
@ -13,8 +13,7 @@ extra-source-files:
|
||||
dependencies:
|
||||
- base
|
||||
- esqueleto
|
||||
- persistent
|
||||
- persistent-template
|
||||
- persistent >= 2.12
|
||||
- persistent-postgresql
|
||||
- mtl
|
||||
- monad-logger
|
||||
|
||||
@ -1041,7 +1041,7 @@ from parts = do
|
||||
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 qualified Data.Set as Set
|
||||
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 @@ parseOnExpr sqlBackend text = do
|
||||
-- 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 @@ skipToEscape escapeChar = void (takeWhile (/= escapeChar))
|
||||
|
||||
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 qualified Data.Text.Lazy.Builder as TLB
|
||||
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 @@ fromStart
|
||||
=> 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 @@ subSelectUnsafe = sub SELECT
|
||||
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 @@ e ^. field
|
||||
| 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 @@ toUniqueDef uniqueConstructor = uniqueDef
|
||||
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 @@ instance Show FromClause where
|
||||
"(FromIdent " <> show ident <> ")"
|
||||
|
||||
where
|
||||
dummy = SqlBackend
|
||||
dummy = mkSqlBackend MkSqlBackendArgs
|
||||
{ connEscapeRawName = id
|
||||
}
|
||||
render' = T.unpack . renderExpr dummy
|
||||
@ -2018,6 +2023,43 @@ type IdentInfo = (SqlBackend, IdentState)
|
||||
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 :: 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 . 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 @@ makeFrom info mode fs = ret
|
||||
(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 @@ makeOrderBy info is =
|
||||
|
||||
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 @@ instance SqlSelect (SqlExpr InsertFinal) InsertFinal where
|
||||
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 @@ instance SqlSelect () () where
|
||||
|
||||
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 @@ import Database.Persist.Sql hiding
|
||||
, delete
|
||||
, deleteCascadeWhere
|
||||
, deleteWhereCount
|
||||
, exists
|
||||
, getPersistMap
|
||||
, limitOffsetOrder
|
||||
, listToJSON
|
||||
@ -171,5 +175,4 @@ import Database.Persist.Sql hiding
|
||||
, (>.)
|
||||
, (>=.)
|
||||
, (||.)
|
||||
, exists
|
||||
)
|
||||
|
||||
@ -48,6 +48,7 @@ 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(..))
|
||||
import Database.Persist.SqlBackend
|
||||
|
||||
-- | (@random()@) Split out into database specific modules
|
||||
-- because MySQL uses `rand()`.
|
||||
@ -207,7 +208,7 @@ upsertBy
|
||||
-- ^ 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 @@ upsertBy uniqueKey record updates = do
|
||||
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 @@ 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 = unEntityNameDB . entityDB . entityDef
|
||||
tableName = unEntityNameDB . getEntityDBName . entityDef
|
||||
entCurrent = EEntity $ I (tableName proxy)
|
||||
uniqueDef = toUniqueDef unique
|
||||
constraint = TLB.fromText . unConstraintNameDB . uniqueDBName $ uniqueDef
|
||||
|
||||
12
stack-8.10.yaml
Normal file
12
stack-8.10.yaml
Normal file
@ -0,0 +1,12 @@
|
||||
resolver: lts-17.8
|
||||
|
||||
packages:
|
||||
- '.'
|
||||
- 'examples'
|
||||
|
||||
extra-deps:
|
||||
- lift-type-0.1.0.1
|
||||
- persistent-2.13.0.0
|
||||
- persistent-sqlite-2.13.0.0
|
||||
- persistent-mysql-2.13.0.0
|
||||
- persistent-postgresql-2.13.0.0
|
||||
@ -1,4 +1,4 @@
|
||||
resolver: lts-17.8
|
||||
resolver: lts-16.31
|
||||
|
||||
packages:
|
||||
- '.'
|
||||
|
||||
@ -1,4 +1,6 @@
|
||||
resolver: nightly-2020-09-20
|
||||
resolver: nightly-2021-05-05
|
||||
packages:
|
||||
- '.'
|
||||
- 'examples'
|
||||
|
||||
|
||||
|
||||
@ -6,7 +6,7 @@
|
||||
packages: []
|
||||
snapshots:
|
||||
- completed:
|
||||
size: 467884
|
||||
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/nightly/2020/1/24.yaml
|
||||
sha256: 55c1a4fc9222bc3b8cf91461f38e2641da675a7296f06528f47340c19d0c6e85
|
||||
original: nightly-2020-01-24
|
||||
size: 581922
|
||||
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/nightly/2021/5/5.yaml
|
||||
sha256: 70797737e072284037792abaffd399e029da7ec3c855fd27b16898662f285d82
|
||||
original: nightly-2021-05-05
|
||||
|
||||
@ -1 +1 @@
|
||||
stack-8.8.yaml
|
||||
stack-8.10.yaml
|
||||
@ -161,10 +161,6 @@ testSqliteTextFunctions = do
|
||||
nameContains like "i" [p4e, p3e]
|
||||
nameContains like "iv" [p4e]
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
hspec $ do
|
||||
@ -173,7 +169,7 @@ main = do
|
||||
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 @@ main = do
|
||||
testSqliteUpdate
|
||||
testSqliteTextFunctions
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
run, runSilent, runVerbose :: Run
|
||||
runSilent act = runNoLoggingT $ run_worker act
|
||||
runVerbose act = runStderrLoggingT $ run_worker act
|
||||
@ -196,20 +188,16 @@ run =
|
||||
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 =
|
||||
R.runResourceT . withSqliteConn ":memory:"
|
||||
|
||||
Loading…
Reference in New Issue
Block a user