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

Create a separate sqlSelectColCount.

Browse Source
This commit is contained in:
Felipe Lessa 2012-09-04 00:45:16 -03:00
parent 57c3b403d5
commit bb7775b672
1 changed files with 44 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -8,7 +8,7 @@ module Database.Esqueleto.Internal.Sql
) where
import Control.Applicative (Applicative(..), (<$>))
import Control.Arrow (first)
import Control.Arrow ((***), first)
import Control.Exception (throwIO)
import Control.Monad (ap)
import Control.Monad.IO.Class (MonadIO(..))
@ -199,8 +199,8 @@ toRawSelectSql esc query =
W.runWriterT $
unQ query
(_, selectText, selectVars) = sqlSelectCols esc ret
( whereText, whereVars) = makeWhere esc whereClauses
(selectText, selectVars) = sqlSelectCols esc ret
(whereText, whereVars) = makeWhere esc whereClauses
text = mconcat
[ "SELECT "
@ -215,10 +215,8 @@ toRawSelectSql esc query =
uncommas :: [TLB.Builder] -> TLB.Builder
uncommas = mconcat . intersperse ", "
uncommas' :: Monoid a => [(Int, TLB.Builder, a)] -> (Int, TLB.Builder, a)
uncommas' xs =
let (as, bs, cs) = unzip3 xs
in (sum as, uncommas bs, mconcat cs)
uncommas' :: Monoid a => [(TLB.Builder, a)] -> (TLB.Builder, a)
uncommas' = (uncommas *** mconcat) . unzip
makeFrom :: Escape -> [FromClause] -> TLB.Builder
@ -248,7 +246,11 @@ class SqlSelect a r | a -> r, r -> a where
-- | Creates the variable part of the @SELECT@ query and
-- returns the list of 'PersistValue's that will be given to
-- 'withStmt'.
sqlSelectCols :: Escape -> a -> (Int, TLB.Builder, [PersistValue])
sqlSelectCols :: Escape -> a -> (TLB.Builder, [PersistValue])
-- | Number of columns that will be consumed. Must be
-- non-strict on the argument.
sqlSelectColCount :: a -> Int
-- | Transform a row of the result into the data type.
sqlSelectProcessRow :: [PersistValue] -> Either T.Text r
@ -270,19 +272,22 @@ instance PersistEntity a => SqlSelect (SqlExpr (Entity a)) (Entity a) where
-- example).
name = ident <> "."
ret = let ed = entityDef $ getEntityVal expr
in (length (entityFields ed) + 1, process ed, mempty)
getEntityVal :: SqlExpr (Entity a) -> a
getEntityVal = error "Database.Esqueleto.SqlSelect.getEntityVal"
in (process ed, mempty)
sqlSelectCols _ _ = error "Esqueleto/Sql/sqlSelectCols[Entity]: never here (see GHC #6124)"
sqlSelectColCount = (+1) . length . entityFields . entityDef . getEntityVal
sqlSelectProcessRow (idCol:ent) =
Entity <$> fromPersistValue idCol
<*> fromPersistValues ent
sqlSelectProcessRow _ = Left "SqlSelect (Entity a): wrong number of columns."
getEntityVal :: SqlExpr (Entity a) -> a
getEntityVal = error "Esqueleto/Sql/getEntityVal"
instance PersistField a => SqlSelect (SqlExpr (Single a)) (Single a) where
sqlSelectCols esc (ERaw f) = let (b, vals) = f esc
in (1, parens b, vals)
in (parens b, vals)
sqlSelectCols _ _ = error "Esqueleto/Sql/sqlSelectCols[Single]: never here (see GHC #6124)"
sqlSelectColCount = const 1
sqlSelectProcessRow [pv] = Single <$> fromPersistValue pv
sqlSelectProcessRow _ = Left "SqlSelect (Single a): wrong number of columns."
@ -294,13 +299,14 @@ instance ( SqlSelect a ra
[ sqlSelectCols esc a
, sqlSelectCols esc b
]
sqlSelectColCount ~(a,b) = sqlSelectColCount a + sqlSelectColCount b
sqlSelectProcessRow =
let x = getType processRow
getType :: SqlSelect a r => (z -> Either y (r,x)) -> a
getType = error "Esqueleto/SqlSelect[(a,b)]/sqlSelectProcessRow/getType"
(colCountFst, _, _) = sqlSelectCols escape x
where escape = error "Esqueleto/SqlSelect[(a,b)]/sqlSelectProcessRow/escape"
colCountFst = sqlSelectColCount x
processRow row =
let (rowFst, rowSnd) = splitAt colCountFst row
in (,) <$> sqlSelectProcessRow rowFst
@ -319,8 +325,12 @@ instance ( SqlSelect a ra
, sqlSelectCols esc b
, sqlSelectCols esc c
]
sqlSelectColCount = sqlSelectColCount . from3
sqlSelectProcessRow = fmap to3 . sqlSelectProcessRow
from3 :: (a,b,c) -> ((a,b),c)
from3 (a,b,c) = ((a,b),c)
to3 :: ((a,b),c) -> (a,b,c)
to3 ((a,b),c) = (a,b,c)
@ -337,8 +347,12 @@ instance ( SqlSelect a ra
, sqlSelectCols esc c
, sqlSelectCols esc d
]
sqlSelectColCount = sqlSelectColCount . from4
sqlSelectProcessRow = fmap to4 . sqlSelectProcessRow
from4 :: (a,b,c,d) -> ((a,b),(c,d))
from4 (a,b,c,d) = ((a,b),(c,d))
to4 :: ((a,b),(c,d)) -> (a,b,c,d)
to4 ((a,b),(c,d)) = (a,b,c,d)
@ -357,8 +371,12 @@ instance ( SqlSelect a ra
, sqlSelectCols esc d
, sqlSelectCols esc e
]
sqlSelectColCount = sqlSelectColCount . from5
sqlSelectProcessRow = fmap to5 . sqlSelectProcessRow
from5 :: (a,b,c,d,e) -> ((a,b),(c,d),e)
from5 (a,b,c,d,e) = ((a,b),(c,d),e)
to5 :: ((a,b),(c,d),e) -> (a,b,c,d,e)
to5 ((a,b),(c,d),e) = (a,b,c,d,e)
@ -379,8 +397,12 @@ instance ( SqlSelect a ra
, sqlSelectCols esc e
, sqlSelectCols esc f
]
sqlSelectColCount = sqlSelectColCount . from6
sqlSelectProcessRow = fmap to6 . sqlSelectProcessRow
from6 :: (a,b,c,d,e,f) -> ((a,b),(c,d),(e,f))
from6 (a,b,c,d,e,f) = ((a,b),(c,d),(e,f))
to6 :: ((a,b),(c,d),(e,f)) -> (a,b,c,d,e,f)
to6 ((a,b),(c,d),(e,f)) = (a,b,c,d,e,f)
@ -403,8 +425,12 @@ instance ( SqlSelect a ra
, sqlSelectCols esc f
, sqlSelectCols esc g
]
sqlSelectColCount = sqlSelectColCount . from7
sqlSelectProcessRow = fmap to7 . sqlSelectProcessRow
from7 :: (a,b,c,d,e,f,g) -> ((a,b),(c,d),(e,f),g)
from7 (a,b,c,d,e,f,g) = ((a,b),(c,d),(e,f),g)
to7 :: ((a,b),(c,d),(e,f),g) -> (a,b,c,d,e,f,g)
to7 ((a,b),(c,d),(e,f),g) = (a,b,c,d,e,f,g)
@ -429,7 +455,11 @@ instance ( SqlSelect a ra
, sqlSelectCols esc g
, sqlSelectCols esc h
]
sqlSelectColCount = sqlSelectColCount . from8
sqlSelectProcessRow = fmap to8 . sqlSelectProcessRow
from8 :: (a,b,c,d,e,f,g,h) -> ((a,b),(c,d),(e,f),(g,h))
from8 (a,b,c,d,e,f,g,h) = ((a,b),(c,d),(e,f),(g,h))
to8 :: ((a,b),(c,d),(e,f),(g,h)) -> (a,b,c,d,e,f,g,h)
to8 ((a,b),(c,d),(e,f),(g,h)) = (a,b,c,d,e,f,g,h)