{-# LANGUAGE ScopedTypeVariables #-}
-- | Unsafe operations giving the user unchecked low-level control over
--   the generated SQL.
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 a column to another type, using whichever coercion semantics are used
--   by the underlying SQL implementation.
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))

-- | Cast an aggregate to another type, using whichever coercion semantics
--   are used by the underlying SQL implementation.
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 the given function into an inner scope.
--
--   Be careful not to use this function with functions capturing rows or columns
--   from an outer scope. For instance, the following usage will likely
--   lead to disaster:
--
-- > query $ do
-- >   x <- #age `from` select person
-- >   inner $ sink (\p -> x + (p ! #age)) <$> select person
--
--   Really, if you have to use this function, ONLY do so in the global scope.
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

-- | Like 'sink', but with two arguments.
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

-- | A unary operation. Note that the provided function name is spliced
--   directly into the resulting SQL query. Thus, this function should ONLY
--   be used to implement well-defined functions that are missing from Selda's
--   standard library, and NOT in an ad hoc manner during queries.
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

-- | Like 'fun', but with two arguments.
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

-- | A custom operator. @operator "~>" a b@ will compile down to
--   @a ~> b@, with parentheses around @a@ and @b@ iff they are not atomic.
--   This means that SQL operator precedence is disregarded, as all
--   subexpressions are parenthesized. In the following example for instance,
--   @foo a b c@ will compile down to @(a ~> b) ~> c@.
--
-- > (~>) = operator "~>"
-- > infixl 5 ~>
-- > foo a b c = a ~> b ~> c
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

-- | Like 'fun', but with zero arguments.
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

-- | Create a raw SQL query fragment from the given column.
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

-- | Create a raw SQL query fragment from the given value.
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

-- | Create a column referring to a name of your choice.
--   Use this to refer to variables not exposed by Selda.
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

-- | Create an expression from the given text.
--   The expression will be inserted verbatim into your query, so you should
--   NEVER pass user-provided text to this function.
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

-- | Execute a raw SQL statement.
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

-- | Execute a raw SQL statement, returning a row consisting of columns by the
--   given names.
--   Will fail if the number of names given does not match up with
--   the type of the returned row.
--   Will generate invalid SQL if the given names don't match up with the
--   column names in the given query.
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))

-- | As 'rawQuery', but returns only a single column. Same warnings still apply.
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"