Skip to content

Commit ae9ef12

Browse files
belevybelevy
authored
Merge pull request #10 from foxhound-systems/from-raw
From raw
2 parents 9d1550b + 75619fe commit ae9ef12

File tree

8 files changed

+408
-437
lines changed

8 files changed

+408
-437
lines changed

‎src/Database/Esqueleto.hs‎

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,7 @@
1-
{-# LANGUAGE FlexibleContexts, FlexibleInstances, GADTs, RankNTypes #-}
1+
{-# LANGUAGE FlexibleContexts #-}
2+
{-# LANGUAGE FlexibleInstances #-}
3+
{-# LANGUAGE GADTs #-}
4+
{-# LANGUAGE RankNTypes #-}
25
-- | The @esqueleto@ EDSL (embedded domain specific language).
36
-- This module replaces @Database.Persist@, so instead of
47
-- importing that module you should just import this one:
@@ -125,8 +128,8 @@ import Control.Monad.Trans.Reader (ReaderT)
125128
import Data.Int (Int64)
126129
import qualified Data.Map.Strict as Map
127130
import Database.Esqueleto.Internal.Language
128-
import Database.Esqueleto.Internal.Sql
129131
import Database.Esqueleto.Internal.PersistentImport
132+
import Database.Esqueleto.Internal.Sql
130133
import qualified Database.Persist
131134

132135

‎src/Database/Esqueleto/Experimental.hs‎

Lines changed: 13 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -19,8 +19,10 @@ module Database.Esqueleto.Experimental
1919
-- * Documentation
2020

2121
Table(..)
22+
, table
2223
, from
2324
, SubQuery(..)
25+
, selectQuery
2426
, (:&)(..)
2527
, on
2628

@@ -40,14 +42,23 @@ module Database.Esqueleto.Experimental
4042
, with
4143
, withRecursive
4244

45+
, innerJoin
46+
, innerJoinLateral
47+
, leftJoin
48+
, leftJoinLateral
49+
, rightJoin
50+
, fullOuterJoin
51+
, crossJoin
52+
, crossJoinLateral
53+
4354
-- * Internals
4455
, From(..)
4556
, ToMaybe(..)
4657
, ToAlias(..)
4758
, ToAliasT
4859
, ToAliasReference(..)
4960
, ToAliasReferenceT
50-
, ToSetOperation(..)
61+
, ToSqlSetOperation(..)
5162
, ValidOnClauseValue
5263
-- * The Normal Stuff
5364

@@ -216,6 +227,7 @@ import Database.Esqueleto.Experimental.From.SqlSetOperation
216227
import Database.Esqueleto.Experimental.ToAlias
217228
import Database.Esqueleto.Experimental.ToAliasReference
218229
import Database.Esqueleto.Experimental.ToMaybe
230+
219231
-- $setup
220232
--
221233
-- If you're already using "Database.Esqueleto", then you can get

‎src/Database/Esqueleto/Experimental/From.hs‎

Lines changed: 50 additions & 50 deletions
Original file line numberDiff line numberDiff line change
@@ -1,21 +1,28 @@
11
{-# LANGUAGE CPP #-}
22
{-# LANGUAGE DataKinds #-}
3+
{-# LANGUAGE DerivingStrategies #-}
34
{-# LANGUAGE FlexibleContexts #-}
45
{-# LANGUAGE FlexibleInstances #-}
56
{-# LANGUAGE FunctionalDependencies #-}
67
{-# LANGUAGE GADTs #-}
8+
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
79
{-# LANGUAGE MultiParamTypeClasses #-}
810
{-# LANGUAGE OverloadedStrings #-}
911
{-# LANGUAGE PatternSynonyms #-}
12+
{-# LANGUAGE ScopedTypeVariables #-}
13+
{-# LANGUAGE TypeApplications #-}
1014
{-# LANGUAGE TypeFamilies #-}
1115
{-# LANGUAGE TypeOperators #-}
1216
{-# LANGUAGE UndecidableInstances #-}
1317

1418
module Database.Esqueleto.Experimental.From
1519
where
1620

21+
import Control.Arrow (first)
22+
import Control.Monad (ap)
1723
import qualified Control.Monad.Trans.Writer as W
1824
import Data.Proxy
25+
import qualified Data.Text.Lazy.Builder as TLB
1926
import Database.Esqueleto.Experimental.ToAlias
2027
import Database.Esqueleto.Experimental.ToAliasReference
2128
import Database.Esqueleto.Internal.Internal hiding (From(..), from, on)
@@ -30,70 +37,56 @@ import Database.Esqueleto.Internal.PersistentImport
3037
-- instances of `From`. This implementation eliminates certain
3138
-- types of runtime errors by preventing the construction of
3239
-- invalid SQL (e.g. illegal nested-@from@).
33-
from :: From a => a -> SqlQuery (FromT a)
34-
from parts = do
35-
(a, clause) <- runFrom parts
36-
Q $ W.tell mempty{sdFromClause=[clause]}
40+
from :: ToFrom a a' => a -> SqlQuery a'
41+
from f = do
42+
(a, clause) <- unFrom (toFrom f)
43+
Q $ W.tell mempty{sdFromClause=[FromRaw $ clause]}
3744
pure a
3845

39-
class From a where
40-
type FromT a
41-
runFrom :: a -> SqlQuery (FromT a, FromClause)
46+
type RawFn = NeedParens -> IdentInfo -> (TLB.Builder, [PersistValue])
47+
newtype From a = From
48+
{ unFrom :: SqlQuery (a, RawFn)}
49+
50+
class ToFrom a r | a -> r where
51+
toFrom :: a -> From r
52+
instance ToFrom (From a) a where
53+
toFrom = id
4254

4355
-- | Data type for bringing a Table into scope in a JOIN tree
4456
--
4557
-- @
4658
-- select $ from $ Table \@People
4759
-- @
4860
data Table a = Table
61+
instance PersistEntity ent => ToFrom (Table ent) (SqlExpr (Entity ent)) where
62+
toFrom _ = table
4963

50-
instance PersistEntity a => From (Table a) where
51-
type FromT (Table a) = SqlExpr (Entity a)
52-
runFrom e@Table = do
53-
let ed = entityDef $ getVal e
54-
ident <- newIdentFor (entityDB ed)
55-
let entity = unsafeSqlEntity ident
56-
pure $ (entity, FromStart ident ed)
57-
where
58-
getVal :: Table ent -> Proxy ent
59-
getVal = const Proxy
64+
table :: forall ent. PersistEntity ent => From (SqlExpr (Entity ent))
65+
table = From $ do
66+
let ed = entityDef (Proxy @ent)
67+
ident <- newIdentFor (entityDB ed)
68+
let entity = unsafeSqlEntity ident
69+
pure $ ( entity, const $ base ident ed )
70+
where
71+
base ident@(I identText) def info =
72+
let db@(DBName dbText) = entityDB def
73+
in ( fromDBName info db <>
74+
if dbText == identText
75+
then mempty
76+
else " AS " <> useIdent info ident
77+
, mempty
78+
)
6079

6180

6281
{-# DEPRECATED SubQuery "/Since: 3.4.0.0/ - It is no longer necessary to tag 'SqlQuery' values with @SubQuery@" #-}
6382
newtype SubQuery a = SubQuery a
83+
instance (SqlSelect a r, ToAlias a, ToAliasReference a) => ToFrom (SubQuery (SqlQuery a)) a where
84+
toFrom (SubQuery q) = selectQuery q
85+
instance (SqlSelect a r, ToAlias a, ToAliasReference a) => ToFrom (SqlQuery a) a where
86+
toFrom = selectQuery
6487

65-
instance
66-
( ToAlias a
67-
, ToAliasReference a
68-
, SqlSelect a r
69-
)
70-
=>
71-
From (SqlQuery a)
72-
where
73-
type FromT (SqlQuery a) = a
74-
runFrom subquery =
75-
fromSubQuery NormalSubQuery subquery
76-
77-
instance
78-
( ToAlias a
79-
, ToAliasReference a
80-
, SqlSelect a r
81-
)
82-
=>
83-
From (SubQuery (SqlQuery a))
84-
where
85-
type FromT (SubQuery (SqlQuery a)) = a
86-
runFrom (SubQuery subquery) =
87-
fromSubQuery NormalSubQuery subquery
88-
89-
fromSubQuery
90-
::
91-
( SqlSelect a r
92-
, ToAlias a
93-
, ToAliasReference a
94-
)
95-
=> SubQueryType -> SqlQuery a -> SqlQuery (a, FromClause)
96-
fromSubQuery subqueryType subquery = do
88+
selectQuery :: (SqlSelect a r, ToAlias a, ToAliasReference a) => SqlQuery a -> From a
89+
selectQuery subquery = From $ do
9790
-- We want to update the IdentState without writing the query to side data
9891
(ret, sideData) <- Q $ W.censor (\_ -> mempty) $ W.listen $ unQ subquery
9992
aliasedValue <- toAlias ret
@@ -105,4 +98,11 @@ fromSubQuery subqueryType subquery = do
10598
-- create aliased references from the outer query results (e.g value from subquery will be `subquery`.`value`),
10699
-- this is probably overkill as the aliases should already be unique but seems to be good practice.
107100
ref <- toAliasReference subqueryAlias aliasedValue
108-
pure (ref , FromQuery subqueryAlias (\info -> toRawSql SELECT info aliasedQuery) subqueryType)
101+
102+
pure (ref, \_ info ->
103+
let (queryText,queryVals) = toRawSql SELECT info aliasedQuery
104+
in
105+
( (parens queryText) <> " AS " <> useIdent info subqueryAlias
106+
, queryVals
107+
)
108+
)

‎src/Database/Esqueleto/Experimental/From/CommonTableExpression.hs‎

Lines changed: 12 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -14,12 +14,6 @@ import Database.Esqueleto.Experimental.ToAliasReference
1414
import Database.Esqueleto.Internal.Internal hiding (From(..), from, on)
1515
import Database.Esqueleto.Internal.PersistentImport (DBName(..))
1616

17-
data CommonTableExpression ref = CommonTableExpression Ident ref
18-
instance From (CommonTableExpression ref) where
19-
type FromT (CommonTableExpression ref) = ref
20-
runFrom (CommonTableExpression ident ref) =
21-
pure (ref, FromIdent ident)
22-
2317
-- | @WITH@ clause used to introduce a [Common Table Expression (CTE)](https://en.wikipedia.org/wiki/Hierarchical_and_recursive_queries_in_SQL#Common_table_expression).
2418
-- CTEs are supported in most modern SQL engines and can be useful
2519
-- in performance tuning. In Esqueleto, CTEs should be used as a
@@ -44,7 +38,7 @@ instance From (CommonTableExpression ref) where
4438
with :: ( ToAlias a
4539
, ToAliasReference a
4640
, SqlSelect a r
47-
) => SqlQuery a -> SqlQuery (CommonTableExpression a)
41+
) => SqlQuery a -> SqlQuery (From a)
4842
with query = do
4943
(ret, sideData) <- Q $ W.censor (\_ -> mempty) $ W.listen $ unQ query
5044
aliasedValue <- toAlias ret
@@ -53,7 +47,7 @@ with query = do
5347
let clause = CommonTableExpressionClause NormalCommonTableExpression ident (\info -> toRawSql SELECT info aliasedQuery)
5448
Q $ W.tell mempty{sdCteClause = [clause]}
5549
ref <- toAliasReference ident aliasedValue
56-
pure $ CommonTableExpression ident ref
50+
pure $ From $ pure (ref, (\_ info -> (useIdent info ident, mempty)))
5751

5852
-- | @WITH@ @RECURSIVE@ allows one to make a recursive subquery, which can
5953
-- reference itself. Like @WITH@, this is supported in most modern SQL engines.
@@ -90,33 +84,29 @@ with query = do
9084
withRecursive :: ( ToAlias a
9185
, ToAliasReference a
9286
, SqlSelect a r
93-
, RecursiveCteUnion unionKind
9487
)
9588
=> SqlQuery a
96-
-> unionKind
97-
-> (CommonTableExpression a -> SqlQuery a)
98-
-> SqlQuery (CommonTableExpression a)
89+
-> UnionKind
90+
-> (From a -> SqlQuery a)
91+
-> SqlQuery (From a)
9992
withRecursive baseCase unionKind recursiveCase = do
10093
(ret, sideData) <- Q $ W.censor (\_ -> mempty) $ W.listen $ unQ baseCase
10194
aliasedValue <- toAlias ret
10295
let aliasedQuery = Q $ W.WriterT $ pure (aliasedValue, sideData)
10396
ident <- newIdentFor (DBName "cte")
10497
ref <- toAliasReference ident aliasedValue
105-
let refFrom = CommonTableExpression ident ref
98+
let refFrom = From (pure (ref, (\_ info -> (useIdent info ident, mempty))))
10699
let recursiveQuery = recursiveCase refFrom
107100
let clause = CommonTableExpressionClause RecursiveCommonTableExpression ident
108101
(\info -> (toRawSql SELECT info aliasedQuery)
109-
<> (unionKeyword unionKind, mempty)
102+
<> ("\n" <> (unUnionKind unionKind) <> "\n", mempty)
110103
<> (toRawSql SELECT info recursiveQuery)
111104
)
112105
Q $ W.tell mempty{sdCteClause = [clause]}
113106
pure refFrom
114107

115-
class RecursiveCteUnion a where
116-
unionKeyword :: a -> TLB.Builder
117-
118-
instance RecursiveCteUnion (a -> b -> Union a b) where
119-
unionKeyword _ = "\nUNION\n"
120-
121-
instance RecursiveCteUnion (a -> b -> UnionAll a b) where
122-
unionKeyword _ = "\nUNION ALL\n"
108+
newtype UnionKind = UnionKind { unUnionKind :: TLB.Builder }
109+
instance Union_ UnionKind where
110+
union_ = UnionKind "UNION"
111+
instance UnionAll_ UnionKind where
112+
unionAll_ = UnionKind "UNION ALL"

0 commit comments

Comments
 (0)