module Database.Relational.Projectable (
SqlContext (unsafeProjectSqlTerms), unsafeProjectSql',
unsafeProjectSql,
value,
valueTrue, valueFalse,
values,
nothing,
PlaceHolders, unsafeAddPlaceHolders, unsafePlaceHolders,
pwPlaceholder, placeholder', placeholder, unitPlaceHolder, unitPH,
unsafeShowSql', unsafeShowSql,
(.=.), (.<.), (.<=.), (.>.), (.>=.), (.<>.),
and', or', in',
(.||.), (?||?), like, likeMaybe, like', likeMaybe',
(.+.), (.-.), (.*.), (./.),
(?+?), (?-?), (?*?), (?/?),
isNothing, isJust, fromMaybe,
not', exists,
negate', fromIntegral', showNum,
negateMaybe, fromIntegralMaybe, showNumMaybe,
casesOrElse, casesOrElse',
caseSearch, caseSearchMaybe, case', caseMaybe,
SqlBinOp, unsafeBinOp, unsafeUniOp,
rank, denseRank, rowNumber, percentRank, cumeDist,
projectZip, (><),
ProjectableMaybe (just, flattenMaybe),
ProjectableFlattenMaybe (flatten),
flattenPiMaybe,
(!), (?), (??), (?!), (?!?), (!??),
unsafeAggregateOp,
count,
sum', sumMaybe, avg, avgMaybe,
max', maxMaybe, min', minMaybe,
every, any', some',
) where
import Prelude hiding (pi)
import Data.String (IsString)
import Data.Functor.ProductIsomorphic
((|$|), ProductIsoApplicative, pureP, (|*|), )
import Language.SQL.Keyword (Keyword)
import qualified Language.SQL.Keyword as SQL
import Database.Record
(PersistableWidth, persistableWidth, PersistableRecordWidth,
HasColumnConstraint, NotNull)
import Database.Record.Persistable (runPersistableRecordWidth)
import Database.Relational.Internal.ContextType (Flat, Exists, OverWindow)
import Database.Relational.Internal.String (StringSQL, stringSQL, showStringSQL)
import Database.Relational.SqlSyntax (Record, Predicate)
import qualified Database.Relational.SqlSyntax as Syntax
import Database.Relational.Pure ()
import Database.Relational.TupleInstances ()
import Database.Relational.Pi (Pi)
import Database.Relational.ProjectableClass
(ShowConstantTermsSQL, showConstantTermsSQL, )
import Database.Relational.Record (RecordList)
import qualified Database.Relational.Record as Record
import Database.Relational.Projectable.Unsafe
(SqlContext (..), OperatorContext, AggregatedContext, PlaceHolders (..))
import Database.Relational.Projectable.Instances ()
unsafeProjectSql' :: SqlContext c => StringSQL -> Record c t
unsafeProjectSql' = unsafeProjectSqlTerms . (:[])
unsafeProjectSql :: SqlContext c => String -> Record c t
unsafeProjectSql = unsafeProjectSql' . stringSQL
nothing :: (OperatorContext c, SqlContext c, PersistableWidth a)
=> Record c (Maybe a)
nothing = proxyWidth persistableWidth
where
proxyWidth :: SqlContext c => PersistableRecordWidth a -> Record c (Maybe a)
proxyWidth w = unsafeProjectSqlTerms $ replicate (runPersistableRecordWidth w) SQL.NULL
value :: (ShowConstantTermsSQL t, OperatorContext c) => t -> Record c t
value = unsafeProjectSqlTerms . showConstantTermsSQL
valueTrue :: (OperatorContext c, ProjectableMaybe (Record c)) => Record c (Maybe Bool)
valueTrue = just $ value True
valueFalse :: (OperatorContext c, ProjectableMaybe (Record c)) => Record c (Maybe Bool)
valueFalse = just $ value False
values :: (ShowConstantTermsSQL t, OperatorContext c) => [t] -> RecordList (Record c) t
values = Record.list . map value
unsafeShowSql' :: Record c a -> StringSQL
unsafeShowSql' = Record.unsafeStringSql
unsafeShowSql :: Record c a
-> String
unsafeShowSql = showStringSQL . unsafeShowSql'
type SqlBinOp = Keyword -> Keyword -> Keyword
unsafeUniOp :: SqlContext c2
=> (Keyword -> Keyword) -> Record c1 a -> Record c2 b
unsafeUniOp u = unsafeProjectSql' . u . unsafeShowSql'
unsafeFlatUniOp :: SqlContext c
=> Keyword -> Record c a -> Record c b
unsafeFlatUniOp kw = unsafeUniOp (SQL.paren . SQL.defineUniOp kw)
unsafeBinOp :: SqlContext k
=> SqlBinOp
-> Record k a -> Record k b -> Record k c
unsafeBinOp op a b = unsafeProjectSql' . SQL.paren $
op (unsafeShowSql' a) (unsafeShowSql' b)
compareBinOp :: SqlContext c
=> SqlBinOp
-> Record c a -> Record c a -> Record c (Maybe Bool)
compareBinOp = unsafeBinOp
monoBinOp :: SqlContext c
=> SqlBinOp
-> Record c a -> Record c a -> Record c a
monoBinOp = unsafeBinOp
(.=.) :: OperatorContext c
=> Record c ft -> Record c ft -> Record c (Maybe Bool)
(.=.) = compareBinOp (SQL..=.)
(.<.) :: OperatorContext c
=> Record c ft -> Record c ft -> Record c (Maybe Bool)
(.<.) = compareBinOp (SQL..<.)
(.<=.) :: OperatorContext c
=> Record c ft -> Record c ft -> Record c (Maybe Bool)
(.<=.) = compareBinOp (SQL..<=.)
(.>.) :: OperatorContext c
=> Record c ft -> Record c ft -> Record c (Maybe Bool)
(.>.) = compareBinOp (SQL..>.)
(.>=.) :: OperatorContext c
=> Record c ft -> Record c ft -> Record c (Maybe Bool)
(.>=.) = compareBinOp (SQL..>=.)
(.<>.) :: OperatorContext c
=> Record c ft -> Record c ft -> Record c (Maybe Bool)
(.<>.) = compareBinOp (SQL..<>.)
and' :: OperatorContext c
=> Record c (Maybe Bool) -> Record c (Maybe Bool) -> Record c (Maybe Bool)
and' = monoBinOp SQL.and
or' :: OperatorContext c
=> Record c (Maybe Bool) -> Record c (Maybe Bool) -> Record c (Maybe Bool)
or' = monoBinOp SQL.or
not' :: OperatorContext c
=> Record c (Maybe Bool) -> Record c (Maybe Bool)
not' = unsafeFlatUniOp SQL.NOT
exists :: OperatorContext c
=> RecordList (Record Exists) r -> Record c (Maybe Bool)
exists = unsafeProjectSql' . SQL.paren . SQL.defineUniOp SQL.EXISTS
. Record.unsafeStringSqlList unsafeShowSql'
(.||.) :: OperatorContext c
=> Record c a -> Record c a -> Record c a
(.||.) = unsafeBinOp (SQL..||.)
(?||?) :: (OperatorContext c, IsString a)
=> Record c (Maybe a) -> Record c (Maybe a) -> Record c (Maybe a)
(?||?) = unsafeBinOp (SQL..||.)
unsafeLike :: OperatorContext c
=> Record c a -> Record c b -> Record c (Maybe Bool)
unsafeLike = unsafeBinOp (SQL.defineBinOp SQL.LIKE)
like' :: (OperatorContext c, IsString a)
=> Record c a -> Record c a -> Record c (Maybe Bool)
x `like'` y = x `unsafeLike` y
likeMaybe' :: (OperatorContext c, IsString a)
=> Record c (Maybe a) -> Record c (Maybe a) -> Record c (Maybe Bool)
x `likeMaybe'` y = x `unsafeLike` y
like :: (OperatorContext c, IsString a, ShowConstantTermsSQL a)
=> Record c a -> a -> Record c (Maybe Bool)
x `like` a = x `like'` value a
likeMaybe :: (OperatorContext c, IsString a, ShowConstantTermsSQL a)
=> Record c (Maybe a) -> a -> Record c (Maybe Bool)
x `likeMaybe` a = x `unsafeLike` value a
monoBinOp' :: SqlContext c
=> Keyword -> Record c a -> Record c a -> Record c a
monoBinOp' = monoBinOp . SQL.defineBinOp
(.+.) :: (OperatorContext c, Num a)
=> Record c a -> Record c a -> Record c a
(.+.) = monoBinOp' "+"
(.-.) :: (OperatorContext c, Num a)
=> Record c a -> Record c a -> Record c a
(.-.) = monoBinOp' "-"
(./.) :: (OperatorContext c, Num a)
=> Record c a -> Record c a -> Record c a
(./.) = monoBinOp' "/"
(.*.) :: (OperatorContext c, Num a)
=> Record c a -> Record c a -> Record c a
(.*.) = monoBinOp' "*"
negate' :: (OperatorContext c, Num a)
=> Record c a -> Record c a
negate' = unsafeFlatUniOp $ SQL.word "-"
unsafeCastProjectable :: SqlContext c
=> Record c a -> Record c b
unsafeCastProjectable = unsafeProjectSql' . unsafeShowSql'
fromIntegral' :: (SqlContext c, Integral a, Num b)
=> Record c a -> Record c b
fromIntegral' = unsafeCastProjectable
showNum :: (SqlContext c, Num a, IsString b)
=> Record c a -> Record c b
showNum = unsafeCastProjectable
(?+?) :: (OperatorContext c, Num a)
=> Record c (Maybe a) -> Record c (Maybe a) -> Record c (Maybe a)
(?+?) = monoBinOp' "+"
(?-?) :: (OperatorContext c, Num a)
=> Record c (Maybe a) -> Record c (Maybe a) -> Record c (Maybe a)
(?-?) = monoBinOp' "-"
(?/?) :: (OperatorContext c, Num a)
=> Record c (Maybe a) -> Record c (Maybe a) -> Record c (Maybe a)
(?/?) = monoBinOp' "/"
(?*?) :: (OperatorContext c, Num a)
=> Record c (Maybe a) -> Record c (Maybe a) -> Record c (Maybe a)
(?*?) = monoBinOp' "*"
negateMaybe :: (OperatorContext c, Num a)
=> Record c (Maybe a) -> Record c (Maybe a)
negateMaybe = unsafeFlatUniOp $ SQL.word "-"
fromIntegralMaybe :: (SqlContext c, Integral a, Num b)
=> Record c (Maybe a) -> Record c (Maybe b)
fromIntegralMaybe = unsafeCastProjectable
showNumMaybe :: (SqlContext c, Num a, IsString b)
=> Record c (Maybe a) -> Record c (Maybe b)
showNumMaybe = unsafeCastProjectable
caseSearch :: OperatorContext c
=> [(Predicate c, Record c a)]
-> Record c a
-> Record c a
caseSearch = Syntax.caseSearch
casesOrElse :: OperatorContext c
=> [(Predicate c, Record c a)]
-> Record c a
-> Record c a
casesOrElse = caseSearch
caseSearchMaybe :: (OperatorContext c , PersistableWidth a)
=> [(Predicate c, Record c (Maybe a))]
-> Record c (Maybe a)
caseSearchMaybe cs = caseSearch cs nothing
case' :: OperatorContext c
=> Record c a
-> [(Record c a, Record c b)]
-> Record c b
-> Record c b
case' = Syntax.case'
casesOrElse' :: OperatorContext c
=> (Record c a, [(Record c a, Record c b)])
-> Record c b
-> Record c b
casesOrElse' = uncurry case'
caseMaybe :: (OperatorContext c , PersistableWidth b)
=> Record c a
-> [(Record c a, Record c (Maybe b))]
-> Record c (Maybe b)
caseMaybe v cs = case' v cs nothing
in' :: OperatorContext c
=> Record c t -> RecordList (Record c) t -> Record c (Maybe Bool)
in' a lp = unsafeProjectSql' . SQL.paren
$ SQL.in' (unsafeShowSql' a) (Record.unsafeStringSqlList unsafeShowSql' lp)
isNothing :: (OperatorContext c, HasColumnConstraint NotNull r)
=> Record c (Maybe r) -> Predicate c
isNothing mr = unsafeProjectSql' $
SQL.paren $ (SQL.defineBinOp SQL.IS)
(Record.unsafeStringSqlNotNullMaybe mr) SQL.NULL
isJust :: (OperatorContext c, HasColumnConstraint NotNull r)
=> Record c (Maybe r) -> Predicate c
isJust = not' . isNothing
fromMaybe :: (OperatorContext c, HasColumnConstraint NotNull r)
=> Record c r -> Record c (Maybe r) -> Record c r
fromMaybe d p = [ (isNothing p, d) ] `casesOrElse` unsafeCastProjectable p
unsafeUniTermFunction :: SqlContext c => Keyword -> Record c t
unsafeUniTermFunction = unsafeProjectSql' . (SQL.<++> stringSQL "()")
rank :: Integral a => Record OverWindow a
rank = unsafeUniTermFunction SQL.RANK
denseRank :: Integral a => Record OverWindow a
denseRank = unsafeUniTermFunction SQL.DENSE_RANK
rowNumber :: Integral a => Record OverWindow a
rowNumber = unsafeUniTermFunction SQL.ROW_NUMBER
percentRank :: Record OverWindow Double
percentRank = unsafeUniTermFunction SQL.PERCENT_RANK
cumeDist :: Record OverWindow Double
cumeDist = unsafeUniTermFunction SQL.CUME_DIST
unsafeAddPlaceHolders :: Functor f => f a -> f (PlaceHolders p, a)
unsafeAddPlaceHolders = fmap ((,) PlaceHolders)
unsafePlaceHolders :: PlaceHolders p
unsafePlaceHolders = PlaceHolders
unitPlaceHolder :: PlaceHolders ()
unitPlaceHolder = pureP ()
unitPH :: PlaceHolders ()
unitPH = pureP ()
unsafeCastPlaceHolders :: PlaceHolders a -> PlaceHolders b
unsafeCastPlaceHolders PlaceHolders = PlaceHolders
pwPlaceholder :: SqlContext c
=> PersistableRecordWidth a
-> (Record c a -> b)
-> (PlaceHolders a, b)
pwPlaceholder pw f = (PlaceHolders, f $ projectPlaceHolder pw)
where
projectPlaceHolder :: SqlContext c
=> PersistableRecordWidth a
-> Record c a
projectPlaceHolder = unsafeProjectSqlTerms . (`replicate` "?") . runPersistableRecordWidth
placeholder' :: (PersistableWidth t, SqlContext c) => (Record c t -> a) -> (PlaceHolders t, a)
placeholder' = pwPlaceholder persistableWidth
placeholder :: (PersistableWidth t, SqlContext c, Monad m) => (Record c t -> m a) -> m (PlaceHolders t, a)
placeholder f = do
let (ph, ma) = placeholder' f
a <- ma
return (ph, a)
projectZip :: ProductIsoApplicative p => p a -> p b -> p (a, b)
projectZip pa pb = (,) |$| pa |*| pb
(><) :: ProductIsoApplicative p => p a -> p b -> p (a, b)
(><) = projectZip
class ProjectableMaybe p where
just :: p a -> p (Maybe a)
flattenMaybe :: p (Maybe (Maybe a)) -> p (Maybe a)
instance ProjectableMaybe PlaceHolders where
just = unsafeCastPlaceHolders
flattenMaybe = unsafeCastPlaceHolders
instance ProjectableMaybe (Record c) where
just = Record.just
flattenMaybe = Record.flattenMaybe
unsafeAggregateOp :: (AggregatedContext ac, SqlContext ac)
=> SQL.Keyword -> Record Flat a -> Record ac b
unsafeAggregateOp op = unsafeUniOp ((op SQL.<++>) . SQL.paren)
count :: (Integral b, AggregatedContext ac, SqlContext ac)
=> Record Flat a -> Record ac b
count = unsafeAggregateOp SQL.COUNT
sumMaybe :: (Num a, AggregatedContext ac, SqlContext ac)
=> Record Flat (Maybe a) -> Record ac (Maybe a)
sumMaybe = unsafeAggregateOp SQL.SUM
sum' :: (Num a, AggregatedContext ac, SqlContext ac)
=> Record Flat a -> Record ac (Maybe a)
sum' = sumMaybe . Record.just
avgMaybe :: (Num a, Fractional b, AggregatedContext ac, SqlContext ac)
=> Record Flat (Maybe a) -> Record ac (Maybe b)
avgMaybe = unsafeAggregateOp SQL.AVG
avg :: (Num a, Fractional b, AggregatedContext ac, SqlContext ac)
=> Record Flat a -> Record ac (Maybe b)
avg = avgMaybe . Record.just
maxMaybe :: (Ord a, AggregatedContext ac, SqlContext ac)
=> Record Flat (Maybe a) -> Record ac (Maybe a)
maxMaybe = unsafeAggregateOp SQL.MAX
max' :: (Ord a, AggregatedContext ac, SqlContext ac)
=> Record Flat a -> Record ac (Maybe a)
max' = maxMaybe . Record.just
minMaybe :: (Ord a, AggregatedContext ac, SqlContext ac)
=> Record Flat (Maybe a) -> Record ac (Maybe a)
minMaybe = unsafeAggregateOp SQL.MIN
min' :: (Ord a, AggregatedContext ac, SqlContext ac)
=> Record Flat a -> Record ac (Maybe a)
min' = minMaybe . Record.just
every :: (AggregatedContext ac, SqlContext ac)
=> Predicate Flat -> Record ac (Maybe Bool)
every = unsafeAggregateOp SQL.EVERY
any' :: (AggregatedContext ac, SqlContext ac)
=> Predicate Flat -> Record ac (Maybe Bool)
any' = unsafeAggregateOp SQL.ANY
some' :: (AggregatedContext ac, SqlContext ac)
=> Predicate Flat -> Record ac (Maybe Bool)
some' = unsafeAggregateOp SQL.SOME
(!) :: PersistableWidth a
=> Record c a
-> Pi a b
-> Record c b
(!) = Record.pi
(?!) :: PersistableWidth a
=> Record c (Maybe a)
-> Pi a b
-> Record c (Maybe b)
(?!) = Record.piMaybe
(?!?) :: PersistableWidth a
=> Record c (Maybe a)
-> Pi a (Maybe b)
-> Record c (Maybe b)
(?!?) = Record.piMaybe'
class ProjectableFlattenMaybe a b where
flatten :: ProjectableMaybe p => p a -> p b
instance ProjectableFlattenMaybe (Maybe a) b
=> ProjectableFlattenMaybe (Maybe (Maybe a)) b where
flatten = flatten . flattenMaybe
instance ProjectableFlattenMaybe (Maybe a) (Maybe a) where
flatten = id
flattenPiMaybe :: (PersistableWidth a, ProjectableMaybe (Record cont), ProjectableFlattenMaybe (Maybe b) c)
=> Record cont (Maybe a)
-> Pi a b
-> Record cont c
flattenPiMaybe p = flatten . Record.piMaybe p
(!??) :: (PersistableWidth a, ProjectableMaybe (Record cont), ProjectableFlattenMaybe (Maybe b) c)
=> Record cont (Maybe a)
-> Pi a b
-> Record cont c
(!??) = flattenPiMaybe
(?) :: PersistableWidth a
=> Record c (Maybe a)
-> Pi a b
-> Record c (Maybe b)
(?) = (?!)
(??) :: PersistableWidth a
=> Record c (Maybe a)
-> Pi a (Maybe b)
-> Record c (Maybe b)
(??) = (?!?)
infixl 8 !, ?, ??, ?!, ?!?, !??
infixl 7 .*., ./., ?*?, ?/?
infixl 6 .+., .-., ?+?, ?-?
infixl 5 .||., ?||?
infix 4 .=., .<>., .>., .>=., .<., .<=., `in'`, `like`, `likeMaybe`, `like'`, `likeMaybe'`
infixr 3 `and'`
infixr 2 `or'`
infixl 1 ><