haskell/esqueleto
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge pull request #16 from bogiebro/master

Browse Source 
Insert select statements
This commit is contained in:
Felipe Lessa 2013-07-01 06:58:13 -07:00
commit 4b776dd7b6
4 changed files with 105 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
esqueleto.cabal
View File

@ -33,9 +33,9 @@ description:
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/>.
.

31
src/Database/Esqueleto.hs
View File

@ -71,6 +71,10 @@ module Database.Esqueleto
, deleteCount
, update
, updateCount
, insertSelect
, insertSelectDistinct
, (<#)
, (<&>)
-- * Helpers
, valkey
@ -318,17 +322,32 @@ import qualified Database.Persist
-- 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.
----------------------------------------------------------------------
-- $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".
--
-- * Everything from "Database.Persist.Class" except for

72
src/Database/Esqueleto/Internal/Sql.hs
View File

@ -35,6 +35,10 @@ module Database.Esqueleto.Internal.Sql
, Mode(..)
, SqlSelect
, veryUnsafeCoerceSqlExprValue
, insertSelectDistinct
, insertSelect
, (<#)
, (<&>)
) where
import Control.Applicative (Applicative(..), (<$>), (<$))
@ -224,9 +228,11 @@ useIdent conn (I ident) = fromDBName conn $ DBName ident
----------------------------------------------------------------------
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 @@ setAux field mkVal = ESet $ \ent -> unsafeSqlBinOp " = " name (mkVal ent)
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 @@ fromDBName conn = TLB.fromText . connEscapeName conn
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 @@ rawSelectSource mode query = src
run conn =
uncurry rawQuery $
first builderToText $
toRawSql mode conn query
toRawSql mode pureQuery conn query
massage = do
mrow <- C.await
@ -600,7 +606,7 @@ rawEsqueleto mode query = do
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 @@ builderToText = TL.toStrict . TLB.toLazyTextWith defaultChunkSize
-- @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,6 +711,21 @@ toRawSql mode conn query =
-- | (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 @@ class SqlSelect a r | a -> r, r -> a where
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 @@ from16P = const Proxy
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

12
test/Test.hs
View File

@ -9,6 +9,7 @@
, Rank2Types
, TemplateHaskell
, TypeFamilies
, ScopedTypeVariables
#-}
module Main (main) where
@ -623,6 +624,17 @@ main = do
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)]
----------------------------------------------------------------------