esqueleto 2.1.2.3 → 2.1.3

raw patch · 5 files changed

+380/−51 lines, 5 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

• esqueleto.cabal +4/−4
• src/Database/Esqueleto.hs +1/−1
• src/Database/Esqueleto/Internal/Language.hs +1/−0
• src/Database/Esqueleto/Internal/Sql.hs +131/−46
• test/Test.hs +243/−0

@@ -1,5 +1,5 @@ name:                esqueleto-version:             2.1.2.3+version:             2.1.3 synopsis:            Type-safe EDSL for SQL queries on persistent backends. homepage:            https://github.com/prowdsponsor/esqueleto license:             BSD3@@ -64,9 +64,9 @@   other-modules:     Database.Esqueleto.Internal.PersistentImport   build-depends:-      base                 >= 4.5    && < 4.9-    , text                 >= 0.11   && < 1.3-    , persistent           >= 2.1    && < 2.2+      base                 >= 4.5     && < 4.9+    , text                 >= 0.11    && < 1.3+    , persistent           >= 2.1.1.7 && < 2.2     , transformers         >= 0.2     , unordered-containers >= 0.2     , tagged               >= 0.2

@@ -44,7 +44,7 @@              , (==.), (>=.), (>.), (<=.), (<.), (!=.), (&&.), (||.)              , (+.), (-.), (/.), (*.)              , random_, round_, ceiling_, floor_-             , min_, max_, sum_, avg_+             , min_, max_, sum_, avg_, lower_              , coalesce, coalesceDefault              , like, (%), concat_, (++.)              , subList_select, subList_selectDistinct, valList

@@ -255,6 +255,7 @@   min_     :: (PersistField a) => expr (Value a) -> expr (Value (Maybe a))   max_     :: (PersistField a) => expr (Value a) -> expr (Value (Maybe a))   avg_     :: (PersistField a, PersistField b) => expr (Value a) -> expr (Value (Maybe b))+  lower_   :: (PersistField a, IsString a) => expr (Value a) -> expr (Value a)    -- | @COALESCE@ function. Evaluates the arguments in order and   -- returns the value of the first non-NULL expression, or NULL

@@ -7,6 +7,8 @@            , MultiParamTypeClasses            , OverloadedStrings            , UndecidableInstances+           , ScopedTypeVariables+           , InstanceSigs  #-} -- | This is an internal module, anything exported by this module -- may change without a major version bump.  Please use only@@ -29,6 +31,7 @@     -- * The guts   , unsafeSqlCase   , unsafeSqlBinOp+  , unsafeSqlBinOpList   , unsafeSqlValue   , unsafeSqlFunction   , unsafeSqlExtractSubField@@ -58,6 +61,9 @@ import Data.Monoid (Monoid(..), (<>)) import Data.Proxy (Proxy(..)) import Database.Esqueleto.Internal.PersistentImport+import Database.Persist.Sql.Util (+    entityColumnNames, entityColumnCount, parseEntityValues, isIdField+  , hasCompositeKey) import qualified Control.Monad.Trans.State as S import qualified Control.Monad.Trans.Writer as W import qualified Data.Conduit as C@@ -226,7 +232,7 @@   -- | Information needed to escape and use identifiers.-type IdentInfo = (Connection, IdentState)+type IdentInfo = (SqlBackend, IdentState)   -- | Use an identifier.@@ -252,6 +258,9 @@   -- interpolated by the SQL backend.   ERaw     :: NeedParens -> (IdentInfo -> (TLB.Builder, [PersistValue])) -> SqlExpr (Value a) +  -- Used to support non-id/composite primary keys+  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)@@ -333,33 +342,50 @@   sub_select         = sub SELECT   sub_selectDistinct = sub SELECT_DISTINCT -  EEntity ident ^. field =-    ERaw Never $ \info -> (useIdent info ident <> ("." <> fieldName info field), [])+  (^.) :: forall val typ. (PersistEntity val, PersistField typ)+       => SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)+  EEntity ident ^. field+    | isComposite = ERawList   $ \info -> (dot info <$> compositeFields pdef,  [])+    | otherwise   = ERaw Never $ \info -> (dot info  $  persistFieldDef field, [])+    where+      isComposite = isIdField field && hasCompositeKey ed+      dot info x  = useIdent info ident <> "." <> fromDBName info (fieldDB x)+      ed          = entityDef $ getEntityVal (Proxy :: Proxy (SqlExpr (Entity val)))+      Just pdef   = entityPrimary ed    EMaybe r ?. field = maybelize (r ^. field)     where       maybelize :: SqlExpr (Value a) -> SqlExpr (Value (Maybe a))-      maybelize (ERaw p f) = ERaw p f+      maybelize (ERaw p f)   = ERaw p f+      maybelize (ERawList f) = ERawList f -  val = ERaw Never . const . (,) "?" . return . toPersistValue+  val v =+    case toPersistValue v of+      PersistList vs -> ERawList   $ const (replicate (length vs) "?", vs)+      pv             -> ERaw Never $ const ("?", [pv]) -  isNothing (ERaw p f) = ERaw Parens $ first ((<> " IS NULL") . parensM p) . f-  just (ERaw p f) = ERaw p f-  nothing   = unsafeSqlValue "NULL"-  joinV (ERaw p f) = ERaw p f+  isNothing (ERaw p f)   = ERaw Parens $ first ((<> " IS NULL") . parensM p) . f+  isNothing (ERawList f) = ERaw Parens $ first (intersperseB " AND " . map (<> " IS NULL")) . f+  just (ERaw p f)   = ERaw p f+  just (ERawList f) = ERawList f+  nothing = unsafeSqlValue "NULL"+  joinV (ERaw p f)   = ERaw p f+  joinV (ERawList f) = ERawList f   countRows = unsafeSqlValue "COUNT(*)"   count (ERaw _ f) = ERaw Never $ \info -> let (b, vals) = f info                                            in ("COUNT" <> parens b, vals)+  count (ERawList _) = unsafeSqlValue "COUNT(*)" -- Assumes no NULLs on a PK    not_ (ERaw p f) = ERaw Never $ \info -> let (b, vals) = f info                                           in ("NOT " <> parensM p b, vals)+  not_ (ERawList _) = unexpectedCompositeKeyError -  (==.) = unsafeSqlBinOp " = "+  (==.) = unsafeSqlBinOpList " = " " AND "+  (!=.) = unsafeSqlBinOpList " != " " OR "   (>=.) = unsafeSqlBinOp " >= "   (>.)  = unsafeSqlBinOp " > "   (<=.) = unsafeSqlBinOp " <= "   (<.)  = unsafeSqlBinOp " < "-  (!=.) = unsafeSqlBinOp " != "   (&&.) = unsafeSqlBinOp " AND "   (||.) = unsafeSqlBinOp " OR "   (+.)  = unsafeSqlBinOp " + "@@ -368,16 +394,18 @@   (*.)  = unsafeSqlBinOp " * "    random_  = unsafeSqlValue "RANDOM()"-  sum_     = unsafeSqlFunction "SUM"   round_   = unsafeSqlFunction "ROUND"   ceiling_ = unsafeSqlFunction "CEILING"   floor_   = unsafeSqlFunction "FLOOR"-  avg_     = unsafeSqlFunction "AVG"++  sum_     = unsafeSqlFunction "SUM"   min_     = unsafeSqlFunction "MIN"   max_     = unsafeSqlFunction "MAX"+  avg_     = unsafeSqlFunction "AVG"+  lower_   = unsafeSqlFunction "LOWER" -  coalesce              = unsafeSqlFunction "COALESCE"-  coalesceDefault exprs = unsafeSqlFunction "COALESCE" . (exprs ++) . return . just+  coalesce              = unsafeSqlFunctionParens "COALESCE"+  coalesceDefault exprs = unsafeSqlFunctionParens "COALESCE" . (exprs ++) . return . just    like    = unsafeSqlBinOp    " LIKE "   (%)     = unsafeSqlValue    "'%'"@@ -407,12 +435,14 @@   field *=. expr = setAux field (\ent -> ent ^. field *. expr)   field /=. expr = setAux field (\ent -> ent ^. field /. expr) -  (<#) _ (ERaw _ f) = EInsert Proxy f+  (<#) _ (ERaw _ f)   = EInsert Proxy f+  (<#) _ (ERawList _) = unexpectedCompositeKeyError    (EInsert _ f) <&> (ERaw _ g) = EInsert Proxy $ \x ->     let (fb, fv) = f x         (gb, gv) = g x     in (fb <> ", " <> gb, fv ++ gv)+  (EInsert _ _) <&> (ERawList _) = unexpectedCompositeKeyError    case_ = unsafeSqlCase @@ -423,6 +453,7 @@           => IdentInfo -> EntityField val typ -> TLB.Builder fieldName info = fromDBName info . fieldDB . persistFieldDef +-- FIXME: Composite/non-id pKS not supported on set setAux :: (PersistEntity val, PersistField typ)        => EntityField val typ        -> (SqlExpr (Entity val) -> SqlExpr (Value typ))@@ -454,23 +485,25 @@ -- -- Since: 2.1.1 unsafeSqlCase :: PersistField a => [(SqlExpr (Value Bool), SqlExpr (Value a))] -> SqlExpr (Value a) -> SqlExpr (Value a)-unsafeSqlCase when_ (ERaw p1 f1) = ERaw Never buildCase+unsafeSqlCase when (ERaw p1 f1) = ERaw Never buildCase   where     buildCase :: IdentInfo -> (TLB.Builder, [PersistValue])     buildCase info =         let (b1, vals1) = f1 info-            (b2, vals2) = mapWhen when_ info+            (b2, vals2) = mapWhen when info         in ( "CASE" <> b2 <> " ELSE " <> parensM p1 b1 <> " END", vals2 <> vals1)      mapWhen :: [(SqlExpr (Value Bool), SqlExpr (Value a))] -> IdentInfo -> (TLB.Builder, [PersistValue])-    mapWhen []    _    = error "unsafeSqlCase: empty when_ list."-    mapWhen when_ info = foldl (foldHelp info) (mempty, mempty) when_+    mapWhen []    _    = error "unsafeSqlCase: empty when list."+    mapWhen when' info = foldl (foldHelp info) (mempty, mempty) when'      foldHelp :: IdentInfo -> (TLB.Builder, [PersistValue]) -> (SqlExpr (Value Bool), SqlExpr (Value a)) -> (TLB.Builder, [PersistValue])-    foldHelp info (b0, vals0) (ERaw p1 f1, ERaw p2 f2) =-        let (b1, vals1) = f1 info+    foldHelp info (b0, vals0) (ERaw p1' f1', ERaw p2 f2) =+        let (b1, vals1) = f1' info             (b2, vals2) = f2 info-        in ( b0 <> " WHEN " <> parensM p1 b1 <> " THEN " <> parensM p2 b2, vals0 <> vals1 <> vals2 )+        in ( b0 <> " WHEN " <> parensM p1' b1 <> " THEN " <> parensM p2 b2, vals0 <> vals1 <> vals2 )+    foldHelp _ _ _ = unexpectedCompositeKeyError+unsafeSqlCase _ (ERawList _) = unexpectedCompositeKeyError   -- | (Internal) Create a custom binary operator.  You /should/@@ -492,9 +525,36 @@                  (b2, vals2) = f2 info              in ( parensM p1 b1 <> op <> parensM p2 b2                 , vals1 <> vals2 )+unsafeSqlBinOp _ _ _ = unexpectedCompositeKeyError {-# INLINE unsafeSqlBinOp #-}  +-- | Similar to 'unsafeSqlBinOp', but may also be applied to+-- composite keys.  Uses the operator given as the second+-- argument whenever applied to composite keys.+--+-- Usage example:+--+-- @+-- (==.) :: SqlExpr (Value a) -> SqlExpr (Value a) -> SqlExpr (Value Bool)+-- (==.) = unsafeSqlBinOpList " = " " AND "+-- @+unsafeSqlBinOpList :: TLB.Builder -> TLB.Builder -> SqlExpr (Value a) -> SqlExpr (Value b) -> SqlExpr (Value c)+unsafeSqlBinOpList op _ a@(ERaw _ _)    b@(ERaw _ _)  = unsafeSqlBinOp op a b+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 sep a b = unsafeSqlBinOpList op sep (promote a) (promote b)+  where+    promote :: SqlExpr (Value d) -> SqlExpr (Value d)+    promote (ERaw p f)     = ERawList $ first (return . parensM p) . f+    promote x@(ERawList _) = x+{-# INLINE unsafeSqlBinOpList #-}+ -- | (Internal) A raw SQL value.  The same warning from -- 'unsafeSqlBinOp' applies to this function as well. unsafeSqlValue :: TLB.Builder -> SqlExpr (Value a)@@ -524,7 +584,17 @@           uncommas' $ map (\(ERaw _ f) -> f info) $ toArgList arg     in ("EXTRACT" <> parens (subField <> " FROM " <> argsTLB), argsVals) +-- | (Internal) A raw SQL function. Preserves parentheses around arguments.+-- See 'unsafeSqlBinOp' for warnings.+unsafeSqlFunctionParens :: UnsafeSqlFunctionArgument a =>+                           TLB.Builder -> a -> SqlExpr (Value b)+unsafeSqlFunctionParens name arg =+  ERaw Never $ \info ->+    let (argsTLB, argsVals) =+          uncommas' $ map (\(ERaw p f) -> first (parensM p) (f info)) $ toArgList arg+    in (name <> parens argsTLB, argsVals) + class UnsafeSqlFunctionArgument a where   toArgList :: a -> [SqlExpr (Value ())] instance (a ~ Value b) => UnsafeSqlFunctionArgument (SqlExpr a) where@@ -555,6 +625,7 @@ -- unless you know what you're doing! veryUnsafeCoerceSqlExprValue :: SqlExpr (Value a) -> SqlExpr (Value b) veryUnsafeCoerceSqlExprValue (ERaw p f) = ERaw p f+veryUnsafeCoerceSqlExprValue (ERawList f) = ERawList f   -- | (Internal) Coerce a value's type from 'SqlExpr (ValueList@@ -829,8 +900,11 @@   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 @@ -887,24 +961,30 @@     fromKind RightOuterJoinKind = " RIGHT OUTER JOIN "     fromKind FullOuterJoinKind  = " FULL OUTER JOIN " -    makeOnClause (ERaw _ f) = first (" ON " <>) (f info)+    makeOnClause (ERaw _ f)   = first (" ON " <>) (f info)+    makeOnClause (ERawList _) = unexpectedCompositeKeyError      mkExc :: SqlExpr (Value Bool) -> OnClauseWithoutMatchingJoinException     mkExc (ERaw _ f) =       OnClauseWithoutMatchingJoinException $       TL.unpack $ TLB.toLazyText $ fst (f info)+    mkExc (ERawList _) = unexpectedCompositeKeyError +unexpectedCompositeKeyError :: a+unexpectedCompositeKeyError = error "non-id/composite keys not expected here" + makeSet :: IdentInfo -> [SetClause] -> (TLB.Builder, [PersistValue]) makeSet _    [] = mempty-makeSet info os = first ("\nSET " <>) $ uncommas' (map mk os)+makeSet info os = first ("\nSET " <>) . uncommas' $ concatMap mk os   where-    mk (SetClause (ERaw _ f)) = f info-+    mk (SetClause (ERaw _ f))   = [f info]+    mk (SetClause (ERawList _)) = error "esqueleto/makeSet: FIXME"  makeWhere :: IdentInfo -> WhereClause -> (TLB.Builder, [PersistValue])-makeWhere _    NoWhere            = mempty-makeWhere info (Where (ERaw _ f)) = first ("\nWHERE " <>) (f info)+makeWhere _    NoWhere              = mempty+makeWhere info (Where (ERaw _ f))   = first ("\nWHERE " <>) (f info)+makeWhere _    (Where (ERawList _)) = unexpectedCompositeKeyError   makeGroupBy :: IdentInfo -> GroupByClause -> (TLB.Builder, [PersistValue])@@ -914,22 +994,26 @@     build = uncommas' $ map (\(SomeValue (ERaw _ f)) -> f info) fields  makeHaving :: IdentInfo -> WhereClause -> (TLB.Builder, [PersistValue])-makeHaving _    NoWhere            = mempty-makeHaving info (Where (ERaw _ f)) = first ("\nHAVING " <>) (f info)+makeHaving _    NoWhere               = mempty+makeHaving info (Where (ERaw _ f))    = first ("\nHAVING " <>) (f info)+makeHaving _    (Where (ERawList _ )) = unexpectedCompositeKeyError  makeOrderBy :: IdentInfo -> [OrderByClause] -> (TLB.Builder, [PersistValue]) makeOrderBy _    [] = mempty-makeOrderBy info os = first ("\nORDER BY " <>) $ uncommas' (map mk os)+makeOrderBy info os = first ("\nORDER BY " <>) . uncommas' $ concatMap mk os   where-    mk :: OrderByClause -> (TLB.Builder, [PersistValue])-    mk (EOrderBy t (ERaw p f)) = first ((<> orderByType t) . parensM p) (f info)-    mk EOrderRandom = first ((<> "RANDOM()")) mempty+    mk :: OrderByClause -> [(TLB.Builder, [PersistValue])]+    mk (EOrderBy t (ERaw p f))   = [first ((<> orderByType t) . parensM p) (f info)]+    mk (EOrderBy t (ERawList f)) = let fs = fst $ f info+                                       vals = repeat []+                                   in zip (map (<> orderByType t) fs) vals+    mk EOrderRandom = [first ((<> "RANDOM()")) mempty]     orderByType ASC  = " ASC"     orderByType DESC = " DESC"   makeLimit :: IdentInfo -> LimitClause -> [OrderByClause] -> (TLB.Builder, [PersistValue])-makeLimit (conn,_) (Limit ml mo) orderByClauses =+makeLimit (conn, _) (Limit ml mo) orderByClauses =   let limitRaw = connLimitOffset conn (v ml, v mo) hasOrderClause "\n"       hasOrderClause = not (null orderByClauses)       v = maybe 0 fromIntegral@@ -994,10 +1078,8 @@   sqlSelectCols info expr@(EEntity ident) = ret       where         process ed = uncommas $-                     map ((name <>) . fromDBName info) $-                     map fieldDB $-                     entityId ed :-                     entityFields ed+                     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@@ -1007,12 +1089,11 @@         name = useIdent info ident <> "."         ret = let ed = entityDef $ getEntityVal $ return expr               in (process ed, mempty)-  sqlSelectColCount = (+1) . length . entityFields . entityDef . getEntityVal-  sqlSelectProcessRow (idCol:ent) =-    Entity <$> fromPersistValue idCol-           <*> fromPersistValues ent-  sqlSelectProcessRow _ = Left "SqlSelect (Entity a): wrong number of columns."+  sqlSelectColCount = entityColumnCount . entityDef . getEntityVal+  sqlSelectProcessRow = parseEntityValues ed+    where ed = entityDef $ getEntityVal $ (Proxy :: Proxy (SqlExpr (Entity a))) + getEntityVal :: Proxy (SqlExpr (Entity a)) -> Proxy a getEntityVal = const Proxy @@ -1034,6 +1115,10 @@ instance PersistField a => SqlSelect (SqlExpr (Value a)) (Value a) where   sqlSelectCols info (ERaw p f) = let (b, vals) = f info                                   in (parensM p b, vals)+  sqlSelectCols info (ERawList f) = let (b, vals) = f info+                                    in case b of+                                         [b'] -> (parensM Parens b', vals)+                                         _    -> unexpectedCompositeKeyError   sqlSelectColCount = const 1   sqlSelectProcessRow [pv] = Value <$> fromPersistValue pv   sqlSelectProcessRow _    = Left "SqlSelect (Value a): wrong number of columns."

@@ -1,6 +1,8 @@ {-# LANGUAGE ConstraintKinds            , EmptyDataDecls            , FlexibleContexts+           , FlexibleInstances+           , DeriveGeneric            , GADTs            , GeneralizedNewtypeDeriving            , MultiParamTypeClasses@@ -44,6 +46,7 @@ import qualified Control.Monad.Trans.Resource as R import qualified Data.Set as S import qualified Data.List as L+import Data.Char (toLower, toUpper)   -- Test schema@@ -62,6 +65,41 @@     follower PersonId     followed PersonId     deriving Eq Show+  Frontcover+    number Int+    title String+    Primary number+    deriving Eq Show+  Article+    title String+    frontcoverNumber Int+    Foreign Frontcover fkfrontcover frontcoverNumber+    deriving Eq Show+  Tag+    name String+    Primary name+    deriving Eq Show+  ArticleTag+    articleId ArticleId+    tagId     TagId+    Primary   articleId tagId+    deriving Eq Show+  Article2+    title String+    frontcoverId FrontcoverId+    deriving Eq Show+  Point+    x Int+    y Int+    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@@ -224,7 +262,39 @@                   return p           liftIO $ ret5 `shouldBe` [ p1e, p4e, p3e, p2e ] +      it "works with non-id primary key" $+        run $ do+          let fc = Frontcover number ""+              number = 101+              Right thePk = keyFromValues [toPersistValue number]+          fcPk <- insert fc+          [Entity _ ret] <- select $ from $ return+          liftIO $ do+            ret `shouldBe` fc+            fcPk `shouldBe` thePk +      it "works when returning a custom non-composite primary key from a query" $+        run $ do+          let name = "foo"+              t = Tag name+              Right thePk = keyFromValues [toPersistValue name]+          tagPk <- insert t+          [Value ret] <- select $ from $ \t' -> return (t'^.TagId)+          liftIO $ do+            ret `shouldBe` thePk+            thePk `shouldBe` tagPk++      it "works when returning a composite primary key from a query" $+        pendingWith "Need to refactor 'Value a's SqlQuery instance"+        {-+        run $ do+          let p = Point 10 20 ""+          thePk <- insert p+          [Value ppk] <- select $ from $ \p' -> return (p'^.PointId)+          liftIO $ ppk `shouldBe` thePk+        -}++     describe "select/JOIN" $ do       it "works with a LEFT OUTER JOIN" $         run $ do@@ -279,6 +349,96 @@              return (p, mb)         ) `shouldThrow` (\(OnClauseWithoutMatchingJoinException _) -> True) +      it "works with ForeignKey to a non-id primary key returning one entity" $+        run $ do+          let fc = Frontcover number ""+              article = Article "Esqueleto supports composite pks!" number+              number = 101+              Right thePk = keyFromValues [toPersistValue number]+          fcPk <- insert fc+          insert_ article+          [Entity _ retFc] <- select $+            from $ \(a `InnerJoin` f) -> do+              on (f^.FrontcoverNumber ==. a^.ArticleFrontcoverNumber)+              return f+          liftIO $ do+            retFc `shouldBe` fc+            fcPk `shouldBe` thePk++      it "works with a ForeignKey to a non-id primary key returning both entities" $+        run $ do+          let fc = Frontcover number ""+              article = Article "Esqueleto supports composite pks!" number+              number = 101+              Right thePk = keyFromValues [toPersistValue number]+          fcPk <- insert fc+          insert_ article+          [(Entity _ retFc, Entity _ retArt)] <- select $+            from $ \(a `InnerJoin` f) -> do+              on (f^.FrontcoverNumber ==. a^.ArticleFrontcoverNumber)+              return (f, a)+          liftIO $ do+            retFc `shouldBe` fc+            retArt `shouldBe` article+            fcPk `shouldBe` thePk+            articleFkfrontcover retArt `shouldBe` thePk++      it "works with a non-id primary key returning one entity" $+        run $ do+          let fc = Frontcover number ""+              article = Article2 "Esqueleto supports composite pks!" thePk+              number = 101+              Right thePk = keyFromValues [toPersistValue number]+          fcPk <- insert fc+          insert_ article+          [Entity _ retFc] <- select $+            from $ \(a `InnerJoin` f) -> do+              on (f^.FrontcoverId ==. a^.Article2FrontcoverId)+              return f+          liftIO $ do+            retFc `shouldBe` fc+            fcPk `shouldBe` thePk++      it "works with a composite primary key" $+        pendingWith "Persistent does not create the CircleFkPoint constructor. See: https://github.com/yesodweb/persistent/issues/341"+        {-+        run $ do+          let p = Point x y ""+              c = Circle x y ""+              x = 10+              y = 15+              Right thePk = keyFromValues [toPersistValue x, toPersistValue 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 "works when joining via a non-id primary key" $+        run $ do+          let fc = Frontcover number ""+              article = Article "Esqueleto supports composite pks!" number+              tag = Tag "foo"+              otherTag = Tag "ignored"+              number = 101+          insert_ fc+          insert_ otherTag+          artId <- insert article+          tagId <- insert tag+          insert_ $ ArticleTag artId tagId+          [(Entity _ retArt, Entity _ retTag)] <- select $+            from $ \(a `InnerJoin` at `InnerJoin` t) -> do+              on (t^.TagId ==. at^.ArticleTagTagId)+              on (a^.ArticleId ==. at^.ArticleTagArticleId)+              return (a, t)+          liftIO $ do+            retArt `shouldBe` article+            retTag `shouldBe` tag+     describe "select/where_" $ do       it "works for a simple example with (==.)" $         run $ do@@ -374,6 +534,25 @@                  return $ joinV $ max_ (p ^. PersonAge)           liftIO $ ret `shouldBe` [ Value $ Just (36 :: Int) ] +      it "works with lower_" $+        run $ do+          p1e <- insert' p1+          p2e@(Entity _ bob) <- insert' $ Person "bob" (Just 36) Nothing   1++          -- lower(name) == 'john'+          ret <- select $+                 from $ \p-> do+                 where_ (lower_ (p ^. PersonName) ==. val (map toLower $ personName p1))+                 return p+          liftIO $ ret `shouldBe` [ p1e ]++          -- name == lower('BOB')+          ret <- select $+                 from $ \p-> do+                 where_ (p ^. PersonName ==. lower_ (val $ map toUpper $ personName bob))+                 return p+          liftIO $ ret `shouldBe` [ p2e ]+       it "works with random_" $         run $ do #if defined(WITH_POSTGRESQL) || defined(WITH_MYSQL)@@ -476,7 +655,21 @@                                   , (p3e, Nothing,  Nothing)                                   , (p2e, Just f21, Just p1e) ] +      it "works with a composite primary key" $+        run $ do+          let p = Point x y ""+              x = 10+              y = 15+              Right thePk = keyFromValues [toPersistValue x, toPersistValue y]+          pPk <- insert p+          [Entity _ ret] <- select $ from $ \p' -> do+            where_ (p'^.PointId ==. val pPk)+            return p'+          liftIO $ do+            ret `shouldBe` p+            pPk `shouldBe` thePk +     describe "select/orderBy" $ do       it "works with a single ASC field" $         run $ do@@ -555,7 +748,17 @@           -- is 1/2^40, so this test should pass almost everytime.           liftIO $ S.size rets `shouldSatisfy` (>2) +      it "works on a composite primary key" $+        run $ do+          let ps = [Point 2 1 "", Point 1 2 ""]+          mapM_ insert ps+          eps <- select $+            from $ \p' -> do+              orderBy [asc (p'^.PointId)]+              return p'+          liftIO $ map entityVal eps `shouldBe` reverse ps +     describe "selectDistinct" $       it "works on a simple example" $         run $ do@@ -595,6 +798,28 @@                                    , Value 5                                    ] +      it "works with sub-queries" $+        run $ do+          p1id <- insert p1+          p2id <- insert p2+          p3id <- insert p3+          _    <- insert p4+          _    <- insert p5+          _ <- insert $ BlogPost "a" p1id+          _ <- insert $ BlogPost "b" p2id+          _ <- insert $ BlogPost "c" p3id+          ret <- select $+                 from $ \b -> do+                   let sub =+                           from $ \p -> do+                           where_ (p ^. PersonId ==. b ^. BlogPostAuthorId)+                           return $ p ^. PersonAge+                   return $ coalesceDefault [sub_select sub] (val (42 :: Int))+          liftIO $ ret `shouldBe` [ Value (36 :: Int)+                                  , Value 42+                                  , Value 17+                                  ]+ #if defined(WITH_POSTGRESQL) || defined(WITH_MYSQL)       it "works on PostgreSQL and MySQL with <2 arguments" $         run $ do@@ -712,6 +937,24 @@           liftIO $ ret `shouldBe` [ Entity p1k p1 { personAge = Just 3 }                                   , Entity p3k p3 { personAge = Just 7 }                                   , Entity p2k p2 { personAge = Just 0 } ]++      it "works with a composite primary key" $+        pendingWith "Need refactor to support composite pks on ESet"+        {-+        run $ do+          let p = Point x y ""+              x = 10+              y = 15+              newX = 20+              newY = 25+              Right newPk = keyFromValues [toPersistValue newX, toPersistValue newY]+          insert_ p+          () <- update $ \p' -> do+                set p' [PointId =. val newPk]+          [Entity _ ret] <- select $ from $ return+          liftIO $ do+            ret `shouldBe` Point newX newY []+        -}        it "GROUP BY works with COUNT" $         run $ do