module Database.Esqueleto.Internal.Sql
(
SqlQuery
, SqlExpr
, SqlEntity
, select
, selectSource
, selectDistinct
, selectDistinctSource
, delete
, deleteCount
, update
, updateCount
, unsafeSqlBinOp
, unsafeSqlValue
, unsafeSqlFunction
, UnsafeSqlFunctionArgument
, rawSelectSource
, runSource
, rawExecute
, toRawSql
, Mode(..)
, SqlSelect
, veryUnsafeCoerceSqlExprValue
) where
import Control.Applicative (Applicative(..), (<$>), (<$))
import Control.Arrow ((***), first)
import Control.Exception (throw, throwIO)
import Control.Monad ((>=>), ap, void, MonadPlus(..))
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Logger (MonadLogger)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Resource (MonadResourceBase)
import Data.Int (Int64)
import Data.List (intersperse)
import Data.Monoid (Monoid(..), (<>))
import Database.Persist.EntityDef
import Database.Persist.GenericSql
import Database.Persist.GenericSql.Internal (Connection(escapeName, noLimit))
import Database.Persist.GenericSql.Raw (executeCount, SqlBackend, withStmt)
import Database.Persist.Store hiding (delete)
import qualified Control.Monad.Trans.Reader as R
import qualified Control.Monad.Trans.State as S
import qualified Control.Monad.Trans.Writer as W
import qualified Data.Conduit as C
import qualified Data.Conduit.List as CL
import qualified Data.HashSet as HS
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TLB
import qualified Data.Text.Lazy.Builder.Int as TLBI
import Database.Esqueleto.Internal.Language
newtype SqlQuery a =
Q { unQ :: W.WriterT SideData (S.State IdentState) a }
instance Functor SqlQuery where
fmap f = Q . fmap f . unQ
instance Monad SqlQuery where
return = Q . return
m >>= f = Q (unQ m >>= unQ . f)
instance Applicative SqlQuery where
pure = return
(<*>) = ap
type SqlEntity ent = (PersistEntity ent, PersistEntityBackend ent ~ SqlBackend)
data SideData = SideData { sdFromClause :: ![FromClause]
, sdSetClause :: ![SetClause]
, sdWhereClause :: !WhereClause
, sdGroupByClause :: !GroupByClause
, sdOrderByClause :: ![OrderByClause]
, sdLimitClause :: !LimitClause
}
instance Monoid SideData where
mempty = SideData mempty mempty mempty mempty mempty mempty
SideData f s w o l g `mappend` SideData f' s' w' o' l' g' =
SideData (f <> f') (s <> s') (w <> w') (o <> o') (l <> l') (g <> g')
data FromClause =
FromStart Ident EntityDef
| FromJoin FromClause JoinKind FromClause (Maybe (SqlExpr (Value Bool)))
| OnClause (SqlExpr (Value Bool))
newtype SetClause = SetClause (SqlExpr (Value ()))
collectOnClauses :: [FromClause] -> Either (SqlExpr (Value Bool)) [FromClause]
collectOnClauses = go []
where
go [] (f@(FromStart _ _):fs) = fmap (f:) (go [] fs)
go acc (OnClause expr :fs) = findMatching acc expr >>= flip go fs
go acc (f:fs) = go (f:acc) fs
go acc [] = return $ reverse acc
findMatching (f : acc) expr =
case tryMatch expr f of
Just f' -> return (f' : acc)
Nothing -> (f:) <$> findMatching acc expr
findMatching [] expr = Left expr
tryMatch expr (FromJoin l k r onClause) =
matchR `mplus` matchC `mplus` matchL
where
matchR = (\r' -> FromJoin l k r' onClause) <$> tryMatch expr r
matchL = (\l' -> FromJoin l' k r onClause) <$> tryMatch expr l
matchC = case onClause of
Nothing -> return (FromJoin l k r (Just expr))
Just _ -> mzero
tryMatch _ _ = mzero
data WhereClause = Where (SqlExpr (Value Bool))
| NoWhere
instance Monoid WhereClause where
mempty = NoWhere
NoWhere `mappend` w = w
w `mappend` NoWhere = w
Where e1 `mappend` Where e2 = Where (e1 &&. e2)
newtype GroupByClause = GroupBy [SomeValue SqlExpr]
instance Monoid GroupByClause where
mempty = GroupBy []
GroupBy fs `mappend` GroupBy fs' = GroupBy (fs <> fs')
type OrderByClause = SqlExpr OrderBy
data LimitClause = Limit (Maybe Int64) (Maybe Int64)
instance Monoid LimitClause where
mempty = Limit mzero mzero
Limit l1 o1 `mappend` Limit l2 o2 =
Limit (l2 `mplus` l1) (o2 `mplus` o1)
newtype Ident = I T.Text
newtype IdentState = IdentState { inUse :: HS.HashSet T.Text }
initialIdentState :: IdentState
initialIdentState = IdentState mempty
newIdentFor :: DBName -> SqlQuery Ident
newIdentFor = Q . lift . try . unDBName
where
try orig = do
s <- S.get
let go (t:ts) | t `HS.member` inUse s = go ts
| otherwise = use t
go [] = error "Esqueleto/Sql/newIdentFor: never here"
go (possibilities orig)
possibilities t = t : map addNum [2..]
where
addNum :: Int -> T.Text
addNum = T.append t . T.pack . show
use t = do
S.modify (\s -> s { inUse = HS.insert t (inUse s) })
return (I t)
useIdent :: Connection -> Ident -> TLB.Builder
useIdent conn (I ident) = fromDBName conn $ DBName ident
data SqlExpr a where
EEntity :: Ident -> SqlExpr (Entity val)
EMaybe :: SqlExpr a -> SqlExpr (Maybe a)
ERaw :: NeedParens -> (Connection -> (TLB.Builder, [PersistValue])) -> SqlExpr (Value a)
EList :: SqlExpr (Value a) -> SqlExpr (ValueList a)
EEmptyList :: SqlExpr (ValueList a)
EOrderBy :: OrderByType -> SqlExpr (Value a) -> SqlExpr OrderBy
ESet :: (SqlExpr (Entity val) -> SqlExpr (Value ())) -> SqlExpr (Update val)
EPreprocessedFrom :: a -> FromClause -> SqlExpr (PreprocessedFrom a)
data NeedParens = Parens | Never
parensM :: NeedParens -> TLB.Builder -> TLB.Builder
parensM Never = id
parensM Parens = parens
data OrderByType = ASC | DESC
instance Esqueleto SqlQuery SqlExpr SqlBackend where
fromStart = x
where
x = do
let ed = entityDef (getVal x)
ident <- newIdentFor (entityDB ed)
let ret = EEntity ident
from_ = FromStart ident ed
return (EPreprocessedFrom ret from_)
getVal :: SqlQuery (SqlExpr (PreprocessedFrom (SqlExpr (Entity a)))) -> a
getVal = error "Esqueleto/Sql/fromStart/getVal: never here"
fromStartMaybe = maybelize <$> fromStart
where
maybelize :: SqlExpr (PreprocessedFrom (SqlExpr (Entity a)))
-> SqlExpr (PreprocessedFrom (SqlExpr (Maybe (Entity a))))
maybelize (EPreprocessedFrom ret from_) = EPreprocessedFrom (EMaybe ret) from_
fromJoin (EPreprocessedFrom lhsRet lhsFrom)
(EPreprocessedFrom rhsRet rhsFrom) = Q $ do
let ret = smartJoin lhsRet rhsRet
from_ = FromJoin lhsFrom
(reifyJoinKind ret)
rhsFrom
Nothing
return (EPreprocessedFrom ret from_)
fromFinish (EPreprocessedFrom ret from_) = Q $ do
W.tell mempty { sdFromClause = [from_] }
return ret
where_ expr = Q $ W.tell mempty { sdWhereClause = Where expr }
on expr = Q $ W.tell mempty { sdFromClause = [OnClause expr] }
groupBy expr = Q $ W.tell mempty { sdGroupByClause = GroupBy $ toSomeValues expr }
orderBy exprs = Q $ W.tell mempty { sdOrderByClause = exprs }
asc = EOrderBy ASC
desc = EOrderBy DESC
limit n = Q $ W.tell mempty { sdLimitClause = Limit (Just n) Nothing }
offset n = Q $ W.tell mempty { sdLimitClause = Limit Nothing (Just n) }
sub_select = sub SELECT
sub_selectDistinct = sub SELECT_DISTINCT
EEntity ident ^. field =
ERaw Never $ \conn -> (useIdent conn ident <> ("." <> fieldName conn field), [])
EMaybe r ?. field = maybelize (r ^. field)
where
maybelize :: SqlExpr (Value a) -> SqlExpr (Value (Maybe a))
maybelize (ERaw p f) = ERaw p f
val = ERaw Never . const . (,) "?" . return . toPersistValue
isNothing (ERaw p f) = ERaw Parens $ first ((<> " IS NULL") . parensM p) . f
just (ERaw p f) = ERaw p f
nothing = unsafeSqlValue "NULL"
countRows = unsafeSqlValue "COUNT(*)"
count (ERaw _ f) = ERaw Never $ \conn -> let (b, vals) = f conn
in ("COUNT" <> parens b, vals)
not_ (ERaw p f) = ERaw Never $ \conn -> let (b, vals) = f conn
in ("NOT " <> parensM p b, vals)
(==.) = unsafeSqlBinOp " = "
(>=.) = unsafeSqlBinOp " >= "
(>.) = unsafeSqlBinOp " > "
(<=.) = unsafeSqlBinOp " <= "
(<.) = unsafeSqlBinOp " < "
(!=.) = unsafeSqlBinOp " != "
(&&.) = unsafeSqlBinOp " AND "
(||.) = unsafeSqlBinOp " OR "
(+.) = unsafeSqlBinOp " + "
(-.) = unsafeSqlBinOp " - "
(/.) = unsafeSqlBinOp " / "
(*.) = unsafeSqlBinOp " * "
like = unsafeSqlBinOp " LIKE "
(%) = unsafeSqlValue "'%'"
concat_ = unsafeSqlFunction "CONCAT"
(++.) = unsafeSqlBinOp " || "
subList_select = EList . sub_select
subList_selectDistinct = EList . sub_selectDistinct
valList [] = EEmptyList
valList vals = EList $ ERaw Parens $ const ( uncommas ("?" <$ vals)
, map toPersistValue vals )
v `in_` e = ifNotEmptyList e False $ unsafeSqlBinOp " IN " v (veryUnsafeCoerceSqlExprValueList e)
v `notIn` e = ifNotEmptyList e True $ unsafeSqlBinOp " NOT IN " v (veryUnsafeCoerceSqlExprValueList e)
exists = unsafeSqlFunction "EXISTS " . existsHelper
notExists = unsafeSqlFunction "NOT EXISTS " . existsHelper
set ent upds = Q $ W.tell mempty { sdSetClause = map apply upds }
where
apply (ESet f) = SetClause (f ent)
field =. expr = setAux field (const expr)
field +=. expr = setAux field (\ent -> ent ^. field +. expr)
field -=. expr = setAux field (\ent -> ent ^. field -. expr)
field *=. expr = setAux field (\ent -> ent ^. field *. expr)
field /=. expr = setAux field (\ent -> ent ^. field /. expr)
instance ToSomeValues SqlExpr (SqlExpr (Value a)) where
toSomeValues a = [SomeValue a]
fieldName :: (PersistEntity val, PersistField typ)
=> Connection -> EntityField val typ -> TLB.Builder
fieldName conn = fromDBName conn . fieldDB . persistFieldDef
setAux :: (PersistEntity val, PersistField typ)
=> EntityField val typ
-> (SqlExpr (Entity val) -> SqlExpr (Value typ))
-> SqlExpr (Update val)
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
fromDBName :: Connection -> DBName -> TLB.Builder
fromDBName conn = TLB.fromText . escapeName conn
existsHelper :: SqlQuery () -> SqlExpr (Value a)
existsHelper =
ERaw Parens .
flip (toRawSql SELECT) .
(>> return (val True :: SqlExpr (Value Bool)))
ifNotEmptyList :: SqlExpr (ValueList a) -> Bool -> SqlExpr (Value Bool) -> SqlExpr (Value Bool)
ifNotEmptyList EEmptyList b _ = val b
ifNotEmptyList (EList _) _ x = x
unsafeSqlBinOp :: TLB.Builder -> SqlExpr (Value a) -> SqlExpr (Value b) -> SqlExpr (Value c)
unsafeSqlBinOp op (ERaw p1 f1) (ERaw p2 f2) = ERaw Parens f
where
f conn = let (b1, vals1) = f1 conn
(b2, vals2) = f2 conn
in ( parensM p1 b1 <> op <> parensM p2 b2
, vals1 <> vals2 )
unsafeSqlValue :: TLB.Builder -> SqlExpr (Value a)
unsafeSqlValue v = ERaw Never $ \_ -> (v, mempty)
unsafeSqlFunction :: UnsafeSqlFunctionArgument a =>
TLB.Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction name arg =
ERaw Never $ \conn ->
let (argsTLB, argsVals) =
uncommas' $ map (\(ERaw _ f) -> f conn) $ toArgList arg
in (name <> parens argsTLB, argsVals)
class UnsafeSqlFunctionArgument a where
toArgList :: a -> [SqlExpr (Value ())]
instance (a ~ Value b) => UnsafeSqlFunctionArgument (SqlExpr a) where
toArgList = (:[]) . veryUnsafeCoerceSqlExprValue
instance UnsafeSqlFunctionArgument a =>
UnsafeSqlFunctionArgument [a] where
toArgList = concatMap toArgList
instance ( UnsafeSqlFunctionArgument a
, UnsafeSqlFunctionArgument b
) => UnsafeSqlFunctionArgument (a, b) where
toArgList (a, b) = toArgList a ++ toArgList b
instance ( UnsafeSqlFunctionArgument a
, UnsafeSqlFunctionArgument b
, UnsafeSqlFunctionArgument c
) => UnsafeSqlFunctionArgument (a, b, c) where
toArgList = toArgList . from3
instance ( UnsafeSqlFunctionArgument a
, UnsafeSqlFunctionArgument b
, UnsafeSqlFunctionArgument c
, UnsafeSqlFunctionArgument d
) => UnsafeSqlFunctionArgument (a, b, c, d) where
toArgList = toArgList . from4
veryUnsafeCoerceSqlExprValue :: SqlExpr (Value a) -> SqlExpr (Value b)
veryUnsafeCoerceSqlExprValue (ERaw p f) = ERaw p f
veryUnsafeCoerceSqlExprValueList :: SqlExpr (ValueList a) -> SqlExpr (Value a)
veryUnsafeCoerceSqlExprValueList (EList v) = v
veryUnsafeCoerceSqlExprValueList EEmptyList =
error "veryUnsafeCoerceSqlExprValueList: empty list."
rawSelectSource :: ( SqlSelect a r
, MonadLogger m
, MonadResourceBase m )
=> Mode
-> SqlQuery a
-> SqlPersist m (C.Source (C.ResourceT (SqlPersist m)) r)
rawSelectSource mode query = src
where
src = do
conn <- SqlPersist R.ask
return $ run conn C.$= massage
run conn =
uncurry withStmt $
first builderToText $
toRawSql mode conn query
massage = do
mrow <- C.await
case process <$> mrow of
Just (Right r) -> C.yield r >> massage
Just (Left err) -> liftIO $ throwIO $ PersistMarshalError err
Nothing -> return ()
process = sqlSelectProcessRow
selectSource :: ( SqlSelect a r
, MonadLogger m
, MonadResourceBase m )
=> SqlQuery a
-> SqlPersist m (C.Source (C.ResourceT (SqlPersist m)) r)
selectSource = rawSelectSource SELECT
select :: ( SqlSelect a r
, MonadLogger m
, MonadResourceBase m )
=> SqlQuery a -> SqlPersist m [r]
select = selectSource >=> runSource
selectDistinctSource
:: ( SqlSelect a r
, MonadLogger m
, MonadResourceBase m )
=> SqlQuery a
-> SqlPersist m (C.Source (C.ResourceT (SqlPersist m)) r)
selectDistinctSource = rawSelectSource SELECT_DISTINCT
selectDistinct :: ( SqlSelect a r
, MonadLogger m
, MonadResourceBase m )
=> SqlQuery a -> SqlPersist m [r]
selectDistinct = selectDistinctSource >=> runSource
runSource :: MonadResourceBase m =>
C.Source (C.ResourceT (SqlPersist m)) r
-> SqlPersist m [r]
runSource src = C.runResourceT $ src C.$$ CL.consume
rawExecute :: ( MonadLogger m
, MonadResourceBase m )
=> Mode
-> SqlQuery ()
-> SqlPersist m Int64
rawExecute mode query = do
conn <- SqlPersist R.ask
uncurry executeCount $
first builderToText $
toRawSql mode conn query
delete :: ( MonadLogger m
, MonadResourceBase m )
=> SqlQuery ()
-> SqlPersist m ()
delete = void . deleteCount
deleteCount :: ( MonadLogger m
, MonadResourceBase m )
=> SqlQuery ()
-> SqlPersist m Int64
deleteCount = rawExecute DELETE
update :: ( MonadLogger m
, MonadResourceBase m
, SqlEntity val )
=> (SqlExpr (Entity val) -> SqlQuery ())
-> SqlPersist m ()
update = void . updateCount
updateCount :: ( MonadLogger m
, MonadResourceBase m
, SqlEntity val )
=> (SqlExpr (Entity val) -> SqlQuery ())
-> SqlPersist m Int64
updateCount = rawExecute UPDATE . from
builderToText :: TLB.Builder -> T.Text
builderToText = TL.toStrict . TLB.toLazyTextWith defaultChunkSize
where
defaultChunkSize = 1024 32
toRawSql :: SqlSelect a r => Mode -> Connection -> SqlQuery a -> (TLB.Builder, [PersistValue])
toRawSql mode conn query =
let (ret, SideData fromClauses setClauses whereClauses groupByClause orderByClauses limitClause) =
flip S.evalState initialIdentState $
W.runWriterT $
unQ query
in mconcat
[ makeSelect conn mode ret
, makeFrom conn mode fromClauses
, makeSet conn setClauses
, makeWhere conn whereClauses
, makeGroupBy conn groupByClause
, makeOrderBy conn orderByClauses
, makeLimit conn limitClause
]
data Mode = SELECT | SELECT_DISTINCT | DELETE | UPDATE
uncommas :: [TLB.Builder] -> TLB.Builder
uncommas = mconcat . intersperse ", "
uncommas' :: Monoid a => [(TLB.Builder, a)] -> (TLB.Builder, a)
uncommas' = (uncommas *** mconcat) . unzip
makeSelect :: SqlSelect a r => Connection -> Mode -> a -> (TLB.Builder, [PersistValue])
makeSelect conn mode ret = first (s <>) (sqlSelectCols conn ret)
where
s = case mode of
SELECT -> "SELECT "
SELECT_DISTINCT -> "SELECT DISTINCT "
DELETE -> "DELETE"
UPDATE -> "UPDATE "
makeFrom :: Connection -> Mode -> [FromClause] -> (TLB.Builder, [PersistValue])
makeFrom _ _ [] = mempty
makeFrom conn mode fs = ret
where
ret = case collectOnClauses fs of
Left expr -> throw $ mkExc expr
Right fs' -> keyword $ uncommas' (map (mk Never mempty) fs')
keyword = case mode of
UPDATE -> id
_ -> first ("\nFROM " <>)
mk _ onClause (FromStart i def) = base i def <> onClause
mk paren onClause (FromJoin lhs kind rhs monClause) =
first (parensM paren) $
mconcat [ mk Parens onClause lhs
, (fromKind kind, mempty)
, mk Never (maybe mempty makeOnClause monClause) rhs
]
mk _ _ (OnClause _) = error "Esqueleto/Sql/makeFrom: never here (is collectOnClauses working?)"
base ident@(I identText) def =
let db@(DBName dbText) = entityDB def
in ( if dbText == identText
then fromDBName conn db
else fromDBName conn db <> (" AS " <> useIdent conn ident)
, mempty )
fromKind InnerJoinKind = " INNER JOIN "
fromKind CrossJoinKind = " CROSS JOIN "
fromKind LeftOuterJoinKind = " LEFT OUTER JOIN "
fromKind RightOuterJoinKind = " RIGHT OUTER JOIN "
fromKind FullOuterJoinKind = " FULL OUTER JOIN "
makeOnClause (ERaw _ f) = first (" ON " <>) (f conn)
mkExc :: SqlExpr (Value Bool) -> OnClauseWithoutMatchingJoinException
mkExc (ERaw _ f) =
OnClauseWithoutMatchingJoinException $
TL.unpack $ TLB.toLazyText $ fst (f conn)
makeSet :: Connection -> [SetClause] -> (TLB.Builder, [PersistValue])
makeSet _ [] = mempty
makeSet conn os = first ("\nSET " <>) $ uncommas' (map mk os)
where
mk (SetClause (ERaw _ f)) = f conn
makeWhere :: Connection -> WhereClause -> (TLB.Builder, [PersistValue])
makeWhere _ NoWhere = mempty
makeWhere conn (Where (ERaw _ f)) = first ("\nWHERE " <>) (f conn)
makeGroupBy :: Connection -> GroupByClause -> (TLB.Builder, [PersistValue])
makeGroupBy _ (GroupBy []) = (mempty, [])
makeGroupBy conn (GroupBy fields) = first ("\nGROUP BY " <>) build
where
build = uncommas' $ map (\(SomeValue (ERaw _ f)) -> f conn) fields
makeOrderBy :: Connection -> [OrderByClause] -> (TLB.Builder, [PersistValue])
makeOrderBy _ [] = mempty
makeOrderBy conn os = first ("\nORDER BY " <>) $ uncommas' (map mk os)
where
mk (EOrderBy t (ERaw p f)) = first ((<> orderByType t) . parensM p) (f conn)
orderByType ASC = " ASC"
orderByType DESC = " DESC"
makeLimit :: Connection -> LimitClause -> (TLB.Builder, [PersistValue])
makeLimit _ (Limit Nothing Nothing) = mempty
makeLimit _ (Limit Nothing (Just 0)) = mempty
makeLimit conn (Limit ml mo) = (ret, mempty)
where
ret = TLB.singleton '\n' <> (limitTLB <> offsetTLB)
limitTLB =
case ml of
Just l -> "LIMIT " <> TLBI.decimal l
Nothing -> TLB.fromText (noLimit conn)
offsetTLB =
case mo of
Just o -> " OFFSET " <> TLBI.decimal o
Nothing -> mempty
parens :: TLB.Builder -> TLB.Builder
parens b = "(" <> (b <> ")")
class SqlSelect a r | a -> r, r -> a where
sqlSelectCols :: Connection -> a -> (TLB.Builder, [PersistValue])
sqlSelectColCount :: a -> Int
sqlSelectProcessRow :: [PersistValue] -> Either T.Text r
instance SqlSelect () () where
sqlSelectCols _ _ = mempty
sqlSelectColCount _ = 0
sqlSelectProcessRow _ = Right ()
instance PersistEntity a => SqlSelect (SqlExpr (Entity a)) (Entity a) where
sqlSelectCols conn expr@(EEntity ident) = ret
where
process ed = uncommas $
map ((name <>) . fromDBName conn) $
(entityID ed:) $
map fieldDB $
entityFields ed
name = useIdent conn ident <> "."
ret = let ed = entityDef $ getEntityVal expr
in (process ed, mempty)
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 PersistEntity a => SqlSelect (SqlExpr (Maybe (Entity a))) (Maybe (Entity a)) where
sqlSelectCols conn (EMaybe ent) = sqlSelectCols conn ent
sqlSelectColCount = sqlSelectColCount . fromEMaybe
where
fromEMaybe :: SqlExpr (Maybe e) -> SqlExpr e
fromEMaybe = error "Esqueleto/Sql/sqlSelectColCount[Maybe Entity]/fromEMaybe"
sqlSelectProcessRow cols
| all (== PersistNull) cols = return Nothing
| otherwise = Just <$> sqlSelectProcessRow cols
instance PersistField a => SqlSelect (SqlExpr (Value a)) (Value a) where
sqlSelectCols esc (ERaw p f) = let (b, vals) = f esc
in (parensM p b, vals)
sqlSelectColCount = const 1
sqlSelectProcessRow [pv] = Value <$> fromPersistValue pv
sqlSelectProcessRow _ = Left "SqlSelect (Value a): wrong number of columns."
instance ( SqlSelect a ra
, SqlSelect b rb
) => SqlSelect (a, b) (ra, rb) where
sqlSelectCols esc (a, b) =
uncommas'
[ 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 = sqlSelectColCount x
processRow row =
let (rowFst, rowSnd) = splitAt colCountFst row
in (,) <$> sqlSelectProcessRow rowFst
<*> sqlSelectProcessRow rowSnd
in colCountFst `seq` processRow
instance ( SqlSelect a ra
, SqlSelect b rb
, SqlSelect c rc
) => SqlSelect (a, b, c) (ra, rb, rc) where
sqlSelectCols esc (a, b, c) =
uncommas'
[ sqlSelectCols esc a
, 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)
instance ( SqlSelect a ra
, SqlSelect b rb
, SqlSelect c rc
, SqlSelect d rd
) => SqlSelect (a, b, c, d) (ra, rb, rc, rd) where
sqlSelectCols esc (a, b, c, d) =
uncommas'
[ sqlSelectCols esc a
, sqlSelectCols esc b
, 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)
instance ( SqlSelect a ra
, SqlSelect b rb
, SqlSelect c rc
, SqlSelect d rd
, SqlSelect e re
) => SqlSelect (a, b, c, d, e) (ra, rb, rc, rd, re) where
sqlSelectCols esc (a, b, c, d, e) =
uncommas'
[ sqlSelectCols esc a
, sqlSelectCols esc b
, sqlSelectCols esc c
, 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)
instance ( SqlSelect a ra
, SqlSelect b rb
, SqlSelect c rc
, SqlSelect d rd
, SqlSelect e re
, SqlSelect f rf
) => SqlSelect (a, b, c, d, e, f) (ra, rb, rc, rd, re, rf) where
sqlSelectCols esc (a, b, c, d, e, f) =
uncommas'
[ sqlSelectCols esc a
, sqlSelectCols esc b
, sqlSelectCols esc c
, sqlSelectCols esc d
, 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)
instance ( SqlSelect a ra
, SqlSelect b rb
, SqlSelect c rc
, SqlSelect d rd
, SqlSelect e re
, SqlSelect f rf
, SqlSelect g rg
) => SqlSelect (a, b, c, d, e, f, g) (ra, rb, rc, rd, re, rf, rg) where
sqlSelectCols esc (a, b, c, d, e, f, g) =
uncommas'
[ sqlSelectCols esc a
, sqlSelectCols esc b
, sqlSelectCols esc c
, sqlSelectCols esc d
, sqlSelectCols esc e
, 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)
instance ( SqlSelect a ra
, SqlSelect b rb
, SqlSelect c rc
, SqlSelect d rd
, SqlSelect e re
, SqlSelect f rf
, SqlSelect g rg
, SqlSelect h rh
) => SqlSelect (a, b, c, d, e, f, g, h) (ra, rb, rc, rd, re, rf, rg, rh) where
sqlSelectCols esc (a, b, c, d, e, f, g, h) =
uncommas'
[ sqlSelectCols esc a
, sqlSelectCols esc b
, sqlSelectCols esc c
, sqlSelectCols esc d
, sqlSelectCols esc e
, sqlSelectCols esc f
, 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)
instance ( SqlSelect a ra
, SqlSelect b rb
, SqlSelect c rc
, SqlSelect d rd
, SqlSelect e re
, SqlSelect f rf
, SqlSelect g rg
, SqlSelect h rh
, SqlSelect i ri
) => SqlSelect (a, b, c, d, e, f, g, h, i) (ra, rb, rc, rd, re, rf, rg, rh, ri) where
sqlSelectCols esc (a, b, c, d, e, f, g, h, i) =
uncommas'
[ sqlSelectCols esc a
, sqlSelectCols esc b
, sqlSelectCols esc c
, sqlSelectCols esc d
, sqlSelectCols esc e
, sqlSelectCols esc f
, sqlSelectCols esc g
, sqlSelectCols esc h
, sqlSelectCols esc i
]
sqlSelectColCount = sqlSelectColCount . from9
sqlSelectProcessRow = fmap to9 . sqlSelectProcessRow
from9 :: (a,b,c,d,e,f,g,h,i) -> ((a,b),(c,d),(e,f),(g,h),i)
from9 (a,b,c,d,e,f,g,h,i) = ((a,b),(c,d),(e,f),(g,h),i)
to9 :: ((a,b),(c,d),(e,f),(g,h),i) -> (a,b,c,d,e,f,g,h,i)
to9 ((a,b),(c,d),(e,f),(g,h),i) = (a,b,c,d,e,f,g,h,i)
instance ( SqlSelect a ra
, SqlSelect b rb
, SqlSelect c rc
, SqlSelect d rd
, SqlSelect e re
, SqlSelect f rf
, SqlSelect g rg
, SqlSelect h rh
, SqlSelect i ri
, SqlSelect j rj
) => SqlSelect (a, b, c, d, e, f, g, h, i, j) (ra, rb, rc, rd, re, rf, rg, rh, ri, rj) where
sqlSelectCols esc (a, b, c, d, e, f, g, h, i, j) =
uncommas'
[ sqlSelectCols esc a
, sqlSelectCols esc b
, sqlSelectCols esc c
, sqlSelectCols esc d
, sqlSelectCols esc e
, sqlSelectCols esc f
, sqlSelectCols esc g
, sqlSelectCols esc h
, sqlSelectCols esc i
, sqlSelectCols esc j
]
sqlSelectColCount = sqlSelectColCount . from10
sqlSelectProcessRow = fmap to10 . sqlSelectProcessRow
from10 :: (a,b,c,d,e,f,g,h,i,j) -> ((a,b),(c,d),(e,f),(g,h),(i,j))
from10 (a,b,c,d,e,f,g,h,i,j) = ((a,b),(c,d),(e,f),(g,h),(i,j))
to10 :: ((a,b),(c,d),(e,f),(g,h),(i,j)) -> (a,b,c,d,e,f,g,h,i,j)
to10 ((a,b),(c,d),(e,f),(g,h),(i,j)) = (a,b,c,d,e,f,g,h,i,j)
instance ( SqlSelect a ra
, SqlSelect b rb
, SqlSelect c rc
, SqlSelect d rd
, SqlSelect e re
, SqlSelect f rf
, SqlSelect g rg
, SqlSelect h rh
, SqlSelect i ri
, SqlSelect j rj
, SqlSelect k rk
) => SqlSelect (a, b, c, d, e, f, g, h, i, j, k) (ra, rb, rc, rd, re, rf, rg, rh, ri, rj, rk) where
sqlSelectCols esc (a, b, c, d, e, f, g, h, i, j, k) =
uncommas'
[ sqlSelectCols esc a
, sqlSelectCols esc b
, sqlSelectCols esc c
, sqlSelectCols esc d
, sqlSelectCols esc e
, sqlSelectCols esc f
, sqlSelectCols esc g
, sqlSelectCols esc h
, sqlSelectCols esc i
, sqlSelectCols esc j
, sqlSelectCols esc k
]
sqlSelectColCount = sqlSelectColCount . from11
sqlSelectProcessRow = fmap to11 . sqlSelectProcessRow
from11 :: (a,b,c,d,e,f,g,h,i,j,k) -> ((a,b),(c,d),(e,f),(g,h),(i,j),k)
from11 (a,b,c,d,e,f,g,h,i,j,k) = ((a,b),(c,d),(e,f),(g,h),(i,j),k)
to11 :: ((a,b),(c,d),(e,f),(g,h),(i,j),k) -> (a,b,c,d,e,f,g,h,i,j,k)
to11 ((a,b),(c,d),(e,f),(g,h),(i,j),k) = (a,b,c,d,e,f,g,h,i,j,k)
instance ( SqlSelect a ra
, SqlSelect b rb
, SqlSelect c rc
, SqlSelect d rd
, SqlSelect e re
, SqlSelect f rf
, SqlSelect g rg
, SqlSelect h rh
, SqlSelect i ri
, SqlSelect j rj
, SqlSelect k rk
, SqlSelect l rl
) => SqlSelect (a, b, c, d, e, f, g, h, i, j, k, l) (ra, rb, rc, rd, re, rf, rg, rh, ri, rj, rk, rl) where
sqlSelectCols esc (a, b, c, d, e, f, g, h, i, j, k, l) =
uncommas'
[ sqlSelectCols esc a
, sqlSelectCols esc b
, sqlSelectCols esc c
, sqlSelectCols esc d
, sqlSelectCols esc e
, sqlSelectCols esc f
, sqlSelectCols esc g
, sqlSelectCols esc h
, sqlSelectCols esc i
, sqlSelectCols esc j
, sqlSelectCols esc k
, sqlSelectCols esc l
]
sqlSelectColCount = sqlSelectColCount . from12
sqlSelectProcessRow = fmap to12 . sqlSelectProcessRow
from12 :: (a,b,c,d,e,f,g,h,i,j,k,l) -> ((a,b),(c,d),(e,f),(g,h),(i,j),(k,l))
from12 (a,b,c,d,e,f,g,h,i,j,k,l) = ((a,b),(c,d),(e,f),(g,h),(i,j),(k,l))
to12 :: ((a,b),(c,d),(e,f),(g,h),(i,j),(k,l)) -> (a,b,c,d,e,f,g,h,i,j,k,l)
to12 ((a,b),(c,d),(e,f),(g,h),(i,j),(k,l)) = (a,b,c,d,e,f,g,h,i,j,k,l)
instance ( SqlSelect a ra
, SqlSelect b rb
, SqlSelect c rc
, SqlSelect d rd
, SqlSelect e re
, SqlSelect f rf
, SqlSelect g rg
, SqlSelect h rh
, SqlSelect i ri
, SqlSelect j rj
, SqlSelect k rk
, SqlSelect l rl
, SqlSelect m rm
) => SqlSelect (a, b, c, d, e, f, g, h, i, j, k, l, m) (ra, rb, rc, rd, re, rf, rg, rh, ri, rj, rk, rl, rm) where
sqlSelectCols esc (a, b, c, d, e, f, g, h, i, j, k, l, m) =
uncommas'
[ sqlSelectCols esc a
, sqlSelectCols esc b
, sqlSelectCols esc c
, sqlSelectCols esc d
, sqlSelectCols esc e
, sqlSelectCols esc f
, sqlSelectCols esc g
, sqlSelectCols esc h
, sqlSelectCols esc i
, sqlSelectCols esc j
, sqlSelectCols esc k
, sqlSelectCols esc l
, sqlSelectCols esc m
]
sqlSelectColCount = sqlSelectColCount . from13
sqlSelectProcessRow = fmap to13 . sqlSelectProcessRow
from13 :: (a,b,c,d,e,f,g,h,i,j,k,l,m) -> ((a,b),(c,d),(e,f),(g,h),(i,j),(k,l),m)
from13 (a,b,c,d,e,f,g,h,i,j,k,l,m) = ((a,b),(c,d),(e,f),(g,h),(i,j),(k,l),m)
to13 :: ((a,b),(c,d),(e,f),(g,h),(i,j),(k,l),m) -> (a,b,c,d,e,f,g,h,i,j,k,l,m)
to13 ((a,b),(c,d),(e,f),(g,h),(i,j),(k,l),m) = (a,b,c,d,e,f,g,h,i,j,k,l,m)
instance ( SqlSelect a ra
, SqlSelect b rb
, SqlSelect c rc
, SqlSelect d rd
, SqlSelect e re
, SqlSelect f rf
, SqlSelect g rg
, SqlSelect h rh
, SqlSelect i ri
, SqlSelect j rj
, SqlSelect k rk
, SqlSelect l rl
, SqlSelect m rm
, SqlSelect n rn
) => SqlSelect (a, b, c, d, e, f, g, h, i, j, k, l, m, n) (ra, rb, rc, rd, re, rf, rg, rh, ri, rj, rk, rl, rm, rn) where
sqlSelectCols esc (a, b, c, d, e, f, g, h, i, j, k, l, m, n) =
uncommas'
[ sqlSelectCols esc a
, sqlSelectCols esc b
, sqlSelectCols esc c
, sqlSelectCols esc d
, sqlSelectCols esc e
, sqlSelectCols esc f
, sqlSelectCols esc g
, sqlSelectCols esc h
, sqlSelectCols esc i
, sqlSelectCols esc j
, sqlSelectCols esc k
, sqlSelectCols esc l
, sqlSelectCols esc m
, sqlSelectCols esc n
]
sqlSelectColCount = sqlSelectColCount . from14
sqlSelectProcessRow = fmap to14 . sqlSelectProcessRow
from14 :: (a,b,c,d,e,f,g,h,i,j,k,l,m,n) -> ((a,b),(c,d),(e,f),(g,h),(i,j),(k,l),(m,n))
from14 (a,b,c,d,e,f,g,h,i,j,k,l,m,n) = ((a,b),(c,d),(e,f),(g,h),(i,j),(k,l),(m,n))
to14 :: ((a,b),(c,d),(e,f),(g,h),(i,j),(k,l),(m,n)) -> (a,b,c,d,e,f,g,h,i,j,k,l,m,n)
to14 ((a,b),(c,d),(e,f),(g,h),(i,j),(k,l),(m,n)) = (a,b,c,d,e,f,g,h,i,j,k,l,m,n)
instance ( SqlSelect a ra
, SqlSelect b rb
, SqlSelect c rc
, SqlSelect d rd
, SqlSelect e re
, SqlSelect f rf
, SqlSelect g rg
, SqlSelect h rh
, SqlSelect i ri
, SqlSelect j rj
, SqlSelect k rk
, SqlSelect l rl
, SqlSelect m rm
, SqlSelect n rn
, SqlSelect o ro
) => SqlSelect (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) (ra, rb, rc, rd, re, rf, rg, rh, ri, rj, rk, rl, rm, rn, ro) where
sqlSelectCols esc (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) =
uncommas'
[ sqlSelectCols esc a
, sqlSelectCols esc b
, sqlSelectCols esc c
, sqlSelectCols esc d
, sqlSelectCols esc e
, sqlSelectCols esc f
, sqlSelectCols esc g
, sqlSelectCols esc h
, sqlSelectCols esc i
, sqlSelectCols esc j
, sqlSelectCols esc k
, sqlSelectCols esc l
, sqlSelectCols esc m
, sqlSelectCols esc n
, sqlSelectCols esc o
]
sqlSelectColCount = sqlSelectColCount . from15
sqlSelectProcessRow = fmap to15 . sqlSelectProcessRow
from15 :: (a,b,c,d,e,f,g,h,i,j,k,l,m,n, o) -> ((a,b),(c,d),(e,f),(g,h),(i,j),(k,l),(m,n),o)
from15 (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) = ((a,b),(c,d),(e,f),(g,h),(i,j),(k,l),(m,n),o)
to15 :: ((a,b),(c,d),(e,f),(g,h),(i,j),(k,l),(m,n),o) -> (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o)
to15 ((a,b),(c,d),(e,f),(g,h),(i,j),(k,l),(m,n),o) = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o)
instance ( SqlSelect a ra
, SqlSelect b rb
, SqlSelect c rc
, SqlSelect d rd
, SqlSelect e re
, SqlSelect f rf
, SqlSelect g rg
, SqlSelect h rh
, SqlSelect i ri
, SqlSelect j rj
, SqlSelect k rk
, SqlSelect l rl
, SqlSelect m rm
, SqlSelect n rn
, SqlSelect o ro
, SqlSelect p rp
) => SqlSelect (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p) (ra, rb, rc, rd, re, rf, rg, rh, ri, rj, rk, rl, rm, rn, ro, rp) where
sqlSelectCols esc (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p) =
uncommas'
[ sqlSelectCols esc a
, sqlSelectCols esc b
, sqlSelectCols esc c
, sqlSelectCols esc d
, sqlSelectCols esc e
, sqlSelectCols esc f
, sqlSelectCols esc g
, sqlSelectCols esc h
, sqlSelectCols esc i
, sqlSelectCols esc j
, sqlSelectCols esc k
, sqlSelectCols esc l
, sqlSelectCols esc m
, sqlSelectCols esc n
, sqlSelectCols esc o
, sqlSelectCols esc p
]
sqlSelectColCount = sqlSelectColCount . from16
sqlSelectProcessRow = fmap to16 . sqlSelectProcessRow
from16 :: (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))
from16 (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)
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)