{-# LANGUAGE ExplicitForAll #-}
{-# OPTIONS_GHC -fno-warn-orphans  #-}
module Database.Persist.Sql.Orphan.PersistUnique
  ()
  where

import Control.Exception (throwIO)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Reader (ask)
import qualified Data.Conduit.List as CL
import Data.Foldable (toList)
import Data.Function (on)
import Data.List (nubBy)
import qualified Data.Text as T

import Database.Persist
import Database.Persist.Class.PersistUnique
       (defaultPutMany, defaultUpsertBy, persistUniqueKeyValues)

import Database.Persist.Sql.Orphan.PersistStore (withRawQuery)
import Database.Persist.Sql.Raw
import Database.Persist.Sql.Types.Internal
import Database.Persist.Sql.Util
       ( dbColumns
       , mkUpdateText'
       , parseEntityValues
       , parseExistsResult
       , updatePersistValue
       )

instance PersistUniqueWrite SqlBackend where
    upsertBy :: forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record SqlBackend,
 SafeToInsert record) =>
Unique record
-> record
-> [Update record]
-> ReaderT SqlBackend m (Entity record)
upsertBy Unique record
uniqueKey record
record [Update record]
updates = do
      SqlBackend
conn <- ReaderT SqlBackend m SqlBackend
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
      let refCol :: Text -> Text
refCol Text
n = [Text] -> Text
T.concat [SqlBackend -> EntityDef -> Text
connEscapeTableName SqlBackend
conn EntityDef
t, Text
".", Text
n]
      let mkUpdateText :: Update record -> Text
mkUpdateText = (FieldNameDB -> Text) -> (Text -> Text) -> Update record -> Text
forall record.
PersistEntity record =>
(FieldNameDB -> Text) -> (Text -> Text) -> Update record -> Text
mkUpdateText' (SqlBackend -> FieldNameDB -> Text
connEscapeFieldName SqlBackend
conn) Text -> Text
refCol
      case SqlBackend
-> Maybe
     (EntityDef -> NonEmpty (FieldNameHS, FieldNameDB) -> Text -> Text)
connUpsertSql SqlBackend
conn of
        Just EntityDef -> NonEmpty (FieldNameHS, FieldNameDB) -> Text -> Text
upsertSql -> case [Update record]
updates of
                            [] -> Unique record
-> record
-> [Update record]
-> ReaderT SqlBackend m (Entity record)
forall record backend (m :: * -> *).
(PersistEntityBackend record ~ BaseBackend backend,
 PersistEntity record, MonadIO m, PersistStoreWrite backend,
 PersistUniqueRead backend, SafeToInsert record) =>
Unique record
-> record -> [Update record] -> ReaderT backend m (Entity record)
defaultUpsertBy Unique record
uniqueKey record
record [Update record]
updates
                            Update record
_:[Update record]
_ -> do
                                let upds :: Text
upds = Text -> [Text] -> Text
T.intercalate Text
"," ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Update record -> Text) -> [Update record] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Update record -> Text
mkUpdateText [Update record]
updates
                                    sql :: Text
sql = EntityDef -> NonEmpty (FieldNameHS, FieldNameDB) -> Text -> Text
upsertSql EntityDef
t (Unique record -> NonEmpty (FieldNameHS, FieldNameDB)
forall record.
PersistEntity record =>
Unique record -> NonEmpty (FieldNameHS, FieldNameDB)
persistUniqueToFieldNames Unique record
uniqueKey) Text
upds
                                    vals :: [PersistValue]
vals = (PersistValue -> PersistValue) -> [PersistValue] -> [PersistValue]
forall a b. (a -> b) -> [a] -> [b]
map PersistValue -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue (record -> [PersistValue]
forall record. PersistEntity record => record -> [PersistValue]
toPersistFields record
record)
                                        [PersistValue] -> [PersistValue] -> [PersistValue]
forall a. [a] -> [a] -> [a]
++ (Update record -> PersistValue)
-> [Update record] -> [PersistValue]
forall a b. (a -> b) -> [a] -> [b]
map Update record -> PersistValue
forall v. Update v -> PersistValue
updatePersistValue [Update record]
updates
                                        [PersistValue] -> [PersistValue] -> [PersistValue]
forall a. [a] -> [a] -> [a]
++ Unique record -> [PersistValue]
forall {record}.
PersistEntity record =>
Unique record -> [PersistValue]
unqs Unique record
uniqueKey

                                [Entity record]
x <- Text -> [PersistValue] -> ReaderT SqlBackend m [Entity record]
forall a (m :: * -> *) backend.
(RawSql a, MonadIO m, BackendCompatible SqlBackend backend) =>
Text -> [PersistValue] -> ReaderT backend m [a]
rawSql Text
sql [PersistValue]
vals
                                Entity record -> ReaderT SqlBackend m (Entity record)
forall a. a -> ReaderT SqlBackend m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Entity record -> ReaderT SqlBackend m (Entity record))
-> Entity record -> ReaderT SqlBackend m (Entity record)
forall a b. (a -> b) -> a -> b
$ [Entity record] -> Entity record
forall a. HasCallStack => [a] -> a
head [Entity record]
x
        Maybe
  (EntityDef -> NonEmpty (FieldNameHS, FieldNameDB) -> Text -> Text)
Nothing -> Unique record
-> record
-> [Update record]
-> ReaderT SqlBackend m (Entity record)
forall record backend (m :: * -> *).
(PersistEntityBackend record ~ BaseBackend backend,
 PersistEntity record, MonadIO m, PersistStoreWrite backend,
 PersistUniqueRead backend, SafeToInsert record) =>
Unique record
-> record -> [Update record] -> ReaderT backend m (Entity record)
defaultUpsertBy Unique record
uniqueKey record
record [Update record]
updates
        where
          t :: EntityDef
t = Maybe record -> EntityDef
forall record (proxy :: * -> *).
PersistEntity record =>
proxy record -> EntityDef
forall (proxy :: * -> *). proxy record -> EntityDef
entityDef (Maybe record -> EntityDef) -> Maybe record -> EntityDef
forall a b. (a -> b) -> a -> b
$ record -> Maybe record
forall a. a -> Maybe a
Just record
record
          unqs :: Unique record -> [PersistValue]
unqs Unique record
uniqueKey' = (Unique record -> [PersistValue])
-> [Unique record] -> [PersistValue]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Unique record -> [PersistValue]
forall {record}.
PersistEntity record =>
Unique record -> [PersistValue]
persistUniqueToValues [Unique record
uniqueKey']

    deleteBy :: forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record SqlBackend) =>
Unique record -> ReaderT SqlBackend m ()
deleteBy Unique record
uniq = do
        SqlBackend
conn <- ReaderT SqlBackend m SqlBackend
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
        let sql' :: Text
sql' = SqlBackend -> Text
sql SqlBackend
conn
            vals :: [PersistValue]
vals = Unique record -> [PersistValue]
forall {record}.
PersistEntity record =>
Unique record -> [PersistValue]
persistUniqueToValues Unique record
uniq
        Text -> [PersistValue] -> ReaderT SqlBackend m ()
forall (m :: * -> *) backend.
(MonadIO m, BackendCompatible SqlBackend backend) =>
Text -> [PersistValue] -> ReaderT backend m ()
rawExecute Text
sql' [PersistValue]
vals
      where
        t :: EntityDef
t = Maybe record -> EntityDef
forall record (proxy :: * -> *).
PersistEntity record =>
proxy record -> EntityDef
forall (proxy :: * -> *). proxy record -> EntityDef
entityDef (Maybe record -> EntityDef) -> Maybe record -> EntityDef
forall a b. (a -> b) -> a -> b
$ Unique record -> Maybe record
forall v. Unique v -> Maybe v
dummyFromUnique Unique record
uniq
        go :: Unique record -> [FieldNameDB]
go = NonEmpty FieldNameDB -> [FieldNameDB]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty FieldNameDB -> [FieldNameDB])
-> (Unique record -> NonEmpty FieldNameDB)
-> Unique record
-> [FieldNameDB]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FieldNameHS, FieldNameDB) -> FieldNameDB)
-> NonEmpty (FieldNameHS, FieldNameDB) -> NonEmpty FieldNameDB
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FieldNameHS, FieldNameDB) -> FieldNameDB
forall a b. (a, b) -> b
snd (NonEmpty (FieldNameHS, FieldNameDB) -> NonEmpty FieldNameDB)
-> (Unique record -> NonEmpty (FieldNameHS, FieldNameDB))
-> Unique record
-> NonEmpty FieldNameDB
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unique record -> NonEmpty (FieldNameHS, FieldNameDB)
forall record.
PersistEntity record =>
Unique record -> NonEmpty (FieldNameHS, FieldNameDB)
persistUniqueToFieldNames
        go' :: SqlBackend -> FieldNameDB -> Text
go' SqlBackend
conn FieldNameDB
x = SqlBackend -> FieldNameDB -> Text
connEscapeFieldName SqlBackend
conn FieldNameDB
x Text -> Text -> Text
forall a. Monoid a => a -> a -> a
`mappend` Text
"=?"
        sql :: SqlBackend -> Text
sql SqlBackend
conn =
            [Text] -> Text
T.concat
                [ Text
"DELETE FROM "
                , SqlBackend -> EntityDef -> Text
connEscapeTableName SqlBackend
conn EntityDef
t
                , Text
" WHERE "
                , Text -> [Text] -> Text
T.intercalate Text
" AND " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (FieldNameDB -> Text) -> [FieldNameDB] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (SqlBackend -> FieldNameDB -> Text
go' SqlBackend
conn) ([FieldNameDB] -> [Text]) -> [FieldNameDB] -> [Text]
forall a b. (a -> b) -> a -> b
$ Unique record -> [FieldNameDB]
go Unique record
uniq]

    putMany :: forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record SqlBackend,
 SafeToInsert record) =>
[record] -> ReaderT SqlBackend m ()
putMany [] = () -> ReaderT SqlBackend m ()
forall a. a -> ReaderT SqlBackend m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    putMany [record]
rsD = do
        let uKeys :: [Unique record]
uKeys = record -> [Unique record]
forall record. PersistEntity record => record -> [Unique record]
persistUniqueKeys (record -> [Unique record])
-> ([record] -> record) -> [record] -> [Unique record]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [record] -> record
forall a. HasCallStack => [a] -> a
head ([record] -> [Unique record]) -> [record] -> [Unique record]
forall a b. (a -> b) -> a -> b
$ [record]
rsD
        case [Unique record]
uKeys of
            [] -> [record] -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
[record] -> ReaderT backend m ()
forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record SqlBackend,
 SafeToInsert record) =>
[record] -> ReaderT SqlBackend m ()
insertMany_ [record]
rsD
            [Unique record]
_ -> ReaderT SqlBackend m ()
go
        where
          go :: ReaderT SqlBackend m ()
go = do
            let rs :: [record]
rs = (record -> record -> Bool) -> [record] -> [record]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy ([PersistValue] -> [PersistValue] -> Bool
forall a. Eq a => a -> a -> Bool
(==) ([PersistValue] -> [PersistValue] -> Bool)
-> (record -> [PersistValue]) -> record -> record -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` record -> [PersistValue]
forall record. PersistEntity record => record -> [PersistValue]
persistUniqueKeyValues) ([record] -> [record]
forall a. [a] -> [a]
reverse [record]
rsD)
            let ent :: EntityDef
ent = [record] -> EntityDef
forall record (proxy :: * -> *).
PersistEntity record =>
proxy record -> EntityDef
forall (proxy :: * -> *). proxy record -> EntityDef
entityDef [record]
rs
            let nr :: Int
nr  = [record] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [record]
rs
            let toVals :: record -> [PersistValue]
toVals record
r = (PersistValue -> PersistValue) -> [PersistValue] -> [PersistValue]
forall a b. (a -> b) -> [a] -> [b]
map PersistValue -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue ([PersistValue] -> [PersistValue])
-> [PersistValue] -> [PersistValue]
forall a b. (a -> b) -> a -> b
$ record -> [PersistValue]
forall record. PersistEntity record => record -> [PersistValue]
toPersistFields record
r
            SqlBackend
conn <- ReaderT SqlBackend m SqlBackend
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
            case SqlBackend -> Maybe (EntityDef -> Int -> Text)
connPutManySql SqlBackend
conn of
                (Just EntityDef -> Int -> Text
mkSql) -> Text -> [PersistValue] -> ReaderT SqlBackend m ()
forall (m :: * -> *) backend.
(MonadIO m, BackendCompatible SqlBackend backend) =>
Text -> [PersistValue] -> ReaderT backend m ()
rawExecute (EntityDef -> Int -> Text
mkSql EntityDef
ent Int
nr) ((record -> [PersistValue]) -> [record] -> [PersistValue]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap record -> [PersistValue]
forall record. PersistEntity record => record -> [PersistValue]
toVals [record]
rs)
                Maybe (EntityDef -> Int -> Text)
Nothing -> [record] -> ReaderT SqlBackend m ()
forall record backend (m :: * -> *).
(PersistEntityBackend record ~ BaseBackend backend,
 PersistEntity record, MonadIO m, PersistStoreWrite backend,
 PersistUniqueRead backend, SafeToInsert record) =>
[record] -> ReaderT backend m ()
defaultPutMany [record]
rs

instance PersistUniqueWrite SqlWriteBackend where
    deleteBy :: forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record SqlWriteBackend) =>
Unique record -> ReaderT SqlWriteBackend m ()
deleteBy Unique record
uniq = ReaderT (BaseBackend SqlWriteBackend) m ()
-> ReaderT SqlWriteBackend m ()
forall backend (m :: * -> *) a.
HasPersistBackend backend =>
ReaderT (BaseBackend backend) m a -> ReaderT backend m a
withBaseBackend (ReaderT (BaseBackend SqlWriteBackend) m ()
 -> ReaderT SqlWriteBackend m ())
-> ReaderT (BaseBackend SqlWriteBackend) m ()
-> ReaderT SqlWriteBackend m ()
forall a b. (a -> b) -> a -> b
$ Unique record -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistUniqueWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Unique record -> ReaderT backend m ()
forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record SqlBackend) =>
Unique record -> ReaderT SqlBackend m ()
deleteBy Unique record
uniq
    upsert :: forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record SqlWriteBackend,
 OnlyOneUniqueKey record, SafeToInsert record) =>
record
-> [Update record] -> ReaderT SqlWriteBackend m (Entity record)
upsert record
rs [Update record]
us = ReaderT (BaseBackend SqlWriteBackend) m (Entity record)
-> ReaderT SqlWriteBackend m (Entity record)
forall backend (m :: * -> *) a.
HasPersistBackend backend =>
ReaderT (BaseBackend backend) m a -> ReaderT backend m a
withBaseBackend (ReaderT (BaseBackend SqlWriteBackend) m (Entity record)
 -> ReaderT SqlWriteBackend m (Entity record))
-> ReaderT (BaseBackend SqlWriteBackend) m (Entity record)
-> ReaderT SqlWriteBackend m (Entity record)
forall a b. (a -> b) -> a -> b
$ record -> [Update record] -> ReaderT SqlBackend m (Entity record)
forall backend record (m :: * -> *).
(PersistUniqueWrite backend, MonadIO m,
 PersistRecordBackend record backend, OnlyOneUniqueKey record,
 SafeToInsert record) =>
record -> [Update record] -> ReaderT backend m (Entity record)
forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record SqlBackend,
 OnlyOneUniqueKey record, SafeToInsert record) =>
record -> [Update record] -> ReaderT SqlBackend m (Entity record)
upsert record
rs [Update record]
us
    putMany :: forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record SqlWriteBackend,
 SafeToInsert record) =>
[record] -> ReaderT SqlWriteBackend m ()
putMany [record]
rs = ReaderT (BaseBackend SqlWriteBackend) m ()
-> ReaderT SqlWriteBackend m ()
forall backend (m :: * -> *) a.
HasPersistBackend backend =>
ReaderT (BaseBackend backend) m a -> ReaderT backend m a
withBaseBackend (ReaderT (BaseBackend SqlWriteBackend) m ()
 -> ReaderT SqlWriteBackend m ())
-> ReaderT (BaseBackend SqlWriteBackend) m ()
-> ReaderT SqlWriteBackend m ()
forall a b. (a -> b) -> a -> b
$ [record] -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistUniqueWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
[record] -> ReaderT backend m ()
forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record SqlBackend,
 SafeToInsert record) =>
[record] -> ReaderT SqlBackend m ()
putMany [record]
rs

instance PersistUniqueRead SqlBackend where
    getBy :: forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record SqlBackend) =>
Unique record -> ReaderT SqlBackend m (Maybe (Entity record))
getBy Unique record
uniq = do
        SqlBackend
conn <- ReaderT SqlBackend m SqlBackend
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
        let sql :: Text
sql =
                [Text] -> Text
T.concat
                    [ Text
"SELECT "
                    , Text -> [Text] -> Text
T.intercalate Text
"," ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty Text -> [Text]) -> NonEmpty Text -> [Text]
forall a b. (a -> b) -> a -> b
$ SqlBackend -> EntityDef -> NonEmpty Text
dbColumns SqlBackend
conn EntityDef
t
                    , Text
" FROM "
                    , SqlBackend -> EntityDef -> Text
connEscapeTableName SqlBackend
conn EntityDef
t
                    , Text
" WHERE "
                    , SqlBackend -> Text
sqlClause SqlBackend
conn]
            uvals :: [PersistValue]
uvals = Unique record -> [PersistValue]
forall {record}.
PersistEntity record =>
Unique record -> [PersistValue]
persistUniqueToValues Unique record
uniq
        Text
-> [PersistValue]
-> ConduitM [PersistValue] Void IO (Maybe (Entity record))
-> ReaderT SqlBackend m (Maybe (Entity record))
forall (m :: * -> *) a.
MonadIO m =>
Text
-> [PersistValue]
-> ConduitM [PersistValue] Void IO a
-> ReaderT SqlBackend m a
withRawQuery Text
sql [PersistValue]
uvals (ConduitM [PersistValue] Void IO (Maybe (Entity record))
 -> ReaderT SqlBackend m (Maybe (Entity record)))
-> ConduitM [PersistValue] Void IO (Maybe (Entity record))
-> ReaderT SqlBackend m (Maybe (Entity record))
forall a b. (a -> b) -> a -> b
$
            do Maybe [PersistValue]
row <- ConduitT [PersistValue] Void IO (Maybe [PersistValue])
forall (m :: * -> *) a o. Monad m => ConduitT a o m (Maybe a)
CL.head
               case Maybe [PersistValue]
row of
                   Maybe [PersistValue]
Nothing -> Maybe (Entity record)
-> ConduitM [PersistValue] Void IO (Maybe (Entity record))
forall a. a -> ConduitT [PersistValue] Void IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Entity record)
forall a. Maybe a
Nothing
                   Just [] -> [Char] -> ConduitM [PersistValue] Void IO (Maybe (Entity record))
forall a. HasCallStack => [Char] -> a
error [Char]
"getBy: empty row"
                   Just [PersistValue]
vals ->
                       case EntityDef -> [PersistValue] -> Either Text (Entity record)
forall record.
PersistEntity record =>
EntityDef -> [PersistValue] -> Either Text (Entity record)
parseEntityValues EntityDef
t [PersistValue]
vals of
                           Left Text
err ->
                               IO (Maybe (Entity record))
-> ConduitM [PersistValue] Void IO (Maybe (Entity record))
forall a. IO a -> ConduitT [PersistValue] Void IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (Entity record))
 -> ConduitM [PersistValue] Void IO (Maybe (Entity record)))
-> IO (Maybe (Entity record))
-> ConduitM [PersistValue] Void IO (Maybe (Entity record))
forall a b. (a -> b) -> a -> b
$ PersistException -> IO (Maybe (Entity record))
forall e a. Exception e => e -> IO a
throwIO (PersistException -> IO (Maybe (Entity record)))
-> PersistException -> IO (Maybe (Entity record))
forall a b. (a -> b) -> a -> b
$ Text -> PersistException
PersistMarshalError Text
err
                           Right Entity record
r -> Maybe (Entity record)
-> ConduitM [PersistValue] Void IO (Maybe (Entity record))
forall a. a -> ConduitT [PersistValue] Void IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Entity record)
 -> ConduitM [PersistValue] Void IO (Maybe (Entity record)))
-> Maybe (Entity record)
-> ConduitM [PersistValue] Void IO (Maybe (Entity record))
forall a b. (a -> b) -> a -> b
$ Entity record -> Maybe (Entity record)
forall a. a -> Maybe a
Just Entity record
r
      where
        sqlClause :: SqlBackend -> Text
sqlClause SqlBackend
conn =
            Text -> [Text] -> Text
T.intercalate Text
" AND " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (FieldNameDB -> Text) -> [FieldNameDB] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (SqlBackend -> FieldNameDB -> Text
go SqlBackend
conn) ([FieldNameDB] -> [Text]) -> [FieldNameDB] -> [Text]
forall a b. (a -> b) -> a -> b
$ Unique record -> [FieldNameDB]
toFieldNames' Unique record
uniq
        go :: SqlBackend -> FieldNameDB -> Text
go SqlBackend
conn FieldNameDB
x = SqlBackend -> FieldNameDB -> Text
connEscapeFieldName SqlBackend
conn FieldNameDB
x Text -> Text -> Text
forall a. Monoid a => a -> a -> a
`mappend` Text
"=?"
        t :: EntityDef
t = Maybe record -> EntityDef
forall record (proxy :: * -> *).
PersistEntity record =>
proxy record -> EntityDef
forall (proxy :: * -> *). proxy record -> EntityDef
entityDef (Maybe record -> EntityDef) -> Maybe record -> EntityDef
forall a b. (a -> b) -> a -> b
$ Unique record -> Maybe record
forall v. Unique v -> Maybe v
dummyFromUnique Unique record
uniq
        toFieldNames' :: Unique record -> [FieldNameDB]
toFieldNames' = NonEmpty FieldNameDB -> [FieldNameDB]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty FieldNameDB -> [FieldNameDB])
-> (Unique record -> NonEmpty FieldNameDB)
-> Unique record
-> [FieldNameDB]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FieldNameHS, FieldNameDB) -> FieldNameDB)
-> NonEmpty (FieldNameHS, FieldNameDB) -> NonEmpty FieldNameDB
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FieldNameHS, FieldNameDB) -> FieldNameDB
forall a b. (a, b) -> b
snd (NonEmpty (FieldNameHS, FieldNameDB) -> NonEmpty FieldNameDB)
-> (Unique record -> NonEmpty (FieldNameHS, FieldNameDB))
-> Unique record
-> NonEmpty FieldNameDB
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unique record -> NonEmpty (FieldNameHS, FieldNameDB)
forall record.
PersistEntity record =>
Unique record -> NonEmpty (FieldNameHS, FieldNameDB)
persistUniqueToFieldNames

    existsBy :: forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record SqlBackend) =>
Unique record -> ReaderT SqlBackend m Bool
existsBy Unique record
uniq = do
        SqlBackend
conn <- ReaderT SqlBackend m SqlBackend
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
        let sql :: Text
sql =
                [Text] -> Text
T.concat
                    [ Text
"SELECT EXISTS(SELECT 1 FROM "
                    , SqlBackend -> EntityDef -> Text
connEscapeTableName SqlBackend
conn EntityDef
t
                    , Text
" WHERE "
                    , SqlBackend -> Text
sqlClause SqlBackend
conn
                    , Text
")"
                    ]
            uvals :: [PersistValue]
uvals = Unique record -> [PersistValue]
forall {record}.
PersistEntity record =>
Unique record -> [PersistValue]
persistUniqueToValues Unique record
uniq
        Text
-> [PersistValue]
-> ConduitM [PersistValue] Void IO Bool
-> ReaderT SqlBackend m Bool
forall (m :: * -> *) a.
MonadIO m =>
Text
-> [PersistValue]
-> ConduitM [PersistValue] Void IO a
-> ReaderT SqlBackend m a
withRawQuery Text
sql [PersistValue]
uvals (ConduitM [PersistValue] Void IO Bool -> ReaderT SqlBackend m Bool)
-> ConduitM [PersistValue] Void IO Bool
-> ReaderT SqlBackend m Bool
forall a b. (a -> b) -> a -> b
$ do
            Maybe [PersistValue]
mm <- ConduitT [PersistValue] Void IO (Maybe [PersistValue])
forall (m :: * -> *) a o. Monad m => ConduitT a o m (Maybe a)
CL.head
            Bool -> ConduitM [PersistValue] Void IO Bool
forall a. a -> ConduitT [PersistValue] Void IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> ConduitM [PersistValue] Void IO Bool)
-> Bool -> ConduitM [PersistValue] Void IO Bool
forall a b. (a -> b) -> a -> b
$ Maybe [PersistValue] -> Text -> [Char] -> Bool
parseExistsResult Maybe [PersistValue]
mm Text
sql [Char]
"PersistUnique.existsBy"
      where
        sqlClause :: SqlBackend -> Text
sqlClause SqlBackend
conn =
            Text -> [Text] -> Text
T.intercalate Text
" AND " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (FieldNameDB -> Text) -> [FieldNameDB] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (SqlBackend -> FieldNameDB -> Text
go SqlBackend
conn) ([FieldNameDB] -> [Text]) -> [FieldNameDB] -> [Text]
forall a b. (a -> b) -> a -> b
$ Unique record -> [FieldNameDB]
toFieldNames' Unique record
uniq
        go :: SqlBackend -> FieldNameDB -> Text
go SqlBackend
conn FieldNameDB
x = SqlBackend -> FieldNameDB -> Text
connEscapeFieldName SqlBackend
conn FieldNameDB
x Text -> Text -> Text
forall a. Monoid a => a -> a -> a
`mappend` Text
"=?"
        t :: EntityDef
t = Maybe record -> EntityDef
forall record (proxy :: * -> *).
PersistEntity record =>
proxy record -> EntityDef
forall (proxy :: * -> *). proxy record -> EntityDef
entityDef (Maybe record -> EntityDef) -> Maybe record -> EntityDef
forall a b. (a -> b) -> a -> b
$ Unique record -> Maybe record
forall v. Unique v -> Maybe v
dummyFromUnique Unique record
uniq
        toFieldNames' :: Unique record -> [FieldNameDB]
toFieldNames' = NonEmpty FieldNameDB -> [FieldNameDB]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty FieldNameDB -> [FieldNameDB])
-> (Unique record -> NonEmpty FieldNameDB)
-> Unique record
-> [FieldNameDB]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FieldNameHS, FieldNameDB) -> FieldNameDB)
-> NonEmpty (FieldNameHS, FieldNameDB) -> NonEmpty FieldNameDB
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FieldNameHS, FieldNameDB) -> FieldNameDB
forall a b. (a, b) -> b
snd (NonEmpty (FieldNameHS, FieldNameDB) -> NonEmpty FieldNameDB)
-> (Unique record -> NonEmpty (FieldNameHS, FieldNameDB))
-> Unique record
-> NonEmpty FieldNameDB
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unique record -> NonEmpty (FieldNameHS, FieldNameDB)
forall record.
PersistEntity record =>
Unique record -> NonEmpty (FieldNameHS, FieldNameDB)
persistUniqueToFieldNames

instance PersistUniqueRead SqlReadBackend where
    getBy :: forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record SqlReadBackend) =>
Unique record -> ReaderT SqlReadBackend m (Maybe (Entity record))
getBy Unique record
uniq = ReaderT (BaseBackend SqlReadBackend) m (Maybe (Entity record))
-> ReaderT SqlReadBackend m (Maybe (Entity record))
forall backend (m :: * -> *) a.
HasPersistBackend backend =>
ReaderT (BaseBackend backend) m a -> ReaderT backend m a
withBaseBackend (ReaderT (BaseBackend SqlReadBackend) m (Maybe (Entity record))
 -> ReaderT SqlReadBackend m (Maybe (Entity record)))
-> ReaderT (BaseBackend SqlReadBackend) m (Maybe (Entity record))
-> ReaderT SqlReadBackend m (Maybe (Entity record))
forall a b. (a -> b) -> a -> b
$ Unique record -> ReaderT SqlBackend m (Maybe (Entity record))
forall backend record (m :: * -> *).
(PersistUniqueRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
Unique record -> ReaderT backend m (Maybe (Entity record))
forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record SqlBackend) =>
Unique record -> ReaderT SqlBackend m (Maybe (Entity record))
getBy Unique record
uniq
    existsBy :: forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record SqlReadBackend) =>
Unique record -> ReaderT SqlReadBackend m Bool
existsBy Unique record
uniq = ReaderT (BaseBackend SqlReadBackend) m Bool
-> ReaderT SqlReadBackend m Bool
forall backend (m :: * -> *) a.
HasPersistBackend backend =>
ReaderT (BaseBackend backend) m a -> ReaderT backend m a
withBaseBackend (ReaderT (BaseBackend SqlReadBackend) m Bool
 -> ReaderT SqlReadBackend m Bool)
-> ReaderT (BaseBackend SqlReadBackend) m Bool
-> ReaderT SqlReadBackend m Bool
forall a b. (a -> b) -> a -> b
$ Unique record -> ReaderT SqlBackend m Bool
forall backend record (m :: * -> *).
(PersistUniqueRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
Unique record -> ReaderT backend m Bool
forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record SqlBackend) =>
Unique record -> ReaderT SqlBackend m Bool
existsBy Unique record
uniq

instance PersistUniqueRead SqlWriteBackend where
    getBy :: forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record SqlWriteBackend) =>
Unique record -> ReaderT SqlWriteBackend m (Maybe (Entity record))
getBy Unique record
uniq = ReaderT (BaseBackend SqlWriteBackend) m (Maybe (Entity record))
-> ReaderT SqlWriteBackend m (Maybe (Entity record))
forall backend (m :: * -> *) a.
HasPersistBackend backend =>
ReaderT (BaseBackend backend) m a -> ReaderT backend m a
withBaseBackend (ReaderT (BaseBackend SqlWriteBackend) m (Maybe (Entity record))
 -> ReaderT SqlWriteBackend m (Maybe (Entity record)))
-> ReaderT (BaseBackend SqlWriteBackend) m (Maybe (Entity record))
-> ReaderT SqlWriteBackend m (Maybe (Entity record))
forall a b. (a -> b) -> a -> b
$ Unique record -> ReaderT SqlBackend m (Maybe (Entity record))
forall backend record (m :: * -> *).
(PersistUniqueRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
Unique record -> ReaderT backend m (Maybe (Entity record))
forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record SqlBackend) =>
Unique record -> ReaderT SqlBackend m (Maybe (Entity record))
getBy Unique record
uniq
    existsBy :: forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record SqlWriteBackend) =>
Unique record -> ReaderT SqlWriteBackend m Bool
existsBy Unique record
uniq = ReaderT (BaseBackend SqlWriteBackend) m Bool
-> ReaderT SqlWriteBackend m Bool
forall backend (m :: * -> *) a.
HasPersistBackend backend =>
ReaderT (BaseBackend backend) m a -> ReaderT backend m a
withBaseBackend (ReaderT (BaseBackend SqlWriteBackend) m Bool
 -> ReaderT SqlWriteBackend m Bool)
-> ReaderT (BaseBackend SqlWriteBackend) m Bool
-> ReaderT SqlWriteBackend m Bool
forall a b. (a -> b) -> a -> b
$ Unique record -> ReaderT SqlBackend m Bool
forall backend record (m :: * -> *).
(PersistUniqueRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
Unique record -> ReaderT backend m Bool
forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record SqlBackend) =>
Unique record -> ReaderT SqlBackend m Bool
existsBy Unique record
uniq

dummyFromUnique :: Unique v -> Maybe v
dummyFromUnique :: forall v. Unique v -> Maybe v
dummyFromUnique Unique v
_ = Maybe v
forall a. Maybe a
Nothing