handle non-id/composite primary keys on ==. and !=.
This commit is contained in:
Alberto Valverde
parent
1f80074b6e
commit
477c0a4c21
@ -257,6 +257,8 @@ data SqlExpr a where
|
||||
-- interpolated by the SQL backend.
|
||||
ERaw :: NeedParens -> (IdentInfo -> (TLB.Builder, [PersistValue])) -> SqlExpr (Value a)
|
||||
|
||||
ERawList :: (IdentInfo -> ([TLB.Builder], [PersistValue])) -> SqlExpr (Value a)
|
||||
|
||||
-- 'EList' and 'EEmptyList' are used by list operators.
|
||||
EList :: SqlExpr (Value a) -> SqlExpr (ValueList a)
|
||||
EEmptyList :: SqlExpr (ValueList a)
|
||||
@ -342,8 +344,8 @@ instance Esqueleto SqlQuery SqlExpr SqlBackend where
|
||||
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
|
||||
EEntity ident ^. field
|
||||
| isIdField field && hasCompositeKey ed
|
||||
= ERaw Parens $
|
||||
\info@(conn,_) -> (uncommas (map (\a -> useIdent info ident <> "." <> TLB.fromText (connEscapeName conn (fieldDB a))) (compositeFields pdef)), [])
|
||||
= ERawList $
|
||||
\info@(conn,_) -> (map (\a -> useIdent info ident <> "." <> TLB.fromText (connEscapeName conn (fieldDB a))) (compositeFields pdef), [])
|
||||
| otherwise = ERaw Never $ \info -> (useIdent info ident <> ("." <> fieldName info field), [])
|
||||
where
|
||||
ed = entityDef $ getEntityVal $ (Proxy :: Proxy (SqlExpr (Entity val)))
|
||||
@ -354,7 +356,11 @@ instance Esqueleto SqlQuery SqlExpr SqlBackend where
|
||||
maybelize :: SqlExpr (Value a) -> SqlExpr (Value (Maybe a))
|
||||
maybelize (ERaw p f) = ERaw p f
|
||||
|
||||
val = ERaw Never . const . (,) "?" . return . toPersistValue
|
||||
val v = case v' of
|
||||
PersistList vs -> ERawList $ const (replicate (length vs) "?", vs)
|
||||
_ -> ERaw Never . const . (,) "?" . return $ v'
|
||||
where v' = toPersistValue v
|
||||
|
||||
|
||||
isNothing (ERaw p f) = ERaw Parens $ first ((<> " IS NULL") . parensM p) . f
|
||||
just (ERaw p f) = ERaw p f
|
||||
@ -367,12 +373,12 @@ instance Esqueleto SqlQuery SqlExpr SqlBackend where
|
||||
not_ (ERaw p f) = ERaw Never $ \info -> let (b, vals) = f info
|
||||
in ("NOT " <> parensM p b, vals)
|
||||
|
||||
(==.) = unsafeSqlBinOp " = "
|
||||
(==.) = unsafeSqlBinOpList " = " " AND "
|
||||
(>=.) = unsafeSqlBinOp " >= "
|
||||
(>.) = unsafeSqlBinOp " > "
|
||||
(<=.) = unsafeSqlBinOp " <= "
|
||||
(<.) = unsafeSqlBinOp " < "
|
||||
(!=.) = unsafeSqlBinOp " != "
|
||||
(!=.) = unsafeSqlBinOpList " != " " OR "
|
||||
(&&.) = unsafeSqlBinOp " AND "
|
||||
(||.) = unsafeSqlBinOp " OR "
|
||||
(+.) = unsafeSqlBinOp " + "
|
||||
@ -507,6 +513,17 @@ unsafeSqlBinOp op (ERaw p1 f1) (ERaw p2 f2) = ERaw Parens f
|
||||
, vals1 <> vals2 )
|
||||
{-# INLINE unsafeSqlBinOp #-}
|
||||
|
||||
unsafeSqlBinOpList :: TLB.Builder -> TLB.Builder -> SqlExpr (Value a) -> SqlExpr (Value b) -> SqlExpr (Value c)
|
||||
unsafeSqlBinOpList op sep (ERawList f1) (ERawList f2) = ERaw Never f
|
||||
where
|
||||
f info = let (b1, vals1) = f1 info
|
||||
(b2, vals2) = f2 info
|
||||
in ( intersperseB sep . map (\(a,b) -> a <> op <> b) $
|
||||
zip b1 b2
|
||||
, vals1 <> vals2 )
|
||||
unsafeSqlBinOpList op _ a@(ERaw _ _) b@(ERaw _ _) = unsafeSqlBinOp op a b
|
||||
unsafeSqlBinOpList _ _ _ _ = error "unsafeSqlBinOpList: must operate against another composite key"
|
||||
{-# INLINE unsafeSqlBinOpList #-}
|
||||
|
||||
-- | (Internal) A raw SQL value. The same warning from
|
||||
-- 'unsafeSqlBinOp' applies to this function as well.
|
||||
@ -842,7 +859,10 @@ data Mode =
|
||||
|
||||
|
||||
uncommas :: [TLB.Builder] -> TLB.Builder
|
||||
uncommas = mconcat . intersperse ", " . filter (/= mempty)
|
||||
uncommas = intersperseB ", "
|
||||
|
||||
intersperseB :: TLB.Builder -> [TLB.Builder] -> TLB.Builder
|
||||
intersperseB a = mconcat . intersperse a . filter (/= mempty)
|
||||
|
||||
uncommas' :: Monoid a => [(TLB.Builder, a)] -> (TLB.Builder, a)
|
||||
uncommas' = (uncommas *** mconcat) . unzip
|
||||
|
||||
43
test/Test.hs
43
test/Test.hs
@ -68,7 +68,8 @@ share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistUpperCase|
|
||||
deriving Eq Show
|
||||
Article
|
||||
title String
|
||||
frontcoverId FrontcoverId
|
||||
frontcoverNumber Int
|
||||
Foreign Frontcover fkfrontcover frontcoverNumber
|
||||
deriving Eq Show
|
||||
Point
|
||||
x Int
|
||||
@ -76,6 +77,12 @@ share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistUpperCase|
|
||||
name String
|
||||
Primary x y
|
||||
deriving Eq Show
|
||||
Circle
|
||||
centerX Int
|
||||
centerY Int
|
||||
name String
|
||||
Foreign Point fkpoint centerX centerY
|
||||
deriving Eq Show
|
||||
|]
|
||||
|
||||
-- | this could be achieved with S.fromList, but not all lists
|
||||
@ -952,39 +959,59 @@ main = do
|
||||
ret `shouldBe` p
|
||||
pPk `shouldBe` thePk
|
||||
|
||||
it "can join with a custom primary key and return one entity" $
|
||||
{- FIXME: Persistent does not create the CircleFkPoint constructor.
|
||||
- Should it?
|
||||
it "can join on a composite primary key" $
|
||||
run $ do
|
||||
let p = Point x y ""
|
||||
c = Circle x y ""
|
||||
x = 10
|
||||
y = 15
|
||||
Right thePk = keyFromValues [ PersistInt64 $ fromIntegral x
|
||||
, PersistInt64 $ fromIntegral y]
|
||||
pPk <- insert p
|
||||
insert_ c
|
||||
[Entity _ ret] <- select $ from $ \(c' `InnerJoin` p') -> do
|
||||
on (p'^.PointId ==. c'^.CircleFkpoint)
|
||||
return p'
|
||||
liftIO $ do
|
||||
ret `shouldBe` p
|
||||
pPk `shouldBe` thePk
|
||||
-}
|
||||
|
||||
it "can join with a non-id primary key and return one entity" $
|
||||
run $ do
|
||||
let fc = Frontcover number ""
|
||||
article = Article "Esqueleto supports composite pks!" thePk
|
||||
article = Article "Esqueleto supports composite pks!" number
|
||||
number = 101
|
||||
Right thePk = keyFromValues [PersistInt64 $ fromIntegral number]
|
||||
fcPk <- insert fc
|
||||
insert_ article
|
||||
[Entity _ retFc] <- select $
|
||||
from $ \(a `InnerJoin` f) -> do
|
||||
on (f^.FrontcoverId ==. a^.ArticleFrontcoverId)
|
||||
on (f^.FrontcoverNumber ==. a^.ArticleFrontcoverNumber)
|
||||
return f
|
||||
liftIO $ do
|
||||
retFc `shouldBe` fc
|
||||
fcPk `shouldBe` thePk
|
||||
|
||||
it "can join with a custom primary key and return both entities" $
|
||||
it "can join with a non-id primary key and return both entities" $
|
||||
run $ do
|
||||
let fc = Frontcover number ""
|
||||
article = Article "Esqueleto supports composite pks!" thePk
|
||||
article = Article "Esqueleto supports composite pks!" number
|
||||
number = 101
|
||||
Right thePk = keyFromValues [PersistInt64 $ fromIntegral number]
|
||||
fcPk <- insert fc
|
||||
insert_ article
|
||||
[(Entity _ retFc, Entity _ retArt)] <- select $
|
||||
from $ \(a `InnerJoin` f) -> do
|
||||
on (f^.FrontcoverId ==. a^.ArticleFrontcoverId)
|
||||
on (f^.FrontcoverNumber ==. a^.ArticleFrontcoverNumber)
|
||||
return (f, a)
|
||||
liftIO $ do
|
||||
retFc `shouldBe` fc
|
||||
retArt `shouldBe` article
|
||||
fcPk `shouldBe` thePk
|
||||
articleFrontcoverId retArt `shouldBe` thePk
|
||||
articleFkfrontcover retArt `shouldBe` thePk
|
||||
----------------------------------------------------------------------
|
||||
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user