esqueleto 2.2.3 → 2.2.4

raw patch · 5 files changed

+261/−79 lines, 5 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• esqueleto.cabal +1/−1
• src/Database/Esqueleto.hs +3/−1
• src/Database/Esqueleto/Internal/Language.hs +89/−0
• src/Database/Esqueleto/Internal/Sql.hs +79/−50
• test/Test.hs +89/−27

@@ -1,5 +1,5 @@ name:                esqueleto-version:             2.2.3+version:             2.2.4 synopsis:            Type-safe EDSL for SQL queries on persistent backends. homepage:            https://github.com/prowdsponsor/esqueleto license:             BSD3

@@ -38,7 +38,8 @@     -- $gettingstarted      -- * @esqueleto@'s Language-    Esqueleto( where_, on, groupBy, orderBy, rand, asc, desc, limit, offset, having+    Esqueleto( where_, on, groupBy, orderBy, rand, asc, desc, limit, offset+             , distinct, distinctOn, don, distinctOnOrderBy, having              , sub_select, sub_selectDistinct, (^.), (?.)              , val, isNothing, just, nothing, joinV, countRows, count, not_              , (==.), (>=.), (>.), (<=.), (<.), (!=.), (&&.), (||.)@@ -59,6 +60,7 @@   , unValue   , ValueList(..)   , OrderBy+  , DistinctOn     -- ** Joins   , InnerJoin(..)   , CrossJoin(..)

@@ -27,6 +27,7 @@   , FullOuterJoin(..)   , OnClauseWithoutMatchingJoinException(..)   , OrderBy+  , DistinctOn   , Update   , Insertion     -- * The guts@@ -179,6 +180,86 @@   -- | @OFFSET@.  Usually used with 'limit'.   offset :: Int64 -> query () +  -- | @DISTINCT@.  Change the current @SELECT@ into @SELECT+  -- DISTINCT@.  For example:+  --+  -- @+  -- select $ distinct $+  --   'from' \\foo -> do+  --   ...+  -- @+  --+  -- Note that this also has the same effect:+  --+  -- @+  -- select $+  --   'from' \\foo -> do+  --   distinct (return ())+  --   ...+  -- @+  --+  -- /Since: 2.2.4/+  distinct :: query a -> query a++  -- | @DISTINCT ON@.  Change the current @SELECT@ into+  -- @SELECT DISTINCT ON (expressions)@.  For example:+  --+  -- @+  -- select $+  --   'from' \\foo ->+  --   'distinctOn' ['don' (foo ^. FooName), 'don' (foo ^. FooState)] $ do+  --   ...+  -- @+  --+  -- You can also chain different calls to 'distinctOn'.  The+  -- above is equivalent to:+  --+  -- @+  -- select $+  --   'from' \\foo ->+  --   'distinctOn' ['don' (foo ^. FooName)] $+  --   'distinctOn' ['don' (foo ^. FooState)] $ do+  --   ...+  -- @+  --+  -- Each call to 'distinctOn' adds more expressions.  Calls to+  -- 'distinctOn' override any calls to 'distinct'.+  --+  -- Note that PostgreSQL requires the expressions on @DISTINCT+  -- ON@ to be the first ones to appear on a @ORDER BY@.  This is+  -- not managed automatically by esqueleto, keeping its spirit+  -- of trying to be close to raw SQL.+  --+  -- Supported by PostgreSQL only.+  --+  -- /Since: 2.2.4/+  distinctOn :: [expr DistinctOn] -> query a -> query a++  -- | Erase an expression's type so that it's suitable to+  -- be used by 'distinctOn'.+  --+  -- /Since: 2.2.4/+  don :: expr (Value a) -> expr DistinctOn++  -- | A convenience function that calls both 'distinctOn' and+  -- 'orderBy'.  In other words,+  --+  -- @+  -- 'distinctOnOrderBy' [asc foo, desc bar, desc quux] $ do+  --   ...+  -- @+  --+  -- is the same as:+  --+  -- @+  -- 'distinctOn' [don foo, don  bar, don  quux] $ do+  --   'orderBy'  [asc foo, desc bar, desc quux]+  --   ...+  -- @+  --+  -- /Since: 2.2.4/+  distinctOnOrderBy :: [expr OrderBy] -> query a -> query a+   -- | @ORDER BY random()@ clause.   --   -- /Since: 1.3.10/@@ -390,6 +471,10 @@   -- /Since: 2.1.2/   case_ :: PersistField a => [(expr (Value Bool), expr (Value a))] -> expr (Value a) -> expr (Value a) +{-# DEPRECATED sub_selectDistinct "Since 2.2.4: use 'sub_select' and 'distinct'." #-}+{-# DEPRECATED subList_selectDistinct "Since 2.2.4: use 'subList_select' and 'distinct'." #-}++ -- Fixity declarations infixl 9 ^. infixl 7 *., /.@@ -600,6 +685,10 @@  -- | Phantom type used by 'orderBy', 'asc' and 'desc'. data OrderBy+++-- | Phantom type used by 'distinctOn' and 'don'.+data DistinctOn   -- | Phantom type for a @SET@ operation on an entity of the given

@@ -103,21 +103,36 @@   -- | Side data written by 'SqlQuery'.-data SideData = SideData { sdFromClause    :: ![FromClause]-                         , sdSetClause     :: ![SetClause]-                         , sdWhereClause   :: !WhereClause-                         , sdGroupByClause :: !GroupByClause-                         , sdHavingClause  :: !HavingClause-                         , sdOrderByClause :: ![OrderByClause]-                         , sdLimitClause   :: !LimitClause+data SideData = SideData { sdDistinctClause :: !DistinctClause+                         , sdFromClause     :: ![FromClause]+                         , sdSetClause      :: ![SetClause]+                         , sdWhereClause    :: !WhereClause+                         , sdGroupByClause  :: !GroupByClause+                         , sdHavingClause   :: !HavingClause+                         , sdOrderByClause  :: ![OrderByClause]+                         , sdLimitClause    :: !LimitClause                          }  instance Monoid SideData where-  mempty = SideData mempty mempty mempty mempty mempty mempty mempty-  SideData f s w g h o l `mappend` SideData f' s' w' g' h' o' l' =-    SideData (f <> f') (s <> s') (w <> w') (g <> g') (h <> h') (o <> o') (l <> l')+  mempty = SideData mempty mempty mempty mempty mempty mempty mempty mempty+  SideData d f s w g h o l `mappend` SideData d' f' s' w' g' h' o' l' =+    SideData (d <> d') (f <> f') (s <> s') (w <> w') (g <> g') (h <> h') (o <> o') (l <> l')  +-- | The @DISTINCT@ "clause".+data DistinctClause =+    DistinctAll                     -- ^ The default, everything.+  | DistinctStandard                -- ^ Only @DISTINCT@, SQL standard.+  | DistinctOn [SqlExpr DistinctOn] -- ^ @DISTINCT ON@, PostgreSQL extension.++instance Monoid DistinctClause where+  mempty = DistinctAll+  DistinctOn a     `mappend` DistinctOn b = DistinctOn (a <> b)+  DistinctOn a     `mappend` _            = DistinctOn a+  DistinctStandard `mappend` _            = DistinctStandard+  DistinctAll      `mappend` b            = b++ -- | A part of a @FROM@ clause. data FromClause =     FromStart Ident EntityDef@@ -313,6 +328,9 @@   EOrderBy :: OrderByType -> SqlExpr (Value a) -> SqlExpr OrderBy   EOrderRandom :: SqlExpr OrderBy +  -- A 'SqlExpr' accepted only by 'distinctOn'.+  EDistinctOn :: SqlExpr (Value a) -> SqlExpr DistinctOn+   -- A 'SqlExpr' accepted only by 'set'.   ESet :: (SqlExpr (Entity val) -> SqlExpr (Value ())) -> SqlExpr (Update val) @@ -383,8 +401,19 @@   limit  n = Q $ W.tell mempty { sdLimitClause = Limit (Just n) Nothing  }   offset n = Q $ W.tell mempty { sdLimitClause = Limit Nothing  (Just n) } +  distinct         act = Q (W.tell mempty { sdDistinctClause = DistinctStandard }) >> act+  distinctOn exprs act = Q (W.tell mempty { sdDistinctClause = DistinctOn exprs }) >> act+  don = EDistinctOn+  distinctOnOrderBy exprs act =+    distinctOn (toDistinctOn <$> exprs) $ do+      orderBy exprs+      act+    where+      toDistinctOn :: SqlExpr OrderBy -> SqlExpr DistinctOn+      toDistinctOn (EOrderBy _ f) = EDistinctOn f+   sub_select         = sub SELECT-  sub_selectDistinct = sub SELECT_DISTINCT+  sub_selectDistinct = sub_select . distinct    (^.) :: forall val typ. (PersistEntity val, PersistField typ)        => SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)@@ -451,7 +480,7 @@   (++.)   = unsafeSqlBinOp    " || "    subList_select         = EList . sub_select-  subList_selectDistinct = EList . sub_selectDistinct+  subList_selectDistinct = subList_select . distinct    valList []   = EEmptyList   valList vals = EList $ ERaw Parens $ const ( uncommas ("?" <$ vals)@@ -801,11 +830,8 @@      , MonadResource m )   => SqlQuery a   -> C.Source (SqlPersistT m) r-selectDistinctSource query = do-    src <- lift $ do-        res <- rawSelectSource SELECT_DISTINCT query-        fmap snd $ allocateAcquire res-    src+selectDistinctSource = selectSource . distinct+{-# DEPRECATED selectDistinctSource "Since 2.2.4: use 'selectSource' and 'distinct'." #-}   -- | Execute an @esqueleto@ @SELECT DISTINCT@ query inside@@ -813,10 +839,8 @@ selectDistinct :: ( SqlSelect a r                   , MonadIO m )                => SqlQuery a -> SqlPersistT m [r]-selectDistinct query = do-    res <- rawSelectSource SELECT_DISTINCT query-    conn <- R.ask-    liftIO $ with res $ flip R.runReaderT conn . runSource+selectDistinct = select . distinct+{-# DEPRECATED selectDistinct "Since 2.2.4: use 'select' and 'distinct'." #-}   -- | (Internal) Run a 'C.Source' of rows.@@ -925,7 +949,8 @@         flip S.runState firstIdentState $         W.runWriterT $         unQ query-      SideData fromClauses+      SideData distinctClause+               fromClauses                setClauses                whereClauses                groupByClause@@ -939,7 +964,7 @@       info = (conn, finalIdentState)   in mconcat       [ makeInsertInto info mode ret-      , makeSelect     info mode ret+      , makeSelect     info mode distinctClause ret       , makeFrom       info mode fromClauses       , makeSet        info setClauses       , makeWhere      info whereClauses@@ -953,11 +978,9 @@ -- | (Internal) Mode of query being converted by 'toRawSql'. data Mode =     SELECT-  | SELECT_DISTINCT   | DELETE   | UPDATE-  | INSERT_INTO Mode-    -- ^ 'Mode' should be either 'SELECT' or 'SELECT_DISTINCT'.+  | INSERT_INTO   uncommas :: [TLB.Builder] -> TLB.Builder@@ -971,21 +994,27 @@   makeInsertInto :: SqlSelect a r => IdentInfo -> Mode -> a -> (TLB.Builder, [PersistValue])-makeInsertInto info (INSERT_INTO _) ret = sqlInsertInto info ret-makeInsertInto _    _               _   = mempty+makeInsertInto info INSERT_INTO ret = sqlInsertInto info ret+makeInsertInto _    _           _   = mempty  -makeSelect :: SqlSelect a r => IdentInfo -> Mode -> a -> (TLB.Builder, [PersistValue])-makeSelect info mode_ ret = process mode_+makeSelect :: SqlSelect a r => IdentInfo -> Mode -> DistinctClause -> a -> (TLB.Builder, [PersistValue])+makeSelect info mode_ distinctClause ret = process mode_   where     process mode =       case mode of-        SELECT            -> withCols "SELECT "-        SELECT_DISTINCT   -> withCols "SELECT DISTINCT "-        DELETE            -> plain "DELETE "-        UPDATE            -> plain "UPDATE "-        INSERT_INTO mode' -> process mode'-    withCols v = first (v <>) (sqlSelectCols info ret)+        SELECT      -> withCols selectKind+        DELETE      -> plain "DELETE "+        UPDATE      -> plain "UPDATE "+        INSERT_INTO -> process SELECT+    selectKind =+      case distinctClause of+        DistinctAll      -> ("SELECT ", [])+        DistinctStandard -> ("SELECT DISTINCT ", [])+        DistinctOn exprs -> first (("SELECT DISTINCT ON (" <>) . (<> ") ")) $+                            uncommas' (processExpr <$> exprs)+      where processExpr (EDistinctOn f) = materializeExpr info f+    withCols v = v <> (sqlSelectCols info ret)     plain    v = (v, [])  @@ -1176,17 +1205,22 @@ -- | You may return any single value (i.e. a single column) from -- a 'select' query. 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 (ECompositeKey f) =-    let bs = f info-    in (uncommas $ map (parensM Parens) bs, [])+  sqlSelectCols = materializeExpr   sqlSelectColCount = const 1   sqlSelectProcessRow [pv] = Value <$> fromPersistValue pv   sqlSelectProcessRow pvs  = Value <$> fromPersistValue (PersistList pvs)  +-- | Materialize a @SqlExpr (Value a)@.+materializeExpr :: IdentInfo -> SqlExpr (Value a) -> (TLB.Builder, [PersistValue])+materializeExpr info (ERaw p f) =+  let (b, vals) = f info+  in (parensM p b, vals)+materializeExpr info (ECompositeKey f) =+  let bs = f info+  in (uncommas $ map (parensM Parens) bs, [])++ -- | You may return tuples (up to 16-tuples) and tuples of tuples -- from a 'select' query. instance ( SqlSelect a ra@@ -1681,16 +1715,11 @@ -- | Insert a 'PersistField' for every selected value. insertSelect :: (MonadIO m, PersistEntity a) =>   SqlQuery (SqlExpr (Insertion a)) -> SqlPersistT m ()-insertSelect = insertGeneralSelect SELECT+insertSelect = liftM (const ()) . rawEsqueleto INSERT_INTO . fmap EInsertFinal   -- | Insert a 'PersistField' for every unique selected value. insertSelectDistinct :: (MonadIO m, PersistEntity a) =>   SqlQuery (SqlExpr (Insertion a)) -> SqlPersistT m ()-insertSelectDistinct = insertGeneralSelect SELECT_DISTINCT---insertGeneralSelect :: (MonadIO m, PersistEntity a) =>-  Mode -> SqlQuery (SqlExpr (Insertion a)) -> SqlPersistT m ()-insertGeneralSelect mode =-  liftM (const ()) . rawEsqueleto (INSERT_INTO mode) . fmap EInsertFinal+insertSelectDistinct = insertSelect . distinct+{-# DEPRECATED insertSelectDistinct "Since 2.2.4: use 'insertSelect' and 'distinct'." #-}

@@ -1,3 +1,4 @@+{-# OPTIONS_GHC -fno-warn-unused-binds  #-} {-# LANGUAGE ConstraintKinds            , EmptyDataDecls            , FlexibleContexts@@ -18,12 +19,15 @@ module Main (main) where  import Control.Applicative ((<$>))+import Control.Arrow ((&&&)) import Control.Exception (IOException)-import Control.Monad (replicateM, replicateM_)+import Control.Monad (replicateM, replicateM_, void) import Control.Monad.IO.Class (MonadIO(liftIO)) import Control.Monad.Logger (MonadLogger(..), runStderrLoggingT, runNoLoggingT) import Control.Monad.Trans.Control (MonadBaseControl(..)) import Control.Monad.Trans.Reader (ReaderT)+import Data.List (sortBy)+import Data.Ord (comparing) import Database.Esqueleto #if   defined (WITH_POSTGRESQL) import Database.Persist.Postgresql (withPostgresqlConn)@@ -448,12 +452,12 @@        it "respects the associativity of joins" $         run $ do-            insert' p1+            void $ insert p1             ps <- select . from $                       \((p :: SqlExpr (Entity Person))                        `LeftOuterJoin`-                        (( q :: SqlExpr (Entity Person))-                         `InnerJoin` (r :: SqlExpr (Entity Person)))) -> do+                        ((_q :: SqlExpr (Entity Person))+                         `InnerJoin` (_r :: SqlExpr (Entity Person)))) -> do                 on (val False) -- Inner join is empty                 on (val True)                 return p@@ -560,18 +564,18 @@           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 ]+          ret1 <- select $+                  from $ \p-> do+                  where_ (lower_ (p ^. PersonName) ==. val (map toLower $ personName p1))+                  return p+          liftIO $ ret1 `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 ]+          ret2 <- select $+                  from $ \p-> do+                  where_ (p ^. PersonName ==. lower_ (val $ map toUpper $ personName bob))+                  return p+          liftIO $ ret2 `shouldBe` [ p2e ]        it "works with random_" $         run $ do@@ -779,19 +783,76 @@           liftIO $ map entityVal eps `shouldBe` reverse ps  -    describe "selectDistinct" $-      it "works on a simple example" $+    describe "SELECT DISTINCT" $ do+      let selDistTest+            :: (   forall m. RunDbMonad m+                => SqlQuery (SqlExpr (Value String))+                -> SqlPersistT (R.ResourceT m) [Value String])+            -> IO ()+          selDistTest q =+            run $ do+              p1k <- insert p1+              let (t1, t2, t3) = ("a", "b", "c")+              mapM_ (insert . flip BlogPost p1k) [t1, t3, t2, t2, t1]+              ret <- q $+                     from $ \b -> do+                     let title = b ^. BlogPostTitle+                     orderBy [asc title]+                     return title+              liftIO $ ret `shouldBe` [ Value t1, Value t2, Value t3 ]+      it "works on a simple example (selectDistinct)" $+        selDistTest selectDistinct++      it "works on a simple example (select . distinct)" $+        selDistTest (select . distinct)++      it "works on a simple example (distinct (return ()))" $+        selDistTest (\act -> select $ distinct (return ()) >> act)++#if defined(WITH_POSTGRESQL)+    describe "SELECT DISTINCT ON" $ do+      it "works on a simple example" $ do         run $ do-          p1k <- insert p1-          let (t1, t2, t3) = ("a", "b", "c")-          mapM_ (insert . flip BlogPost p1k) [t1, t3, t2, t2, t1]-          ret <- selectDistinct $-                 from $ \b -> do-                 let title = b ^. BlogPostTitle-                 orderBy [asc title]-                 return title-          liftIO $ ret `shouldBe` [ Value t1, Value t2, Value t3 ]+          [p1k, p2k, _] <- mapM insert [p1, p2, p3]+          [_, bpB, bpC] <- mapM insert'+            [ BlogPost "A" p1k+            , BlogPost "B" p1k+            , BlogPost "C" p2k ]+          ret <- select $+                 from $ \bp ->+                 distinctOn [don (bp ^. BlogPostAuthorId)] $ do+                 orderBy [asc (bp ^. BlogPostAuthorId), desc (bp ^. BlogPostTitle)]+                 return bp+          liftIO $ ret `shouldBe` sortBy (comparing (blogPostAuthorId . entityVal)) [bpB, bpC] +      let slightlyLessSimpleTest q =+            run $ do+              [p1k, p2k, _] <- mapM insert [p1, p2, p3]+              [bpA, bpB, bpC] <- mapM insert'+                [ BlogPost "A" p1k+                , BlogPost "B" p1k+                , BlogPost "C" p2k ]+              ret <- select $+                     from $ \bp ->+                     q bp $ return bp+              let cmp = (blogPostAuthorId &&& blogPostTitle) . entityVal+              liftIO $ ret `shouldBe` sortBy (comparing cmp) [bpA, bpB, bpC]+      it "works on a slightly less simple example (two distinctOn calls, orderBy)" $+        slightlyLessSimpleTest $ \bp act ->+          distinctOn [don (bp ^. BlogPostAuthorId)] $+          distinctOn [don (bp ^. BlogPostTitle)] $ do+            orderBy [asc (bp ^. BlogPostAuthorId), asc (bp ^. BlogPostTitle)]+            act+      it "works on a slightly less simple example (one distinctOn call, orderBy)" $ do+        slightlyLessSimpleTest $ \bp act ->+          distinctOn [don (bp ^. BlogPostAuthorId), don (bp ^. BlogPostTitle)] $ do+            orderBy [asc (bp ^. BlogPostAuthorId), asc (bp ^. BlogPostTitle)]+            act+      it "works on a slightly less simple example (distinctOnOrderBy)" $ do+        slightlyLessSimpleTest $ \bp ->+          distinctOnOrderBy [asc (bp ^. BlogPostAuthorId), asc (bp ^. BlogPostTitle)]+#endif+     describe "coalesce/coalesceDefault" $ do       it "works on a simple example" $         run $ do@@ -878,7 +939,7 @@ #if defined(WITH_POSTGRESQL)       it "ilike, (%) and (++.) work on a simple example on PostgreSQL" $          run $ do-           [p1e, p2e, p3e, p4e, p5e] <- mapM insert' [p1, p2, p3, p4, p5]+           [p1e, _, p3e, _, p5e] <- mapM insert' [p1, p2, p3, p4, p5]            let nameContains t expected = do                  ret <- select $                         from $ \p -> do@@ -1098,6 +1159,7 @@                  where_ $ exists $                           from $ \bp -> do                           where_ (bp ^. BlogPostAuthorId ==. p ^. PersonId)+                 orderBy [asc (p ^. PersonName)]                  return p           liftIO $ ret `shouldBe` [ Entity p1k p1                                   , Entity p3k p3 ]@@ -1274,7 +1336,7 @@ #endif   runSqlConn . #if defined (WITH_POSTGRESQL) || defined (WITH_MYSQL)-  (runMigration migrateAll >>) $ (cleanDB >> act)+  (runMigrationSilent migrateAll >>) $ (cleanDB >> act) #else   (runMigrationSilent migrateAll >>) $ act #endif