{-# LANGUAGE ScopedTypeVariables #-}
module Database.Selda.Unsafe
( fun, fun2, fun0, operator
, aggr
, cast, castAggr, sink, sink2
, unsafeSelector
, QueryFragment, inj, injLit, rawName, rawExp, rawStm, rawQuery, rawQuery1
) where
import Control.Exception (throw)
import Control.Monad.State.Strict
( MonadIO(liftIO), void, MonadState(put, get) )
import Database.Selda.Backend.Internal
( SqlType(mkLit, sqlType),
MonadSelda,
SeldaBackend(runStmt, ppConfig),
SeldaError(UnsafeError),
withBackend )
import Database.Selda.Column
( BinOp(CustomOp),
UnOp(Fun),
NulOp(Fun0),
Exp(Col, Cast, UnOp, Fun2, BinOp, NulOp, Lit, Raw),
UntypedCol(Untyped),
SomeCol(Named),
hideRenaming,
Same(liftC2),
Row(..),
Col(..),
liftC )
import Database.Selda.Inner (Inner, Aggr, aggr, liftAggr)
import Database.Selda.Selectors (unsafeSelector)
import Database.Selda.Query.Type (Query (..), sources, renameAll, rename)
import Database.Selda.SQL (QueryFragment (..), SqlSource (RawSql), sqlFrom)
import Database.Selda.SQL.Print (compRaw)
import Database.Selda.SqlRow (SqlRow (..))
import Database.Selda.Types (ColName)
import Data.Text (Text)
import Data.Proxy ( Proxy(..) )
import Unsafe.Coerce ( unsafeCoerce )
cast :: forall s a b. SqlType b => Col s a -> Col s b
cast :: forall s a b. SqlType b => Col s a -> Col s b
cast = forall {k} a b (s :: k).
(Exp SQL a -> Exp SQL b) -> Col s a -> Col s b
liftC forall a b. (a -> b) -> a -> b
$ forall sql a b. SqlTypeRep -> Exp sql a -> Exp sql b
Cast (forall a. SqlType a => Proxy a -> SqlTypeRep
sqlType (forall {k} (t :: k). Proxy t
Proxy :: Proxy b))
castAggr :: forall s a b. SqlType b => Aggr s a -> Aggr s b
castAggr :: forall s a b. SqlType b => Aggr s a -> Aggr s b
castAggr = forall s a b. (Col s a -> Col s b) -> Aggr s a -> Aggr s b
liftAggr forall s a b. SqlType b => Col s a -> Col s b
cast
sink :: (f s a -> f s b) -> f (Inner s) a -> f (Inner s) b
sink :: forall (f :: * -> * -> *) s a b.
(f s a -> f s b) -> f (Inner s) a -> f (Inner s) b
sink = forall a b. a -> b
unsafeCoerce
sink2 :: (f s a -> f s b -> f s c) -> f (Inner s) a -> f (Inner s) b -> f (Inner s) c
sink2 :: forall (f :: * -> * -> *) s a b c.
(f s a -> f s b -> f s c)
-> f (Inner s) a -> f (Inner s) b -> f (Inner s) c
sink2 = forall a b. a -> b
unsafeCoerce
fun :: Text -> Col s a -> Col s b
fun :: forall s a b. Text -> Col s a -> Col s b
fun = forall {k} a b (s :: k).
(Exp SQL a -> Exp SQL b) -> Col s a -> Col s b
liftC forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b sql. UnOp a b -> Exp sql a -> Exp sql b
UnOp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Text -> UnOp a b
Fun
fun2 :: Text -> Col s a -> Col s b -> Col s c
fun2 :: forall s a b c. Text -> Col s a -> Col s b -> Col s c
fun2 = forall {k} (s :: k) (t :: k) a b c.
Same s t =>
(Exp SQL a -> Exp SQL b -> Exp SQL c)
-> Col s a -> Col t b -> Col s c
liftC2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sql a b c. Text -> Exp sql a -> Exp sql b -> Exp sql c
Fun2
operator :: Text -> Col s a -> Col s b -> Col s c
operator :: forall s a b c. Text -> Col s a -> Col s b -> Col s c
operator = forall {k} (s :: k) (t :: k) a b c.
Same s t =>
(Exp SQL a -> Exp SQL b -> Exp SQL c)
-> Col s a -> Col t b -> Col s c
liftC2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c sql.
BinOp a b c -> Exp sql a -> Exp sql b -> Exp sql c
BinOp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. Text -> BinOp a b c
CustomOp
fun0 :: Text -> Col s a
fun0 :: forall s a. Text -> Col s a
fun0 = forall {k} (s :: k) a. Exp SQL a -> Col s a
One forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a sql. NulOp a -> Exp sql a
NulOp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Text -> NulOp a
Fun0
inj :: Col s a -> QueryFragment
inj :: forall s a. Col s a -> QueryFragment
inj (One Exp SQL a
x) = forall a. Exp SQL a -> QueryFragment
RawExp Exp SQL a
x
injLit :: SqlType a => a -> QueryFragment
injLit :: forall a. SqlType a => a -> QueryFragment
injLit = forall a. Exp SQL a -> QueryFragment
RawExp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a sql. Lit a -> Exp sql a
Lit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. SqlType a => a -> Lit a
mkLit
rawName :: SqlType a => ColName -> Col s a
rawName :: forall a s. SqlType a => ColName -> Col s a
rawName = forall {k} (s :: k) a. Exp SQL a -> Col s a
One forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sql a. ColName -> Exp sql a
Col
rawExp :: SqlType a => Text -> Col s a
rawExp :: forall a s. SqlType a => Text -> Col s a
rawExp = forall {k} (s :: k) a. Exp SQL a -> Col s a
One forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sql a. Text -> Exp sql a
Raw
rawStm :: MonadSelda m => QueryFragment -> m ()
rawStm :: forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
rawStm QueryFragment
q = forall (m :: * -> *) a.
MonadSelda m =>
(SeldaBackend (Backend m) -> m a) -> m a
withBackend forall a b. (a -> b) -> a -> b
$ \SeldaBackend (Backend m)
b -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall b.
SeldaBackend b -> Text -> [Param] -> IO (Int, [[SqlValue]])
runStmt SeldaBackend (Backend m)
b) forall a b. (a -> b) -> a -> b
$ PPConfig -> QueryFragment -> (Text, [Param])
compRaw (forall b. SeldaBackend b -> PPConfig
ppConfig SeldaBackend (Backend m)
b) QueryFragment
q
rawQuery :: forall a s. SqlRow a => [ColName] -> QueryFragment -> Query s (Row s a)
rawQuery :: forall a s.
SqlRow a =>
[ColName] -> QueryFragment -> Query s (Row s a)
rawQuery [ColName]
names QueryFragment
q
| forall (t :: * -> *) a. Foldable t => t a -> Int
length [ColName]
names forall a. Eq a => a -> a -> Bool
/= forall a. SqlRow a => Proxy a -> Int
nestedCols (forall {k} (t :: k). Proxy t
Proxy :: Proxy a) = do
let err :: [Char]
err = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [Char]
"rawQuery: return type has ", forall a. Show a => a -> [Char]
show (forall a. SqlRow a => Proxy a -> Int
nestedCols (forall {k} (t :: k). Proxy t
Proxy :: Proxy a))
, [Char]
" columns, but only ", forall a. Show a => a -> [Char]
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [ColName]
names), [Char]
" names were given"
]
forall a e. Exception e => e -> a
throw ([Char] -> SeldaError
UnsafeError [Char]
err)
| Bool
otherwise = forall s a. State GenState a -> Query s a
Query forall a b. (a -> b) -> a -> b
$ do
[SomeCol SQL]
rns <- forall sql. [UntypedCol sql] -> State GenState [SomeCol sql]
renameAll [forall sql a. Exp sql a -> UntypedCol sql
Untyped (forall sql a. ColName -> Exp sql a
Col ColName
name) | ColName
name <- [ColName]
names]
GenState
st <- forall s (m :: * -> *). MonadState s m => m s
get
forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ GenState
st { sources :: [SQL]
sources = [SomeCol SQL] -> SqlSource -> SQL
sqlFrom [SomeCol SQL]
rns (QueryFragment -> SqlSource
RawSql QueryFragment
q) forall a. a -> [a] -> [a]
: GenState -> [SQL]
sources GenState
st }
forall (m :: * -> *) a. Monad m => a -> m a
return (forall {k} {k} (s :: k) (a :: k). [UntypedCol SQL] -> Row s a
Many (forall a b. (a -> b) -> [a] -> [b]
map forall sql. SomeCol sql -> UntypedCol sql
hideRenaming [SomeCol SQL]
rns))
rawQuery1 :: SqlType a => ColName -> QueryFragment -> Query s (Col s a)
rawQuery1 :: forall a s.
SqlType a =>
ColName -> QueryFragment -> Query s (Col s a)
rawQuery1 ColName
name QueryFragment
q = forall s a. State GenState a -> Query s a
Query forall a b. (a -> b) -> a -> b
$ do
SomeCol SQL
name' <- forall a. [a] -> a
head forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall sql. UntypedCol sql -> State GenState [SomeCol sql]
rename (forall sql a. Exp sql a -> UntypedCol sql
Untyped (forall sql a. ColName -> Exp sql a
Col ColName
name))
GenState
st <- forall s (m :: * -> *). MonadState s m => m s
get
forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ GenState
st { sources :: [SQL]
sources = [SomeCol SQL] -> SqlSource -> SQL
sqlFrom [SomeCol SQL
name'] (QueryFragment -> SqlSource
RawSql QueryFragment
q) forall a. a -> [a] -> [a]
: GenState -> [SQL]
sources GenState
st }
case SomeCol SQL
name' of
Named ColName
n Exp SQL a
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall {k} (s :: k) a. Exp SQL a -> Col s a
One (forall sql a. ColName -> Exp sql a
Col ColName
n))
SomeCol SQL
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"BUG: renaming did not rename"