Remove entity specific constructors from SqlExpr
This commit is contained in:
belevy
parent
4dc58ec1b8
commit
f77134e788
@ -52,7 +52,7 @@ instance PersistEntity a => From (Table a) where
|
||||
runFrom e@Table = do
|
||||
let ed = entityDef $ getVal e
|
||||
ident <- newIdentFor (entityDB ed)
|
||||
let entity = EEntity ident
|
||||
let entity = unsafeSqlEntity ident
|
||||
pure $ (entity, FromStart ident ed)
|
||||
where
|
||||
getVal :: Table ent -> Proxy ent
|
||||
|
||||
@ -1,13 +1,12 @@
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
|
||||
module Database.Esqueleto.Experimental.ToAlias
|
||||
where
|
||||
|
||||
import Database.Esqueleto.Internal.Internal hiding (From,
|
||||
from, on)
|
||||
import Database.Esqueleto.Internal.PersistentImport
|
||||
import Database.Esqueleto.Internal.Internal hiding (From, from, on)
|
||||
import Database.Esqueleto.Internal.PersistentImport
|
||||
|
||||
{-# DEPRECATED ToAliasT "This type alias doesn't do anything. Please delete it. Will be removed in the next release." #-}
|
||||
type ToAliasT a = a
|
||||
@ -17,22 +16,26 @@ class ToAlias a where
|
||||
toAlias :: a -> SqlQuery a
|
||||
|
||||
instance ToAlias (SqlExpr (Value a)) where
|
||||
toAlias (ERaw m f)
|
||||
| Nothing <- sqlExprMetaAlias m = do
|
||||
ident <- newIdentFor (DBName "v")
|
||||
pure $ ERaw noMeta{sqlExprMetaAlias = Just ident} $ \_ info ->
|
||||
let (b, v) = f Never info
|
||||
in (b <> " AS " <> useIdent info ident, [])
|
||||
toAlias (ERaw m f) =
|
||||
case sqlExprMetaAlias m of
|
||||
Just _ -> pure $ ERaw m f
|
||||
Nothing -> do
|
||||
ident <- newIdentFor (DBName "v")
|
||||
pure $ ERaw noMeta{sqlExprMetaAlias = Just ident} $ \_ info ->
|
||||
let (b, v) = f Never info
|
||||
in (b <> " AS " <> useIdent info ident, [])
|
||||
|
||||
|
||||
instance ToAlias (SqlExpr (Entity a)) where
|
||||
toAlias v@(EAliasedEntityReference _ _) = pure v
|
||||
toAlias v@(EAliasedEntity _ _) = pure v
|
||||
toAlias (EEntity tableIdent) = do
|
||||
toAlias (ERaw m f) = do
|
||||
ident <- newIdentFor (DBName "v")
|
||||
pure $ EAliasedEntity ident tableIdent
|
||||
pure $ ERaw m{sqlExprMetaIsReference = False, sqlExprMetaAlias = Just ident} f
|
||||
|
||||
instance ToAlias (SqlExpr (Maybe (Entity a))) where
|
||||
toAlias (EMaybe e) = EMaybe <$> toAlias e
|
||||
-- FIXME: Code duplication because the compiler doesnt like half final encoding
|
||||
toAlias (ERaw m f) = do
|
||||
ident <- newIdentFor (DBName "v")
|
||||
pure $ ERaw m{sqlExprMetaIsReference = False, sqlExprMetaAlias = Just ident} f
|
||||
|
||||
instance (ToAlias a, ToAlias b) => ToAlias (a,b) where
|
||||
toAlias (a,b) = (,) <$> toAlias a <*> toAlias b
|
||||
|
||||
@ -1,14 +1,13 @@
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
|
||||
module Database.Esqueleto.Experimental.ToAliasReference
|
||||
where
|
||||
|
||||
import Database.Esqueleto.Experimental.ToAlias
|
||||
import Database.Esqueleto.Internal.Internal hiding (From,
|
||||
from, on)
|
||||
import Database.Esqueleto.Internal.PersistentImport
|
||||
import Database.Esqueleto.Experimental.ToAlias
|
||||
import Database.Esqueleto.Internal.Internal hiding (From, from, on)
|
||||
import Database.Esqueleto.Internal.PersistentImport
|
||||
|
||||
{-# DEPRECATED ToAliasReferenceT "This type alias doesn't do anything. Please delete it. Will be removed in the next release." #-}
|
||||
type ToAliasReferenceT a = a
|
||||
@ -19,16 +18,24 @@ class ToAliasReference a where
|
||||
|
||||
instance ToAliasReference (SqlExpr (Value a)) where
|
||||
toAliasReference aliasSource (ERaw m _)
|
||||
| Just alias <- sqlExprMetaAlias m = pure $ ERaw noMeta $ \p info ->
|
||||
| Just alias <- sqlExprMetaAlias m = pure $ ERaw m $ \_ info ->
|
||||
(useIdent info aliasSource <> "." <> useIdent info alias, [])
|
||||
toAliasReference _ e = pure e
|
||||
|
||||
instance ToAliasReference (SqlExpr (Entity a)) where
|
||||
toAliasReference aliasSource (EAliasedEntity ident _) = pure $ EAliasedEntityReference aliasSource ident
|
||||
toAliasReference _ e@(EEntity _) = toAlias e
|
||||
toAliasReference s (EAliasedEntityReference _ b) = pure $ EAliasedEntityReference s b
|
||||
toAliasReference aliasSource (ERaw m _)
|
||||
| Just _ <- sqlExprMetaAlias m, False <- sqlExprMetaIsReference m =
|
||||
pure $ ERaw m{sqlExprMetaIsReference = True} $ \_ info ->
|
||||
(useIdent info aliasSource, [])
|
||||
toAliasReference _ e = pure e
|
||||
|
||||
instance ToAliasReference (SqlExpr (Maybe (Entity a))) where
|
||||
toAliasReference s (EMaybe e) = EMaybe <$> toAliasReference s e
|
||||
-- FIXME: Code duplication because the compiler doesnt like half final encoding
|
||||
toAliasReference aliasSource (ERaw m f)
|
||||
| Just _ <- sqlExprMetaAlias m, False <- sqlExprMetaIsReference m =
|
||||
pure $ ERaw m{sqlExprMetaIsReference = True} $ \_ info ->
|
||||
(useIdent info aliasSource, [])
|
||||
toAliasReference s e = pure e
|
||||
|
||||
|
||||
instance (ToAliasReference a, ToAliasReference b) => ToAliasReference (a, b) where
|
||||
|
||||
@ -21,7 +21,7 @@ instance ToMaybe (SqlExpr (Maybe a)) where
|
||||
|
||||
instance ToMaybe (SqlExpr (Entity a)) where
|
||||
type ToMaybeT (SqlExpr (Entity a)) = SqlExpr (Maybe (Entity a))
|
||||
toMaybe = EMaybe
|
||||
toMaybe (ERaw f m) = (ERaw f m)
|
||||
|
||||
instance ToMaybe (SqlExpr (Value a)) where
|
||||
type ToMaybeT (SqlExpr (Value a)) = SqlExpr (Value (Maybe (Nullable a)))
|
||||
|
||||
@ -88,7 +88,7 @@ fromStart
|
||||
fromStart = do
|
||||
let ed = entityDef (Proxy :: Proxy a)
|
||||
ident <- newIdentFor (entityDB ed)
|
||||
let ret = EEntity ident
|
||||
let ret = unsafeSqlEntity ident
|
||||
f' = FromStart ident ed
|
||||
return (EPreprocessedFrom ret f')
|
||||
|
||||
@ -103,7 +103,7 @@ fromStartMaybe = maybelize <$> fromStart
|
||||
maybelize
|
||||
:: SqlExpr (PreprocessedFrom (SqlExpr (Entity a)))
|
||||
-> SqlExpr (PreprocessedFrom (SqlExpr (Maybe (Entity a))))
|
||||
maybelize (EPreprocessedFrom ret f') = EPreprocessedFrom (EMaybe ret) f'
|
||||
maybelize (EPreprocessedFrom (ERaw m f) f') = EPreprocessedFrom (ERaw m f) f'
|
||||
|
||||
-- | (Internal) Do a @JOIN@.
|
||||
fromJoin
|
||||
@ -527,9 +527,12 @@ subSelectUnsafe = sub SELECT
|
||||
=> SqlExpr (Entity val)
|
||||
-> EntityField val typ
|
||||
-> SqlExpr (Value typ)
|
||||
(EAliasedEntityReference source base) ^. field =
|
||||
ERaw noMeta $ \_ info ->
|
||||
(useIdent info source <> "." <> useIdent info (aliasedEntityColumnIdent base fieldDef), [])
|
||||
e ^. field
|
||||
| isIdField field = idFieldValue
|
||||
| ERaw m f <- e, Just alias <- sqlExprMetaAlias m =
|
||||
ERaw noMeta $ \_ info ->
|
||||
f Never info <> ("." <> useIdent info (aliasedEntityColumnIdent alias fieldDef), [])
|
||||
| otherwise = ERaw noMeta $ \_ info -> (dot info $ persistFieldDef field, [])
|
||||
where
|
||||
fieldDef =
|
||||
if isIdField field then
|
||||
@ -537,13 +540,6 @@ subSelectUnsafe = sub SELECT
|
||||
head $ entityKeyFields ed
|
||||
else
|
||||
persistFieldDef field
|
||||
|
||||
ed = entityDef $ getEntityVal (Proxy :: Proxy (SqlExpr (Entity val)))
|
||||
|
||||
e ^. field
|
||||
| isIdField field = idFieldValue
|
||||
| otherwise = ERaw noMeta $ \_ info -> (dot info $ persistFieldDef field, [])
|
||||
where
|
||||
idFieldValue =
|
||||
case entityKeyFields ed of
|
||||
idField:[] ->
|
||||
@ -558,29 +554,19 @@ e ^. field
|
||||
ed = entityDef $ getEntityVal (Proxy :: Proxy (SqlExpr (Entity val)))
|
||||
|
||||
dot info fieldDef =
|
||||
useIdent info sourceIdent <> "." <> fieldIdent
|
||||
sourceIdent info <> "." <> fieldIdent
|
||||
where
|
||||
sourceIdent =
|
||||
case e of
|
||||
EEntity ident -> ident
|
||||
EAliasedEntity baseI _ -> baseI
|
||||
EAliasedEntityReference a b ->
|
||||
error $ unwords
|
||||
[ "Used (^.) with an EAliasedEntityReference."
|
||||
, "Please file this as an Esqueleto bug."
|
||||
, "EAliasedEntityReference", show a, show b
|
||||
]
|
||||
ERaw _ f -> fmap fst $ f Never
|
||||
fieldIdent =
|
||||
case e of
|
||||
EEntity _ -> fromDBName info (fieldDB fieldDef)
|
||||
EAliasedEntity baseI _ -> useIdent info $ aliasedEntityColumnIdent baseI fieldDef
|
||||
EAliasedEntityReference a b ->
|
||||
error $ unwords
|
||||
[ "Used (^.) with an EAliasedEntityReference."
|
||||
, "Please file this as an Esqueleto bug."
|
||||
, "EAliasedEntityReference", show a, show b
|
||||
]
|
||||
|
||||
ERaw m f ->
|
||||
case sqlExprMetaAlias m of
|
||||
Just baseI ->
|
||||
useIdent info $ aliasedEntityColumnIdent baseI fieldDef
|
||||
Nothing ->
|
||||
fromDBName info (fieldDB fieldDef)
|
||||
|
||||
-- | Project an SqlExpression that may be null, guarding against null cases.
|
||||
withNonNull
|
||||
@ -598,7 +584,7 @@ withNonNull field f = do
|
||||
=> SqlExpr (Maybe (Entity val))
|
||||
-> EntityField val typ
|
||||
-> SqlExpr (Value (Maybe typ))
|
||||
EMaybe r ?. field = just (r ^. field)
|
||||
ERaw m f ?. field = just (ERaw m f ^. field)
|
||||
|
||||
-- | Lift a constant value from Haskell-land to the query.
|
||||
val :: PersistField typ => typ -> SqlExpr (Value typ)
|
||||
@ -2012,12 +1998,14 @@ useIdent info (I ident) = fromDBName info $ DBName ident
|
||||
data SqlExprMeta = SqlExprMeta
|
||||
{ sqlExprMetaCompositeFields :: Maybe (IdentInfo -> [TLB.Builder])
|
||||
, sqlExprMetaAlias :: Maybe Ident
|
||||
, sqlExprMetaIsReference :: Bool
|
||||
}
|
||||
|
||||
noMeta :: SqlExprMeta
|
||||
noMeta = SqlExprMeta
|
||||
{ sqlExprMetaCompositeFields = Nothing
|
||||
, sqlExprMetaAlias = Nothing
|
||||
, sqlExprMetaIsReference = False
|
||||
}
|
||||
|
||||
hasCompositeKeyMeta :: SqlExprMeta -> Bool
|
||||
@ -2028,16 +2016,6 @@ hasCompositeKeyMeta = Maybe.isJust . sqlExprMetaCompositeFields
|
||||
-- There are many comments describing the constructors of this
|
||||
-- data type. However, Haddock doesn't like GADTs, so you'll have to read them by hitting \"Source\".
|
||||
data SqlExpr a where
|
||||
-- An entity, created by 'from' (cf. 'fromStart').
|
||||
EEntity :: Ident -> SqlExpr (Entity val)
|
||||
-- Base Table
|
||||
EAliasedEntity :: Ident -> Ident -> SqlExpr (Entity val)
|
||||
-- Source Base
|
||||
EAliasedEntityReference :: Ident -> Ident -> SqlExpr (Entity val)
|
||||
|
||||
-- Just a tag stating that something is nullable.
|
||||
EMaybe :: SqlExpr a -> SqlExpr (Maybe a)
|
||||
|
||||
-- Raw expression: states whether parenthesis are needed
|
||||
-- around this expression, and takes information about the SQL
|
||||
-- connection (mainly for escaping names) and returns both an
|
||||
@ -2270,6 +2248,10 @@ unsafeSqlValue :: TLB.Builder -> SqlExpr (Value a)
|
||||
unsafeSqlValue v = ERaw noMeta $ \_ _ -> (v, mempty)
|
||||
{-# INLINE unsafeSqlValue #-}
|
||||
|
||||
unsafeSqlEntity :: PersistEntity ent => Ident -> SqlExpr (Entity ent)
|
||||
unsafeSqlEntity ident = ERaw noMeta $ \_ info ->
|
||||
(useIdent info ident, [])
|
||||
|
||||
valueToFunctionArg :: IdentInfo -> SqlExpr (Value a) -> (TLB.Builder, [PersistValue])
|
||||
valueToFunctionArg info v =
|
||||
case v of
|
||||
@ -3035,37 +3017,36 @@ unescapedColumnNames ent =
|
||||
|
||||
-- | 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)
|
||||
-- '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
|
||||
-- clause), while 'rawSql' assumes that it's just the
|
||||
-- name of the table (which doesn't allow self-joins, for
|
||||
-- example).
|
||||
name = useIdent info ident <> "."
|
||||
ret = let ed = entityDef $ getEntityVal $ return expr
|
||||
in (process ed, mempty)
|
||||
sqlSelectCols info expr@(EAliasedEntity aliasIdent tableIdent) = ret
|
||||
where
|
||||
process ed = uncommas $
|
||||
map ((name <>) . aliasName) $
|
||||
unescapedColumnNames ed
|
||||
aliasName columnName = (fromDBName info columnName) <> " AS " <> aliasedColumnName aliasIdent info (unDBName columnName)
|
||||
name = useIdent info tableIdent <> "."
|
||||
ret = let ed = entityDef $ getEntityVal $ return expr
|
||||
in (process ed, mempty)
|
||||
sqlSelectCols info expr@(EAliasedEntityReference sourceIdent baseIdent) = ret
|
||||
where
|
||||
process ed = uncommas $
|
||||
map ((name <>) . aliasedColumnName baseIdent info . unDBName) $
|
||||
unescapedColumnNames ed
|
||||
name = useIdent info sourceIdent <> "."
|
||||
ret = let ed = entityDef $ getEntityVal $ return expr
|
||||
in (process ed, mempty)
|
||||
sqlSelectCols info expr@(ERaw m f)
|
||||
| Just baseIdent <- sqlExprMetaAlias m, False <- sqlExprMetaIsReference m =
|
||||
let process ed = uncommas $
|
||||
map ((name <>) . aliasName) $
|
||||
unescapedColumnNames ed
|
||||
aliasName columnName = (fromDBName info columnName) <> " AS " <> aliasedColumnName baseIdent info (unDBName columnName)
|
||||
name = fst (f Never info) <> "."
|
||||
ed = entityDef $ getEntityVal $ return expr
|
||||
in (process ed, mempty)
|
||||
| Just baseIdent <- sqlExprMetaAlias m, True <- sqlExprMetaIsReference m =
|
||||
let process ed = uncommas $
|
||||
map ((name <>) . aliasedColumnName baseIdent info . unDBName) $
|
||||
unescapedColumnNames ed
|
||||
name = fst (f Never info) <> "."
|
||||
ed = entityDef $ getEntityVal $ return expr
|
||||
in (process ed, mempty)
|
||||
| otherwise =
|
||||
let process ed = uncommas $
|
||||
map ((name <>) . TLB.fromText) $
|
||||
entityColumnNames 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
|
||||
-- clause), while 'rawSql' assumes that it's just the
|
||||
-- name of the table (which doesn't allow self-joins, for
|
||||
-- example).
|
||||
name = fst (f Never info) <> "."
|
||||
ed = entityDef $ getEntityVal $ return expr
|
||||
in (process ed, mempty)
|
||||
|
||||
sqlSelectColCount = entityColumnCount . entityDef . getEntityVal
|
||||
sqlSelectProcessRow = parseEntityValues ed
|
||||
where
|
||||
@ -3076,7 +3057,7 @@ getEntityVal = const Proxy
|
||||
|
||||
-- | You may return a possibly-@NULL@ 'Entity' from a 'select' query.
|
||||
instance PersistEntity a => SqlSelect (SqlExpr (Maybe (Entity a))) (Maybe (Entity a)) where
|
||||
sqlSelectCols info (EMaybe ent) = sqlSelectCols info ent
|
||||
sqlSelectCols info (ERaw m f) = sqlSelectCols info (ERaw m f :: SqlExpr (Entity a))
|
||||
sqlSelectColCount = sqlSelectColCount . fromEMaybe
|
||||
where
|
||||
fromEMaybe :: Proxy (SqlExpr (Maybe e)) -> Proxy (SqlExpr e)
|
||||
|
||||
@ -1,18 +1,18 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE ConstraintKinds #-}
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
{-# LANGUAGE EmptyDataDecls #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE ConstraintKinds #-}
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
{-# LANGUAGE EmptyDataDecls #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE FunctionalDependencies #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE InstanceSigs #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE Rank2Types #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE InstanceSigs #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE Rank2Types #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
|
||||
|
||||
-- | This is an internal module, anything exported by this module
|
||||
@ -38,6 +38,7 @@ module Database.Esqueleto.Internal.Sql
|
||||
, unsafeSqlCase
|
||||
, unsafeSqlBinOp
|
||||
, unsafeSqlValue
|
||||
, unsafeSqlEntity
|
||||
, unsafeSqlCastAs
|
||||
, unsafeSqlFunction
|
||||
, unsafeSqlExtractSubField
|
||||
@ -74,4 +75,4 @@ module Database.Esqueleto.Internal.Sql
|
||||
, associateJoin
|
||||
) where
|
||||
|
||||
import Database.Esqueleto.Internal.Internal
|
||||
import Database.Esqueleto.Internal.Internal
|
||||
|
||||
@ -1,8 +1,8 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE Rank2Types #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE Rank2Types #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
|
||||
-- | This module contain PostgreSQL-specific functions.
|
||||
@ -31,23 +31,22 @@ module Database.Esqueleto.PostgreSQL
|
||||
) where
|
||||
|
||||
#if __GLASGOW_HASKELL__ < 804
|
||||
import Data.Semigroup
|
||||
import Data.Semigroup
|
||||
#endif
|
||||
import Control.Arrow (first, (***))
|
||||
import Control.Exception (throw)
|
||||
import Control.Monad (void)
|
||||
import Control.Monad.IO.Class (MonadIO (..))
|
||||
import qualified Control.Monad.Trans.Reader as R
|
||||
import Data.Int (Int64)
|
||||
import Data.List.NonEmpty (NonEmpty ((:|)))
|
||||
import qualified Data.List.NonEmpty as NonEmpty
|
||||
import Data.Proxy (Proxy (..))
|
||||
import qualified Data.Text.Internal.Builder as TLB
|
||||
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 Control.Arrow (first, (***))
|
||||
import Control.Exception (throw)
|
||||
import Control.Monad (void)
|
||||
import Control.Monad.IO.Class (MonadIO(..))
|
||||
import qualified Control.Monad.Trans.Reader as R
|
||||
import Data.Int (Int64)
|
||||
import Data.List.NonEmpty (NonEmpty((:|)))
|
||||
import qualified Data.List.NonEmpty as NonEmpty
|
||||
import Data.Proxy (Proxy(..))
|
||||
import qualified Data.Text.Internal.Builder as TLB
|
||||
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)
|
||||
|
||||
-- | (@random()@) Split out into database specific modules
|
||||
-- because MySQL uses `rand()`.
|
||||
@ -306,9 +305,9 @@ insertSelectWithConflictCount unique query conflictQuery = do
|
||||
proxy = Proxy
|
||||
updates = conflictQuery entCurrent entExcluded
|
||||
combine (tlb1,vals1) (tlb2,vals2) = (builderToText (tlb1 `mappend` tlb2), vals1 ++ vals2)
|
||||
entExcluded = EEntity $ I "excluded"
|
||||
entExcluded = unsafeSqlEntity (I "excluded")
|
||||
tableName = unDBName . entityDB . entityDef
|
||||
entCurrent = EEntity $ I (tableName proxy)
|
||||
entCurrent = unsafeSqlEntity (I (tableName proxy))
|
||||
uniqueDef = toUniqueDef unique
|
||||
constraint = TLB.fromText . unDBName . uniqueDBName $ uniqueDef
|
||||
renderedUpdates :: (BackendCompatible SqlBackend backend) => backend -> (TLB.Builder, [PersistValue])
|
||||
|
||||
@ -1,25 +1,25 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE ConstraintKinds #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE DerivingStrategies #-}
|
||||
{-# LANGUAGE EmptyDataDecls #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE ConstraintKinds #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE DerivingStrategies #-}
|
||||
{-# LANGUAGE EmptyDataDecls #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE PartialTypeSignatures #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE Rank2Types #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE StandaloneDeriving #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE TypeSynonymInstances #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE PartialTypeSignatures #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE Rank2Types #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE StandaloneDeriving #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE TypeSynonymInstances #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
|
||||
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
|
||||
{-# OPTIONS_GHC -fno-warn-deprecations #-}
|
||||
@ -62,41 +62,37 @@ module Common.Test
|
||||
, Key(..)
|
||||
) where
|
||||
|
||||
import Control.Monad (forM_, replicateM,
|
||||
replicateM_, void)
|
||||
import Control.Monad.Catch (MonadCatch)
|
||||
import Control.Monad.Reader (ask)
|
||||
import Data.Either
|
||||
import Data.Time
|
||||
import Control.Monad (forM_, replicateM, replicateM_, void)
|
||||
import Control.Monad.Catch (MonadCatch)
|
||||
import Control.Monad.Reader (ask)
|
||||
import Data.Either
|
||||
import Data.Time
|
||||
#if __GLASGOW_HASKELL__ >= 806
|
||||
import Control.Monad.Fail (MonadFail)
|
||||
import Control.Monad.Fail (MonadFail)
|
||||
#endif
|
||||
import Control.Monad.IO.Class (MonadIO (liftIO))
|
||||
import Control.Monad.Logger (MonadLogger (..),
|
||||
NoLoggingT,
|
||||
runNoLoggingT)
|
||||
import Control.Monad.Trans.Reader (ReaderT)
|
||||
import qualified Data.Attoparsec.Text as AP
|
||||
import Data.Char (toLower, toUpper)
|
||||
import Data.Monoid ((<>))
|
||||
import Database.Esqueleto
|
||||
import Database.Esqueleto.Experimental hiding (from, on)
|
||||
import qualified Database.Esqueleto.Experimental as Experimental
|
||||
import Database.Persist.TH
|
||||
import Test.Hspec
|
||||
import UnliftIO
|
||||
import Control.Monad.IO.Class (MonadIO(liftIO))
|
||||
import Control.Monad.Logger (MonadLogger(..), NoLoggingT, runNoLoggingT)
|
||||
import Control.Monad.Trans.Reader (ReaderT)
|
||||
import qualified Data.Attoparsec.Text as AP
|
||||
import Data.Char (toLower, toUpper)
|
||||
import Data.Monoid ((<>))
|
||||
import Database.Esqueleto
|
||||
import Database.Esqueleto.Experimental hiding (from, on)
|
||||
import qualified Database.Esqueleto.Experimental as Experimental
|
||||
import Database.Persist.TH
|
||||
import Test.Hspec
|
||||
import UnliftIO
|
||||
|
||||
import Data.Conduit (ConduitT, runConduit,
|
||||
(.|))
|
||||
import qualified Data.Conduit.List as CL
|
||||
import qualified Data.List as L
|
||||
import qualified Data.Set as S
|
||||
import qualified Data.Text as Text
|
||||
import qualified Data.Text.Internal.Lazy as TL
|
||||
import qualified Data.Text.Lazy.Builder as TLB
|
||||
import Data.Conduit (ConduitT, runConduit, (.|))
|
||||
import qualified Data.Conduit.List as CL
|
||||
import qualified Data.List as L
|
||||
import qualified Data.Set as S
|
||||
import qualified Data.Text as Text
|
||||
import qualified Data.Text.Internal.Lazy as TL
|
||||
import qualified Data.Text.Lazy.Builder as TLB
|
||||
import qualified Database.Esqueleto.Internal.ExprParser as P
|
||||
import qualified Database.Esqueleto.Internal.Sql as EI
|
||||
import qualified UnliftIO.Resource as R
|
||||
import qualified Database.Esqueleto.Internal.Sql as EI
|
||||
import qualified UnliftIO.Resource as R
|
||||
|
||||
-- Test schema
|
||||
share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistUpperCase|
|
||||
@ -390,7 +386,6 @@ testSubSelect run = do
|
||||
|
||||
describe "subSelectList" $ do
|
||||
it "is safe on empty databases as well as good databases" $ run $ do
|
||||
liftIO $ putStrLn "hello"
|
||||
let query =
|
||||
from $ \n -> do
|
||||
where_ $ n ^. NumbersInt `in_` do
|
||||
@ -399,10 +394,7 @@ testSubSelect run = do
|
||||
where_ $ n' ^. NumbersInt >=. val 3
|
||||
pure (n' ^. NumbersInt)
|
||||
pure n
|
||||
empty <- do
|
||||
liftIO . print =<< renderQuerySelect query
|
||||
select query
|
||||
liftIO $ putStrLn "goodbye"
|
||||
empty <- select query
|
||||
|
||||
full <- do
|
||||
setup
|
||||
@ -895,12 +887,15 @@ testSelectSubQuery run = describe "select subquery" $ do
|
||||
l1Deeds <- mapM (\k -> insert' $ Deed k (entityKey l1e)) (map show [1..3 :: Int])
|
||||
let l1WithDeeds = do d <- l1Deeds
|
||||
pure (l1e, Just d)
|
||||
ret <- select $ Experimental.from $ do
|
||||
(lords :& deeds) <-
|
||||
Experimental.from $ Table @Lord
|
||||
`LeftOuterJoin` Table @Deed
|
||||
`Experimental.on` (\(l :& d) -> just (l ^. LordId) ==. d ?. DeedOwnerId)
|
||||
pure (lords, deeds)
|
||||
let q = Experimental.from $ do
|
||||
(lords :& deeds) <-
|
||||
Experimental.from $ Table @Lord
|
||||
`LeftOuterJoin` Table @Deed
|
||||
`Experimental.on` (\(l :& d) -> just (l ^. LordId) ==. d ?. DeedOwnerId)
|
||||
pure (lords, deeds)
|
||||
|
||||
liftIO . print =<< renderQuerySelect q
|
||||
ret <- select q
|
||||
liftIO $ ret `shouldMatchList` ((l3e, Nothing) : l1WithDeeds)
|
||||
|
||||
it "lets you order by alias" $ run $ do
|
||||
@ -1847,9 +1842,10 @@ testRenderSql run = do
|
||||
(c, expr) <- run $ do
|
||||
conn <- ask
|
||||
let Right c = P.mkEscapeChar conn
|
||||
let user = EI.unsafeSqlEntity (EI.I "user")
|
||||
blogPost = EI.unsafeSqlEntity (EI.I "blog_post")
|
||||
pure $ (,) c $ EI.renderExpr conn $
|
||||
EI.EEntity (EI.I "user") ^. PersonId
|
||||
==. EI.EEntity (EI.I "blog_post") ^. BlogPostAuthorId
|
||||
user ^. PersonId ==. blogPost ^. BlogPostAuthorId
|
||||
expr
|
||||
`shouldBe`
|
||||
Text.intercalate (Text.singleton c) ["", "user", ".", "id", ""]
|
||||
@ -1861,23 +1857,6 @@ testRenderSql run = do
|
||||
expr <- run $ ask >>= \c -> pure $ EI.renderExpr c (val (PersonKey 0) ==. val (PersonKey 1))
|
||||
expr `shouldBe` "? = ?"
|
||||
|
||||
describe "EEntity Ident behavior" $ do
|
||||
let render :: SqlExpr (Entity val) -> Text.Text
|
||||
render (EI.EEntity (EI.I ident)) = ident
|
||||
render _ = error "guess we gotta handle this in the test suite now"
|
||||
it "renders sensibly" $ run $ do
|
||||
_ <- insert $ Foo 2
|
||||
_ <- insert $ Foo 3
|
||||
_ <- insert $ Person "hello" Nothing Nothing 3
|
||||
results <- select $
|
||||
from $ \(a `LeftOuterJoin` b) -> do
|
||||
on $ a ^. FooName ==. b ^. PersonFavNum
|
||||
pure (val (render a), val (render b))
|
||||
liftIO $
|
||||
head results
|
||||
`shouldBe`
|
||||
(Value "Foo", Value "Person")
|
||||
|
||||
describe "ExprParser" $ do
|
||||
let parse parser = AP.parseOnly (parser '#')
|
||||
describe "parseEscapedChars" $ do
|
||||
|
||||
Loading…
Reference in New Issue
Block a user