esqueleto 1.2.2.1 → 1.2.3

raw patch · 4 files changed

+106/−14 lines, 4 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• esqueleto.cabal +4/−4
• src/Database/Esqueleto.hs +25/−3
• src/Database/Esqueleto/Internal/Sql.hs +65/−7
• test/Test.hs +12/−0

@@ -1,5 +1,5 @@ name:                esqueleto-version:             1.2.2.1+version:             1.2.3 synopsis:            Bare bones, type-safe EDSL for SQL queries on persistent backends. homepage:            https://github.com/meteficha/esqueleto license:             BSD3@@ -33,9 +33,9 @@   compile-time errors---although it is possible to write   type-checked @esqueleto@ queries that fail at runtime.   .-  Currently only @SELECT@s are supported.  Not all SQL features-  are available, but most of them can be easily added (especially-  functions), so please open an issue or send a pull request if+  Currently, @SELECT@s, @UPDATE@s, @INSERT@s and @DELETE@s are supported.+  Not all SQL features are available, but most of them can be easily added+  (especially functions), so please open an issue or send a pull request if   you need anything that is not covered by @esqueleto@ on   <https://github.com/meteficha/esqueleto/>.   .

@@ -71,6 +71,10 @@   , deleteCount   , update   , updateCount+  , insertSelect+  , insertSelectDistinct+  , (<#)+  , (<&>)      -- * Helpers   , valkey@@ -318,6 +322,26 @@ --      from $ \\p -> do --      where_ (p ^. PersonAge <. just (val 14)) -- @+--+-- The results of queries can also be used for insertions.+-- In @SQL@, we might write the following, inserting a new blog+-- post for every user:+--+-- @+-- INSERT INTO BlogPost+-- SELECT ('Group Blog Post', id)+-- FROM Person+-- @+--+-- In @esqueleto@, we may write the same query above as:+--+-- @+-- insertSelect $ from $ \p->+--  return $ BlogPost \<# \"Group Blog Post\" \<&\> (p ^. PersonId)+-- @+--+-- Individual insertions can be performed through Persistent's+-- 'insert' function, reexported for convenience.   ----------------------------------------------------------------------@@ -325,9 +349,7 @@  -- $reexports ----- We re-export many symbols from @persistent@ for convenince,--- since @esqueleto@ currently does not provide a way of doing--- @INSERT@s:+-- We re-export many symbols from @persistent@ for convenince: -- --  * \"Store functions\" from "Database.Persist". --

@@ -35,6 +35,10 @@   , Mode(..)   , SqlSelect   , veryUnsafeCoerceSqlExprValue+  , insertSelectDistinct+  , insertSelect+  , (<#)+  , (<&>)   ) where  import Control.Applicative (Applicative(..), (<$>), (<$))@@ -224,9 +228,11 @@  ---------------------------------------------------------------------- +type Insertion = Proxy  -- | An expression on the SQL backend. data SqlExpr a where+  EInsert  :: Proxy a -> (Connection -> (TLB.Builder, [PersistValue])) -> SqlExpr (Insertion a)   EEntity  :: Ident -> SqlExpr (Entity val)   EMaybe   :: SqlExpr a -> SqlExpr (Maybe a)   ERaw     :: NeedParens -> (Connection -> (TLB.Builder, [PersistValue])) -> SqlExpr (Value a)@@ -371,7 +377,7 @@   where name = ERaw Never $ \conn -> (fieldName conn field, mempty)  sub :: PersistField a => Mode -> SqlQuery (SqlExpr (Value a)) -> SqlExpr (Value a)-sub mode query = ERaw Parens $ \conn -> toRawSql mode conn query+sub mode query = ERaw Parens $ \conn -> toRawSql mode pureQuery conn query  fromDBName :: Connection -> DBName -> TLB.Builder fromDBName conn = TLB.fromText . connEscapeName conn@@ -379,7 +385,7 @@ existsHelper :: SqlQuery () -> SqlExpr (Value a) existsHelper =   ERaw Parens .-  flip (toRawSql SELECT) .+  flip (toRawSql SELECT pureQuery) .   (>> return (val True :: SqlExpr (Value Bool)))  ifNotEmptyList :: SqlExpr (ValueList a) -> Bool -> SqlExpr (Value Bool) -> SqlExpr (Value Bool)@@ -488,7 +494,7 @@       run conn =         uncurry rawQuery $         first builderToText $-        toRawSql mode conn query+        toRawSql mode pureQuery conn query        massage = do         mrow <- C.await@@ -600,7 +606,7 @@   conn <- SqlPersistT R.ask   uncurry rawExecuteCount $     first builderToText $-    toRawSql mode conn query+    toRawSql mode pureQuery conn query   -- | Execute an @esqueleto@ @DELETE@ query inside @persistent@'s@@ -684,14 +690,15 @@ -- @esqueleto@, instead of manually using this function (which is -- possible but tedious), you may just turn on query logging of -- @persistent@.-toRawSql :: SqlSelect a r => Mode -> Connection -> SqlQuery a -> (TLB.Builder, [PersistValue])-toRawSql mode conn query =+toRawSql :: SqlSelect a r => Mode -> QueryType a -> Connection -> SqlQuery a -> (TLB.Builder, [PersistValue])+toRawSql mode qt conn query =   let (ret, SideData fromClauses setClauses whereClauses groupByClause havingClause orderByClauses limitClause) =         flip S.evalState initialIdentState $         W.runWriterT $         unQ query   in mconcat-      [ makeSelect  conn mode ret+      [ makeInsert  qt ret+      , makeSelect  conn mode ret       , makeFrom    conn mode fromClauses       , makeSet     conn setClauses       , makeWhere   conn whereClauses@@ -704,7 +711,22 @@ -- | (Internal) Mode of query being converted by 'toRawSql'. data Mode = SELECT | SELECT_DISTINCT | DELETE | UPDATE +newtype QueryType a = QueryType { unQueryType :: a -> TLB.Builder } +pureQuery :: QueryType a+pureQuery = QueryType (const mempty)++insertQuery :: PersistEntity a => QueryType (SqlExpr (Insertion a))+insertQuery = QueryType $ \(EInsert p _)->+    let def = entityDef p+        unName = TLB.fromText . unDBName+        fields = uncommas $ map (unName . fieldDB) (entityFields def)+        table = unName . entityDB . entityDef $ p+    in "INSERT INTO " <> table <> parens fields <> "\n"++makeInsert :: QueryType a -> a -> (TLB.Builder, [PersistValue])+makeInsert q a = (unQueryType q a, [])+ uncommas :: [TLB.Builder] -> TLB.Builder uncommas = mconcat . intersperse ", " . filter (/= mempty) @@ -840,6 +862,14 @@   sqlSelectProcessRow :: [PersistValue] -> Either T.Text r  +-- | You may return an insertion of some PersistEntity+instance PersistEntity a => SqlSelect (SqlExpr (Insertion a)) (Insertion a) where+  sqlSelectCols esc (EInsert _ f) = let (b, vals) = f esc+                                    in (b, vals)+  sqlSelectColCount = const 0+  sqlSelectProcessRow = const (Right Proxy)++ -- | Not useful for 'select', but used for 'update' and 'delete'. instance SqlSelect () () where   sqlSelectCols _ _ = ("1", [])@@ -1386,3 +1416,31 @@  to16 :: ((a,b),(c,d),(e,f),(g,h),(i,j),(k,l),(m,n),(o,p)) -> (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p) to16 ((a,b),(c,d),(e,f),(g,h),(i,j),(k,l),(m,n),(o,p)) = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p)++-- | Apply a 'PersistField' constructor to @SqlExpr Value@ arguments+(<#) :: (a -> b) -> SqlExpr (Value a) -> SqlExpr (Insertion b)+(<#) _ (ERaw _ f) = EInsert Proxy f++-- | Apply extra @SqlExpr Value@ arguments to a 'PersistField' constructor+(<&>) :: SqlExpr (Insertion (a -> b)) -> SqlExpr (Value a) -> SqlExpr (Insertion b)+(EInsert _ f) <&> (ERaw _ g) = EInsert Proxy $ \x-> +  let (fb, fv) = f x+      (gb, gv) = g x+  in (fb <> ", " <> gb, fv ++ gv)++-- | Insert a 'PersistField' for every selected value+insertSelect :: (MonadLogger m, MonadResourceBase m, SqlSelect (SqlExpr (Insertion a)) r, PersistEntity a) =>+  SqlQuery (SqlExpr (Insertion a)) -> SqlPersistT m ()+insertSelect = insertGeneralSelect SELECT++-- | Insert a 'PersistField' for every unique selected value+insertSelectDistinct :: (MonadLogger m, MonadResourceBase m, SqlSelect (SqlExpr (Insertion a)) r, PersistEntity a) =>+  SqlQuery (SqlExpr (Insertion a)) -> SqlPersistT m ()+insertSelectDistinct = insertGeneralSelect SELECT_DISTINCT+++insertGeneralSelect :: (MonadLogger m, MonadResourceBase m, SqlSelect (SqlExpr (Insertion a)) r, PersistEntity a) =>+  Mode -> SqlQuery (SqlExpr (Insertion a)) -> SqlPersistT m ()+insertGeneralSelect mode query = do+  conn <- SqlPersistT R.ask+  uncurry rawExecute $ first builderToText $ toRawSql mode insertQuery conn query

@@ -9,6 +9,7 @@            , Rank2Types            , TemplateHaskell            , TypeFamilies+           , ScopedTypeVariables  #-} module Main (main) where @@ -622,6 +623,17 @@                           where_ (bp ^. BlogPostAuthorId ==. p ^. PersonId)                  return p           liftIO $ ret `shouldBe` [ Entity p2k p2 ]++    describe "inserts by select" $ do+      it "IN works for insertSelect" $+        run $ do+          _ <- insert p1+          _ <- insert p2+          _ <- insert p3+          insertSelect $ from $ \p -> do+            return $ BlogPost <# val "FakePost" <&> (p ^. PersonId)+          ret <- select $ from (\(b::(SqlExpr (Entity BlogPost))) -> return countRows)+          liftIO $ ret `shouldBe` [Value (3::Int)]   ----------------------------------------------------------------------