{-# LANGUAGE GADTs, TypeOperators, TypeFamilies, ScopedTypeVariables #-}
{-# LANGUAGE FlexibleInstances, FlexibleContexts, UndecidableInstances #-}
{-# LANGUAGE ConstraintKinds #-}
-- | Selda SQL compilation.
module Database.Selda.Compile
  ( Result, Res
  , buildResult, compQuery, compQueryWithFreshScope
  , compile, compileWith
  , compileInsert, compileUpdate, compileDelete
  )
  where
import Control.Monad (liftM2)
import Database.Selda.Column
    ( UntypedCol(Untyped),
      SomeCol(Some),
      Row(..),
      Col(..),
      Columns(toTup) )
import Database.Selda.Generic ( Relational, params )
import Database.Selda.Query.Type
    ( GenState(nameSupply), Query, Scope, runQueryM )
import Database.Selda.SQL ( Param, SQL(SQL), SqlSource(Product) )
import Database.Selda.SQL.Print ( compSql, compUpdate, compDelete )
import Database.Selda.SQL.Print.Config
    ( PPConfig(ppMaxInsertParams), defPPConfig )
import Database.Selda.SqlRow
    ( SqlRow(nextResult), ResultReader, runResultReader, next )
import Database.Selda.SqlType ( SqlValue, SqlType(fromSql) )
import Database.Selda.Table
    ( ColInfo(colName), Table(tableCols, tableName), tableExpr )
import Database.Selda.Table.Compile ( compInsert )
import Database.Selda.Transform
    ( removeDeadCols, implicitlyLiveCols, colNames, state2sql )
import Database.Selda.Types ( type (:*:)(..) )
import Data.Proxy ( Proxy(..) )
import Data.Text (Text, empty)
import Data.Typeable (Typeable)

-- For scope supply
import Data.IORef ( IORef, atomicModifyIORef', newIORef )
import System.IO.Unsafe ( unsafePerformIO )

-- | Compile a query into a parameterised SQL statement.
--
--   The types given are tailored for SQLite. To translate SQLite types into
--   whichever types are used by your backend, use 'compileWith'.
compile :: Result a => Query s a -> (Text, [Param])
compile :: forall a s. Result a => Query s a -> (Text, [Param])
compile = forall a s. Result a => PPConfig -> Query s a -> (Text, [Param])
compileWith PPConfig
defPPConfig

-- | Compile a query using the given type translation function.
compileWith :: Result a => PPConfig -> Query s a -> (Text, [Param])
compileWith :: forall a s. Result a => PPConfig -> Query s a -> (Text, [Param])
compileWith PPConfig
cfg = PPConfig -> SQL -> (Text, [Param])
compSql PPConfig
cfg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a s. Result a => Scope -> Query s a -> (Scope, SQL)
compQuery Scope
0

-- | Compile an @INSERT@ query, given the keyword representing default values
--   in the target SQL dialect, a table and a list of items corresponding
--   to the table.
compileInsert :: Relational a => PPConfig -> Table a -> [a] -> [(Text, [Param])]
compileInsert :: forall a.
Relational a =>
PPConfig -> Table a -> [a] -> [(Text, [Param])]
compileInsert PPConfig
_ Table a
_ [] =
  [(Text
empty, [])]
compileInsert PPConfig
cfg Table a
tbl [a]
rows =
    case PPConfig -> Maybe Scope
ppMaxInsertParams PPConfig
cfg of
      Maybe Scope
Nothing -> [forall a.
PPConfig -> Table a -> [[Either Param Param]] -> (Text, [Param])
compInsert PPConfig
cfg Table a
tbl [[Either Param Param]]
rows']
      Just Scope
n  -> forall a b. (a -> b) -> [a] -> [b]
map (forall a.
PPConfig -> Table a -> [[Either Param Param]] -> (Text, [Param])
compInsert PPConfig
cfg Table a
tbl) (forall {a}. Scope -> [a] -> [[a]]
chunk (Scope
n forall a. Integral a => a -> a -> a
`div` Scope
rowlen) [[Either Param Param]]
rows')
  where
    rows' :: [[Either Param Param]]
rows' = forall a b. (a -> b) -> [a] -> [b]
map forall a. Relational a => a -> [Either Param Param]
params [a]
rows
    rowlen :: Scope
rowlen = forall (t :: * -> *) a. Foldable t => t a -> Scope
length (forall a. [a] -> a
head [[Either Param Param]]
rows')
    chunk :: Scope -> [a] -> [[a]]
chunk Scope
chunksize [a]
xs =
      case forall a. Scope -> [a] -> ([a], [a])
splitAt Scope
chunksize [a]
xs of
        ([], []) -> []
        ([a]
x, [])  -> [[a]
x]
        ([a]
x, [a]
xs') -> [a]
x forall a. a -> [a] -> [a]
: Scope -> [a] -> [[a]]
chunk Scope
chunksize [a]
xs'

-- | Compile an @UPDATE@ query.
compileUpdate :: forall s a. (Relational a, SqlRow a)
              => PPConfig
              -> Table a                 -- ^ Table to update.
              -> (Row s a -> Row s a)    -- ^ Update function.
              -> (Row s a -> Col s Bool) -- ^ Predicate.
              -> (Text, [Param])
compileUpdate :: forall s a.
(Relational a, SqlRow a) =>
PPConfig
-> Table a
-> (Row s a -> Row s a)
-> (Row s a -> Col s Bool)
-> (Text, [Param])
compileUpdate PPConfig
cfg Table a
tbl Row s a -> Row s a
upd Row s a -> Col s Bool
check =
    PPConfig
-> TableName
-> Exp SQL Bool
-> [(ColName, SomeCol SQL)]
-> (Text, [Param])
compUpdate PPConfig
cfg (forall a. Table a -> TableName
tableName Table a
tbl) Exp SQL Bool
predicate [(ColName, SomeCol SQL)]
updated
  where
    names :: [ColName]
names = forall a b. (a -> b) -> [a] -> [b]
map ColInfo -> ColName
colName (forall a. Table a -> [ColInfo]
tableCols Table a
tbl)
    cs :: Row s a
cs = forall a s. Table a -> Row s a
tableExpr Table a
tbl
    updated :: [(ColName, SomeCol SQL)]
updated = forall a b. [a] -> [b] -> [(a, b)]
zip [ColName]
names (forall r. Result r => r -> [SomeCol SQL]
finalCols (Row s a -> Row s a
upd Row s a
cs))
    One Exp SQL Bool
predicate = Row s a -> Col s Bool
check Row s a
cs

-- | Compile a @DELETE FROM@ query.
compileDelete :: Relational a
              => PPConfig
              -> Table a
              -> (Row s a -> Col s Bool)
              -> (Text, [Param])
compileDelete :: forall a s.
Relational a =>
PPConfig -> Table a -> (Row s a -> Col s Bool) -> (Text, [Param])
compileDelete PPConfig
cfg Table a
tbl Row s a -> Col s Bool
check = PPConfig -> TableName -> Exp SQL Bool -> (Text, [Param])
compDelete PPConfig
cfg (forall a. Table a -> TableName
tableName Table a
tbl) Exp SQL Bool
predicate
  where One Exp SQL Bool
predicate = Row s a -> Col s Bool
check forall a b. (a -> b) -> a -> b
$ forall a. Columns a => [ColName] -> a
toTup forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ColInfo -> ColName
colName forall a b. (a -> b) -> a -> b
$ forall a. Table a -> [ColInfo]
tableCols Table a
tbl

-- | Compile a query to an SQL AST.
--   Groups are ignored, as they are only used by 'aggregate'.
compQuery :: Result a => Scope -> Query s a -> (Int, SQL)
compQuery :: forall a s. Result a => Scope -> Query s a -> (Scope, SQL)
compQuery Scope
ns Query s a
q =
    (GenState -> Scope
nameSupply GenState
st, [SomeCol SQL]
-> SqlSource
-> [Exp SQL Bool]
-> [SomeCol SQL]
-> [(Order, SomeCol SQL)]
-> Maybe (Scope, Scope)
-> [SomeCol SQL]
-> Bool
-> SQL
SQL [SomeCol SQL]
final ([SQL] -> SqlSource
Product [SQL
srcs]) [] [] [] forall a. Maybe a
Nothing [] Bool
False)
  where
    (a
cs, GenState
st) = forall s a. Scope -> Query s a -> (a, GenState)
runQueryM Scope
ns Query s a
q
    final :: [SomeCol SQL]
final = forall r. Result r => r -> [SomeCol SQL]
finalCols a
cs
    sql :: SQL
sql = GenState -> SQL
state2sql GenState
st
    live :: [ColName]
live = [SomeCol SQL] -> [ColName]
colNames [SomeCol SQL]
final forall a. [a] -> [a] -> [a]
++ SQL -> [ColName]
implicitlyLiveCols SQL
sql
    srcs :: SQL
srcs = [ColName] -> SQL -> SQL
removeDeadCols [ColName]
live SQL
sql

{-# NOINLINE scopeSupply #-}
scopeSupply :: IORef Scope
scopeSupply :: IORef Scope
scopeSupply = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef Scope
1

-- | Get a fresh scope from the global scope supply, then use it to compile
--   the given query.
compQueryWithFreshScope :: Result a => Query s a -> (Int, SQL)
compQueryWithFreshScope :: forall a s. Result a => Query s a -> (Scope, SQL)
compQueryWithFreshScope Query s a
q = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
  Scope
s <- forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef Scope
scopeSupply (\Scope
s -> (Scope
sforall a. Num a => a -> a -> a
+Scope
1, Scope
s))
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a s. Result a => Scope -> Query s a -> (Scope, SQL)
compQuery Scope
s Query s a
q

buildResult :: Result r => Proxy r -> [SqlValue] -> Res r
buildResult :: forall r. Result r => Proxy r -> [SqlValue] -> Res r
buildResult Proxy r
p = forall a. ResultReader a -> [SqlValue] -> a
runResultReader (forall r. Result r => Proxy r -> ResultReader (Res r)
toRes Proxy r
p)

type family Res r where
  Res (Col s a :*: b) = a :*: Res b
  Res (Row s a :*: b) = a :*: Res b
  Res (Col s a)       = a
  Res (Row s a)       = a

-- | An acceptable query result type; one or more columns stitched together
--   with @:*:@.
class Typeable (Res r) => Result r where
  -- | Converts the given list of @SqlValue@s into an tuple of well-typed
  --   results.
  --   See 'querySQLite' for example usage.
  toRes :: Proxy r -> ResultReader (Res r)

  -- | Produce a list of all columns present in the result.
  finalCols :: r -> [SomeCol SQL]

instance (SqlType a, Result b) => Result (Col s a :*: b) where
  toRes :: Proxy (Col s a :*: b) -> ResultReader (Res (Col s a :*: b))
toRes Proxy (Col s a :*: b)
_ = forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 forall a b. a -> b -> a :*: b
(:*:) (forall a. SqlType a => SqlValue -> a
fromSql forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ResultReader SqlValue
next) (forall r. Result r => Proxy r -> ResultReader (Res r)
toRes (forall {k} (t :: k). Proxy t
Proxy :: Proxy b))
  finalCols :: (Col s a :*: b) -> [SomeCol SQL]
finalCols (Col s a
a :*: b
b) = forall r. Result r => r -> [SomeCol SQL]
finalCols Col s a
a forall a. [a] -> [a] -> [a]
++ forall r. Result r => r -> [SomeCol SQL]
finalCols b
b

instance (SqlRow a, Result b) => Result (Row s a :*: b) where
  toRes :: Proxy (Row s a :*: b) -> ResultReader (Res (Row s a :*: b))
toRes Proxy (Row s a :*: b)
_ = forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 forall a b. a -> b -> a :*: b
(:*:) forall a. SqlRow a => ResultReader a
nextResult (forall r. Result r => Proxy r -> ResultReader (Res r)
toRes (forall {k} (t :: k). Proxy t
Proxy :: Proxy b))
  finalCols :: (Row s a :*: b) -> [SomeCol SQL]
finalCols (Row s a
a :*: b
b) = forall r. Result r => r -> [SomeCol SQL]
finalCols Row s a
a forall a. [a] -> [a] -> [a]
++ forall r. Result r => r -> [SomeCol SQL]
finalCols b
b

instance SqlType a => Result (Col s a) where
  toRes :: Proxy (Col s a) -> ResultReader (Res (Col s a))
toRes Proxy (Col s a)
_ = forall a. SqlType a => SqlValue -> a
fromSql forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ResultReader SqlValue
next
  finalCols :: Col s a -> [SomeCol SQL]
finalCols (One Exp SQL a
c) = [forall sql a. Exp sql a -> SomeCol sql
Some Exp SQL a
c]

instance SqlRow a => Result (Row s a) where
  toRes :: Proxy (Row s a) -> ResultReader (Res (Row s a))
toRes Proxy (Row s a)
_ = forall a. SqlRow a => ResultReader a
nextResult
  finalCols :: Row s a -> [SomeCol SQL]
finalCols (Many [UntypedCol SQL]
cs) = [forall sql a. Exp sql a -> SomeCol sql
Some Exp SQL a
c | Untyped Exp SQL a
c <- [UntypedCol SQL]
cs]