{-# LANGUAGE OverloadedStrings, FlexibleInstances, UndecidableInstances #-}
{-# LANGUAGE ScopedTypeVariables, TypeOperators, GADTs, FlexibleContexts #-}
module Database.Selda
(
MonadSelda
, SeldaError (..), ValidationError
, SeldaT, SeldaM, Table, Query, Col, Res, Result
, query, transaction, setLocalCache
, Selector, (!), Assignment(..), with
, SqlType (..), SqlEnum (..)
, Cols, Columns
, Order (..)
, (:*:)(..)
, select, selectValues, from, distinct
, restrict, limit
, order , ascending, descending
, inner, suchThat
, Set (..)
, RowID, invalidRowId, isInvalidRowId, fromRowId
, (.==), (./=), (.>), (.<), (.>=), (.<=), like
, (.&&), (.||), not_
, literal, int, float, text, true, false, null_
, roundTo, length_, isNull, ifThenElse, matchNull
, round_, just, fromBool, fromInt, toString
, Aggr, Aggregates, OuterCols, AggrCols, LeftCols, Inner, SqlOrd
, innerJoin, leftJoin
, aggregate, groupBy
, count, avg, sum_, max_, min_
, Insert
, insert, insert_, insertWithPK, tryInsert, insertUnless, insertWhen, def
, update, update_, upsert
, deleteFrom, deleteFrom_
, Preparable, Prepare
, prepared
, TableSpec, ColSpecs, ColSpec, TableName, ColName
, NonNull
, Append (..), (:++:)
, Selectors, HasSelectors
, table, tableWithSelectors, selectors
, required, optional
, primary, autoPrimary
, fk, optFk, unique
, createTable, tryCreateTable
, validateTable, dropTable, tryDropTable
, OnError (..)
, compile
, compileCreateTable, compileDropTable
, compileInsert, compileUpdate
, Tup, Head
, first, second, third, fourth, fifth, sixth, seventh, eighth, ninth, tenth
, MonadIO, liftIO
, Text, Day, TimeOfDay, UTCTime
) where
import Database.Selda.Backend
import Database.Selda.Column
import Database.Selda.Compile
import Database.Selda.Frontend
import Database.Selda.Inner
import Database.Selda.Prepared
import Database.Selda.Query
import Database.Selda.Query.Type
import Database.Selda.Selectors
import Database.Selda.SQL hiding (distinct)
import Database.Selda.SqlType
import Database.Selda.Table
import Database.Selda.Table.Compile
import Database.Selda.Table.Foreign
import Database.Selda.Types
import Database.Selda.Unsafe
import Control.Exception (throw)
import Data.Text (Text)
import Data.Time (Day, TimeOfDay, UTCTime)
import Data.Typeable (eqT, (:~:)(..))
import Unsafe.Coerce
class SqlType a => SqlOrd a
instance {-# OVERLAPPABLE #-} (SqlType a, Num a) => SqlOrd a
instance SqlOrd Text
instance SqlOrd Day
instance SqlOrd UTCTime
instance SqlOrd TimeOfDay
instance SqlOrd a => SqlOrd (Maybe a)
validateTable :: MonadSelda m => Table a -> m ()
validateTable t = validate (tableName t) (tableCols t) `seq` return ()
from :: ToDyn (Cols () a)
=> Selector a b
-> Query s (Cols s a)
-> Query s (Col s b)
from s q = (! s) <$> q
infixr 7 `from`
inner :: (Columns a, Columns (OuterCols a))
=> Query (Inner s) a
-> Query s (OuterCols a)
inner = innerJoin (const true)
suchThat :: (Columns a, Columns (OuterCols a))
=> Query (Inner s) a
-> (a -> Col (Inner s) Bool)
-> Query s (OuterCols a)
suchThat q p = inner $ do
x <- q
restrict (p x)
return x
infixr 7 `suchThat`
(.==), (./=) :: SqlType a => Col s a -> Col s a -> Col s Bool
(.>), (.<), (.>=), (.<=) :: SqlOrd a => Col s a -> Col s a -> Col s Bool
(.==) = liftC2 $ BinOp Eq
(./=) = liftC2 $ BinOp Neq
(.>) = liftC2 $ BinOp Gt
(.<) = liftC2 $ BinOp Lt
(.>=) = liftC2 $ BinOp Gte
(.<=) = liftC2 $ BinOp Lte
infixl 4 .==
infixl 4 ./=
infixl 4 .>
infixl 4 .<
infixl 4 .>=
infixl 4 .<=
isNull :: Col s (Maybe a) -> Col s Bool
isNull = liftC $ UnOp IsNull
matchNull :: SqlType a => Col s b -> (Col s a -> Col s b) -> Col s (Maybe a) -> Col s b
matchNull nullvalue f x = ifThenElse (isNull x) nullvalue (f (cast x))
class Set set where
isIn :: SqlType a => Col s a -> set (Col s a) -> Col s Bool
infixl 4 `isIn`
instance Set [] where
isIn _ [] = false
isIn (C x) xs = C $ InList x (unsafeCoerce xs)
instance Set (Query s) where
isIn (C x) = C . InQuery x . snd . compQueryWithFreshScope
(.&&), (.||) :: Col s Bool -> Col s Bool -> Col s Bool
(.&&) = liftC2 $ BinOp And
(.||) = liftC2 $ BinOp Or
infixr 3 .&&
infixr 2 .||
ascending, descending :: Order
ascending = Asc
descending = Desc
def :: SqlType a => a
def = throw DefaultValueException
just :: SqlType a => Col s a -> Col s (Maybe a)
just = cast
null_ :: SqlType a => Col s (Maybe a)
null_ = literal Nothing
int :: Int -> Col s Int
int = literal
float :: Double -> Col s Double
float = literal
text :: Text -> Col s Text
text = literal
true, false :: Col s Bool
true = literal True
false = literal False
like :: Col s Text -> Col s Text -> Col s Bool
like = liftC2 $ BinOp Like
infixl 4 `like`
count :: SqlType a => Col s a -> Aggr s Int
count = aggr "COUNT"
avg :: (SqlType a, Num a) => Col s a -> Aggr s a
avg = aggr "AVG"
max_ :: SqlOrd a => Col s a -> Aggr s a
max_ = aggr "MAX"
min_ :: SqlOrd a => Col s a -> Aggr s a
min_ = aggr "MIN"
sum_ :: (SqlType a, Num a) => Col s a -> Aggr s a
sum_ = aggr "SUM"
round_ :: forall s a. (SqlType a, Num a) => Col s Double -> Col s a
round_ =
case eqT :: Maybe (a :~: Double) of
Just Refl -> fun "ROUND"
_ -> cast . fun "ROUND"
roundTo :: Col s Int -> Col s Double -> Col s Double
roundTo = flip $ fun2 "ROUND"
length_ :: Col s Text -> Col s Int
length_ = fun "LENGTH"
not_ :: Col s Bool -> Col s Bool
not_ = liftC $ UnOp Not
fromBool :: (SqlType a, Num a) => Col s Bool -> Col s a
fromBool = cast
fromInt :: (SqlType a, Num a) => Col s Int -> Col s a
fromInt = cast
toString :: Col s a -> Col s Text
toString = cast
ifThenElse :: Col s Bool -> Col s a -> Col s a -> Col s a
ifThenElse = liftC3 If