{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-- | This module has common SQL functions and operators which are supported in the most SQL databases
module Database.Groundhog.Generic.Sql.Functions
  ( like,
    notLike,
    in_,
    notIn_,
    lower,
    upper,
    case_,
    SqlDb (..),
    cot,
    atan2,
    radians,
    degrees,
  )
where

import Data.Int (Int64)
import Data.String
import Database.Groundhog.Core
import Database.Groundhog.Expression
import Database.Groundhog.Generic.Sql

in_ ::
  (SqlDb db, Expression db r a, Expression db r b, PrimitivePersistField b, Unifiable a b) =>
  a ->
  [b] ->
  Cond db r
in_ :: a -> [b] -> Cond db r
in_ a
_ [] = Cond db r -> Cond db r
forall db r. Cond db r -> Cond db r
Not Cond db r
forall db r. Cond db r
CondEmpty
in_ a
a [b]
bs = QueryRaw db r -> Cond db r
forall db r. QueryRaw db r -> Cond db r
CondRaw (QueryRaw db r -> Cond db r) -> QueryRaw db r -> Cond db r
forall a b. (a -> b) -> a -> b
$ (RenderConfig -> Int -> [RenderS db r]) -> Snippet db r
forall db r.
(RenderConfig -> Int -> [RenderS db r]) -> Snippet db r
Snippet ((RenderConfig -> Int -> [RenderS db r]) -> Snippet db r)
-> (RenderConfig -> Int -> [RenderS db r]) -> Snippet db r
forall a b. (a -> b) -> a -> b
$ \RenderConfig
conf Int
p -> [Int -> Int -> RenderS db r -> RenderS db r
forall db r. Int -> Int -> RenderS db r -> RenderS db r
parens Int
45 Int
p (RenderS db r -> RenderS db r) -> RenderS db r -> RenderS db r
forall a b. (a -> b) -> a -> b
$ RenderConfig -> UntypedExpr db r -> RenderS db r
forall db r.
SqlDb db =>
RenderConfig -> UntypedExpr db r -> RenderS db r
renderExpr RenderConfig
conf (a -> UntypedExpr db r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr a
a) RenderS db r -> RenderS db r -> RenderS db r
forall a. Semigroup a => a -> a -> a
<> RenderS db r
" IN (" RenderS db r -> RenderS db r -> RenderS db r
forall a. Semigroup a => a -> a -> a
<> [RenderS db r] -> RenderS db r
forall s. StringLike s => [s] -> s
commasJoin ((b -> RenderS db r) -> [b] -> [RenderS db r]
forall a b. (a -> b) -> [a] -> [b]
map (RenderConfig -> UntypedExpr db r -> RenderS db r
forall db r.
SqlDb db =>
RenderConfig -> UntypedExpr db r -> RenderS db r
renderExpr RenderConfig
conf (UntypedExpr db r -> RenderS db r)
-> (b -> UntypedExpr db r) -> b -> RenderS db r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> UntypedExpr db r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr) [b]
bs) RenderS db r -> RenderS db r -> RenderS db r
forall a. Semigroup a => a -> a -> a
<> RenderS db r
")"]

notIn_ ::
  (SqlDb db, Expression db r a, Expression db r b, PrimitivePersistField b, Unifiable a b) =>
  a ->
  [b] ->
  Cond db r
notIn_ :: a -> [b] -> Cond db r
notIn_ a
_ [] = Cond db r
forall db r. Cond db r
CondEmpty
notIn_ a
a [b]
bs = QueryRaw db r -> Cond db r
forall db r. QueryRaw db r -> Cond db r
CondRaw (QueryRaw db r -> Cond db r) -> QueryRaw db r -> Cond db r
forall a b. (a -> b) -> a -> b
$ (RenderConfig -> Int -> [RenderS db r]) -> Snippet db r
forall db r.
(RenderConfig -> Int -> [RenderS db r]) -> Snippet db r
Snippet ((RenderConfig -> Int -> [RenderS db r]) -> Snippet db r)
-> (RenderConfig -> Int -> [RenderS db r]) -> Snippet db r
forall a b. (a -> b) -> a -> b
$ \RenderConfig
conf Int
p -> [Int -> Int -> RenderS db r -> RenderS db r
forall db r. Int -> Int -> RenderS db r -> RenderS db r
parens Int
45 Int
p (RenderS db r -> RenderS db r) -> RenderS db r -> RenderS db r
forall a b. (a -> b) -> a -> b
$ RenderConfig -> UntypedExpr db r -> RenderS db r
forall db r.
SqlDb db =>
RenderConfig -> UntypedExpr db r -> RenderS db r
renderExpr RenderConfig
conf (a -> UntypedExpr db r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr a
a) RenderS db r -> RenderS db r -> RenderS db r
forall a. Semigroup a => a -> a -> a
<> RenderS db r
" NOT IN (" RenderS db r -> RenderS db r -> RenderS db r
forall a. Semigroup a => a -> a -> a
<> [RenderS db r] -> RenderS db r
forall s. StringLike s => [s] -> s
commasJoin ((b -> RenderS db r) -> [b] -> [RenderS db r]
forall a b. (a -> b) -> [a] -> [b]
map (RenderConfig -> UntypedExpr db r -> RenderS db r
forall db r.
SqlDb db =>
RenderConfig -> UntypedExpr db r -> RenderS db r
renderExpr RenderConfig
conf (UntypedExpr db r -> RenderS db r)
-> (b -> UntypedExpr db r) -> b -> RenderS db r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> UntypedExpr db r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr) [b]
bs) RenderS db r -> RenderS db r -> RenderS db r
forall a. Semigroup a => a -> a -> a
<> RenderS db r
")"]

like :: (SqlDb db, ExpressionOf db r a a', IsString a') => a -> String -> Cond db r
like :: a -> String -> Cond db r
like a
a String
b = QueryRaw db r -> Cond db r
forall db r. QueryRaw db r -> Cond db r
CondRaw (QueryRaw db r -> Cond db r) -> QueryRaw db r -> Cond db r
forall a b. (a -> b) -> a -> b
$ Int -> String -> a -> String -> Snippet db r
forall db r a b.
(SqlDb db, Expression db r a, Expression db r b) =>
Int -> String -> a -> b -> Snippet db r
operator Int
40 String
" LIKE " a
a String
b

notLike :: (SqlDb db, ExpressionOf db r a a', IsString a') => a -> String -> Cond db r
notLike :: a -> String -> Cond db r
notLike a
a String
b = QueryRaw db r -> Cond db r
forall db r. QueryRaw db r -> Cond db r
CondRaw (QueryRaw db r -> Cond db r) -> QueryRaw db r -> Cond db r
forall a b. (a -> b) -> a -> b
$ Int -> String -> a -> String -> Snippet db r
forall db r a b.
(SqlDb db, Expression db r a, Expression db r b) =>
Int -> String -> a -> b -> Snippet db r
operator Int
40 String
" NOT LIKE " a
a String
b

lower :: (SqlDb db, ExpressionOf db r a a', IsString a') => a -> Expr db r a'
lower :: a -> Expr db r a'
lower a
a = Snippet db r -> Expr db r a'
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet db r -> Expr db r a') -> Snippet db r -> Expr db r a'
forall a b. (a -> b) -> a -> b
$ String -> [UntypedExpr db r] -> Snippet db r
forall db r.
SqlDb db =>
String -> [UntypedExpr db r] -> Snippet db r
function String
"lower" [a -> UntypedExpr db r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr a
a]

upper :: (SqlDb db, ExpressionOf db r a a', IsString a') => a -> Expr db r a'
upper :: a -> Expr db r a'
upper a
a = Snippet db r -> Expr db r a'
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet db r -> Expr db r a') -> Snippet db r -> Expr db r a'
forall a b. (a -> b) -> a -> b
$ String -> [UntypedExpr db r] -> Snippet db r
forall db r.
SqlDb db =>
String -> [UntypedExpr db r] -> Snippet db r
function String
"upper" [a -> UntypedExpr db r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr a
a]

cot :: (FloatingSqlDb db, ExpressionOf db r a a', Floating a') => a -> Expr db r a'
cot :: a -> Expr db r a'
cot a
a = Snippet db r -> Expr db r a'
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet db r -> Expr db r a') -> Snippet db r -> Expr db r a'
forall a b. (a -> b) -> a -> b
$ String -> [UntypedExpr db r] -> Snippet db r
forall db r.
SqlDb db =>
String -> [UntypedExpr db r] -> Snippet db r
function String
"cot" [a -> UntypedExpr db r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr a
a]

radians, degrees :: (FloatingSqlDb db, ExpressionOf db r a a', Floating a') => a -> Expr db r a'
radians :: a -> Expr db r a'
radians a
x = Snippet db r -> Expr db r a'
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet db r -> Expr db r a') -> Snippet db r -> Expr db r a'
forall a b. (a -> b) -> a -> b
$ String -> [UntypedExpr db r] -> Snippet db r
forall db r.
SqlDb db =>
String -> [UntypedExpr db r] -> Snippet db r
function String
"radians" [a -> UntypedExpr db r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr a
x]
degrees :: a -> Expr db r a'
degrees a
x = Snippet db r -> Expr db r a'
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet db r -> Expr db r a') -> Snippet db r -> Expr db r a'
forall a b. (a -> b) -> a -> b
$ String -> [UntypedExpr db r] -> Snippet db r
forall db r.
SqlDb db =>
String -> [UntypedExpr db r] -> Snippet db r
function String
"degrees" [a -> UntypedExpr db r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr a
x]

instance (SqlDb db, PersistField a, Num a) => Num (Expr db r a) where
  Expr db r a
a + :: Expr db r a -> Expr db r a -> Expr db r a
+ Expr db r a
b = Snippet db r -> Expr db r a
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet db r -> Expr db r a) -> Snippet db r -> Expr db r a
forall a b. (a -> b) -> a -> b
$ Int -> String -> Expr db r a -> Expr db r a -> Snippet db r
forall db r a b.
(SqlDb db, Expression db r a, Expression db r b) =>
Int -> String -> a -> b -> Snippet db r
operator Int
60 String
"+" Expr db r a
a Expr db r a
b
  Expr db r a
a - :: Expr db r a -> Expr db r a -> Expr db r a
- Expr db r a
b = Snippet db r -> Expr db r a
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet db r -> Expr db r a) -> Snippet db r -> Expr db r a
forall a b. (a -> b) -> a -> b
$ Int -> String -> Expr db r a -> Expr db r a -> Snippet db r
forall db r a b.
(SqlDb db, Expression db r a, Expression db r b) =>
Int -> String -> a -> b -> Snippet db r
operator Int
60 String
"-" Expr db r a
a Expr db r a
b
  Expr db r a
a * :: Expr db r a -> Expr db r a -> Expr db r a
* Expr db r a
b = Snippet db r -> Expr db r a
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet db r -> Expr db r a) -> Snippet db r -> Expr db r a
forall a b. (a -> b) -> a -> b
$ Int -> String -> Expr db r a -> Expr db r a -> Snippet db r
forall db r a b.
(SqlDb db, Expression db r a, Expression db r b) =>
Int -> String -> a -> b -> Snippet db r
operator Int
70 String
"*" Expr db r a
a Expr db r a
b
  signum :: Expr db r a -> Expr db r a
signum Expr db r a
a = Expr db r a -> Expr db r a
forall db r x a.
(SqlDb db, ExpressionOf db r x a, Num a) =>
x -> Expr db r a
signum' Expr db r a
a
  abs :: Expr db r a -> Expr db r a
abs Expr db r a
a = Snippet db r -> Expr db r a
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet db r -> Expr db r a) -> Snippet db r -> Expr db r a
forall a b. (a -> b) -> a -> b
$ String -> [UntypedExpr db r] -> Snippet db r
forall db r.
SqlDb db =>
String -> [UntypedExpr db r] -> Snippet db r
function String
"abs" [Expr db r a -> UntypedExpr db r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr Expr db r a
a]
  fromInteger :: Integer -> Expr db r a
fromInteger Integer
a = UntypedExpr db r -> Expr db r a
forall db r a. UntypedExpr db r -> Expr db r a
Expr (UntypedExpr db r -> Expr db r a)
-> UntypedExpr db r -> Expr db r a
forall a b. (a -> b) -> a -> b
$ Int64 -> UntypedExpr db r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr (Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
a :: Int64)

instance (SqlDb db, PersistField a, Fractional a) => Fractional (Expr db r a) where
  Expr db r a
a / :: Expr db r a -> Expr db r a -> Expr db r a
/ Expr db r a
b = Snippet db r -> Expr db r a
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet db r -> Expr db r a) -> Snippet db r -> Expr db r a
forall a b. (a -> b) -> a -> b
$ Int -> String -> Expr db r a -> Expr db r a -> Snippet db r
forall db r a b.
(SqlDb db, Expression db r a, Expression db r b) =>
Int -> String -> a -> b -> Snippet db r
operator Int
70 String
"/" Expr db r a
a Expr db r a
b
  fromRational :: Rational -> Expr db r a
fromRational Rational
a = UntypedExpr db r -> Expr db r a
forall db r a. UntypedExpr db r -> Expr db r a
Expr (UntypedExpr db r -> Expr db r a)
-> UntypedExpr db r -> Expr db r a
forall a b. (a -> b) -> a -> b
$ Double -> UntypedExpr db r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
a :: Double)

instance (FloatingSqlDb db, PersistField a, Floating a) => Floating (Expr db r a) where
  pi :: Expr db r a
pi = Snippet db r -> Expr db r a
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet db r -> Expr db r a) -> Snippet db r -> Expr db r a
forall a b. (a -> b) -> a -> b
$ String -> [UntypedExpr db r] -> Snippet db r
forall db r.
SqlDb db =>
String -> [UntypedExpr db r] -> Snippet db r
function String
"pi" []
  exp :: Expr db r a -> Expr db r a
exp Expr db r a
x = Snippet db r -> Expr db r a
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet db r -> Expr db r a) -> Snippet db r -> Expr db r a
forall a b. (a -> b) -> a -> b
$ String -> [UntypedExpr db r] -> Snippet db r
forall db r.
SqlDb db =>
String -> [UntypedExpr db r] -> Snippet db r
function String
"exp" [Expr db r a -> UntypedExpr db r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr Expr db r a
x]
  sqrt :: Expr db r a -> Expr db r a
sqrt Expr db r a
x = Snippet db r -> Expr db r a
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet db r -> Expr db r a) -> Snippet db r -> Expr db r a
forall a b. (a -> b) -> a -> b
$ String -> [UntypedExpr db r] -> Snippet db r
forall db r.
SqlDb db =>
String -> [UntypedExpr db r] -> Snippet db r
function String
"sqrt" [Expr db r a -> UntypedExpr db r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr Expr db r a
x]
  log :: Expr db r a -> Expr db r a
log Expr db r a
x = Expr db r a -> Expr db r a
forall db r x a.
(FloatingSqlDb db, ExpressionOf db r x a, Floating a) =>
x -> Expr db r a
log' Expr db r a
x
  Expr db r a
x ** :: Expr db r a -> Expr db r a -> Expr db r a
** Expr db r a
y = Snippet db r -> Expr db r a
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet db r -> Expr db r a) -> Snippet db r -> Expr db r a
forall a b. (a -> b) -> a -> b
$ String -> [UntypedExpr db r] -> Snippet db r
forall db r.
SqlDb db =>
String -> [UntypedExpr db r] -> Snippet db r
function String
"pow" [Expr db r a -> UntypedExpr db r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr Expr db r a
x, Expr db r a -> UntypedExpr db r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr Expr db r a
y]
  logBase :: Expr db r a -> Expr db r a -> Expr db r a
logBase Expr db r a
b Expr db r a
x = Expr db r a -> Expr db r a -> Expr db r a
forall db r b a x.
(FloatingSqlDb db, ExpressionOf db r b a, ExpressionOf db r x a,
 Floating a) =>
b -> x -> Expr db r a
logBase' Expr db r a
b Expr db r a
x
  sin :: Expr db r a -> Expr db r a
sin Expr db r a
x = Snippet db r -> Expr db r a
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet db r -> Expr db r a) -> Snippet db r -> Expr db r a
forall a b. (a -> b) -> a -> b
$ String -> [UntypedExpr db r] -> Snippet db r
forall db r.
SqlDb db =>
String -> [UntypedExpr db r] -> Snippet db r
function String
"sin" [Expr db r a -> UntypedExpr db r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr Expr db r a
x]
  tan :: Expr db r a -> Expr db r a
tan Expr db r a
x = Snippet db r -> Expr db r a
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet db r -> Expr db r a) -> Snippet db r -> Expr db r a
forall a b. (a -> b) -> a -> b
$ String -> [UntypedExpr db r] -> Snippet db r
forall db r.
SqlDb db =>
String -> [UntypedExpr db r] -> Snippet db r
function String
"tan" [Expr db r a -> UntypedExpr db r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr Expr db r a
x]
  cos :: Expr db r a -> Expr db r a
cos Expr db r a
x = Snippet db r -> Expr db r a
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet db r -> Expr db r a) -> Snippet db r -> Expr db r a
forall a b. (a -> b) -> a -> b
$ String -> [UntypedExpr db r] -> Snippet db r
forall db r.
SqlDb db =>
String -> [UntypedExpr db r] -> Snippet db r
function String
"cos" [Expr db r a -> UntypedExpr db r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr Expr db r a
x]
  asin :: Expr db r a -> Expr db r a
asin Expr db r a
x = Snippet db r -> Expr db r a
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet db r -> Expr db r a) -> Snippet db r -> Expr db r a
forall a b. (a -> b) -> a -> b
$ String -> [UntypedExpr db r] -> Snippet db r
forall db r.
SqlDb db =>
String -> [UntypedExpr db r] -> Snippet db r
function String
"asin" [Expr db r a -> UntypedExpr db r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr Expr db r a
x]
  atan :: Expr db r a -> Expr db r a
atan Expr db r a
x = Snippet db r -> Expr db r a
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet db r -> Expr db r a) -> Snippet db r -> Expr db r a
forall a b. (a -> b) -> a -> b
$ String -> [UntypedExpr db r] -> Snippet db r
forall db r.
SqlDb db =>
String -> [UntypedExpr db r] -> Snippet db r
function String
"atan" [Expr db r a -> UntypedExpr db r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr Expr db r a
x]
  acos :: Expr db r a -> Expr db r a
acos Expr db r a
x = Snippet db r -> Expr db r a
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet db r -> Expr db r a) -> Snippet db r -> Expr db r a
forall a b. (a -> b) -> a -> b
$ String -> [UntypedExpr db r] -> Snippet db r
forall db r.
SqlDb db =>
String -> [UntypedExpr db r] -> Snippet db r
function String
"acos" [Expr db r a -> UntypedExpr db r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr Expr db r a
x]
  sinh :: Expr db r a -> Expr db r a
sinh Expr db r a
x = (Expr db r a -> Expr db r a
forall a. Floating a => a -> a
exp Expr db r a
x Expr db r a -> Expr db r a -> Expr db r a
forall a. Num a => a -> a -> a
- Expr db r a -> Expr db r a
forall a. Floating a => a -> a
exp (- Expr db r a
x)) Expr db r a -> Expr db r a -> Expr db r a
forall a. Fractional a => a -> a -> a
/ Expr db r a
2
  tanh :: Expr db r a -> Expr db r a
tanh Expr db r a
x = (Expr db r a -> Expr db r a
forall a. Floating a => a -> a
exp (Expr db r a
2 Expr db r a -> Expr db r a -> Expr db r a
forall a. Num a => a -> a -> a
* Expr db r a
x) Expr db r a -> Expr db r a -> Expr db r a
forall a. Num a => a -> a -> a
- Expr db r a
1) Expr db r a -> Expr db r a -> Expr db r a
forall a. Fractional a => a -> a -> a
/ (Expr db r a -> Expr db r a
forall a. Floating a => a -> a
exp (Expr db r a
2 Expr db r a -> Expr db r a -> Expr db r a
forall a. Num a => a -> a -> a
* Expr db r a
x) Expr db r a -> Expr db r a -> Expr db r a
forall a. Num a => a -> a -> a
+ Expr db r a
1)
  cosh :: Expr db r a -> Expr db r a
cosh Expr db r a
x = (Expr db r a -> Expr db r a
forall a. Floating a => a -> a
exp Expr db r a
x Expr db r a -> Expr db r a -> Expr db r a
forall a. Num a => a -> a -> a
+ Expr db r a -> Expr db r a
forall a. Floating a => a -> a
exp (- Expr db r a
x)) Expr db r a -> Expr db r a -> Expr db r a
forall a. Fractional a => a -> a -> a
/ Expr db r a
2
  asinh :: Expr db r a -> Expr db r a
asinh Expr db r a
x = Expr db r a -> Expr db r a
forall a. Floating a => a -> a
log (Expr db r a -> Expr db r a) -> Expr db r a -> Expr db r a
forall a b. (a -> b) -> a -> b
$ Expr db r a
x Expr db r a -> Expr db r a -> Expr db r a
forall a. Num a => a -> a -> a
+ Expr db r a -> Expr db r a
forall a. Floating a => a -> a
sqrt (Expr db r a
x Expr db r a -> Expr db r a -> Expr db r a
forall a. Num a => a -> a -> a
* Expr db r a
x Expr db r a -> Expr db r a -> Expr db r a
forall a. Num a => a -> a -> a
+ Expr db r a
1)
  atanh :: Expr db r a -> Expr db r a
atanh Expr db r a
x = Expr db r a -> Expr db r a
forall a. Floating a => a -> a
log ((Expr db r a
1 Expr db r a -> Expr db r a -> Expr db r a
forall a. Num a => a -> a -> a
+ Expr db r a
x) Expr db r a -> Expr db r a -> Expr db r a
forall a. Fractional a => a -> a -> a
/ (Expr db r a
1 Expr db r a -> Expr db r a -> Expr db r a
forall a. Num a => a -> a -> a
- Expr db r a
x)) Expr db r a -> Expr db r a -> Expr db r a
forall a. Fractional a => a -> a -> a
/ Expr db r a
2
  acosh :: Expr db r a -> Expr db r a
acosh Expr db r a
x = Expr db r a -> Expr db r a
forall a. Floating a => a -> a
log (Expr db r a -> Expr db r a) -> Expr db r a -> Expr db r a
forall a b. (a -> b) -> a -> b
$ Expr db r a
x Expr db r a -> Expr db r a -> Expr db r a
forall a. Num a => a -> a -> a
+ Expr db r a -> Expr db r a
forall a. Floating a => a -> a
sqrt (Expr db r a
x Expr db r a -> Expr db r a -> Expr db r a
forall a. Num a => a -> a -> a
* Expr db r a
x Expr db r a -> Expr db r a -> Expr db r a
forall a. Num a => a -> a -> a
- Expr db r a
1)

instance (SqlDb db, PersistField a, Ord a) => Ord (Expr db r a) where
  compare :: Expr db r a -> Expr db r a -> Ordering
compare = String -> Expr db r a -> Expr db r a -> Ordering
forall a. HasCallStack => String -> a
error String
"compare: instance Ord (Expr db r a) does not have implementation"
  <= :: Expr db r a -> Expr db r a -> Bool
(<=) = String -> Expr db r a -> Expr db r a -> Bool
forall a. HasCallStack => String -> a
error String
"(<=): instance Ord (Expr db r a) does not have implementation"
  max :: Expr db r a -> Expr db r a -> Expr db r a
max Expr db r a
a Expr db r a
b = Snippet db r -> Expr db r a
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet db r -> Expr db r a) -> Snippet db r -> Expr db r a
forall a b. (a -> b) -> a -> b
$ String -> [UntypedExpr db r] -> Snippet db r
forall db r.
SqlDb db =>
String -> [UntypedExpr db r] -> Snippet db r
function String
"max" [Expr db r a -> UntypedExpr db r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr Expr db r a
a, Expr db r a -> UntypedExpr db r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr Expr db r a
b]
  min :: Expr db r a -> Expr db r a -> Expr db r a
min Expr db r a
a Expr db r a
b = Snippet db r -> Expr db r a
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet db r -> Expr db r a) -> Snippet db r -> Expr db r a
forall a b. (a -> b) -> a -> b
$ String -> [UntypedExpr db r] -> Snippet db r
forall db r.
SqlDb db =>
String -> [UntypedExpr db r] -> Snippet db r
function String
"min" [Expr db r a -> UntypedExpr db r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr Expr db r a
a, Expr db r a -> UntypedExpr db r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr Expr db r a
b]

instance (SqlDb db, PersistField a, Real a) => Real (Expr db r a) where
  toRational :: Expr db r a -> Rational
toRational = String -> Expr db r a -> Rational
forall a. HasCallStack => String -> a
error String
"toRational: instance Real (Expr db r a) is made only for Integral superclass constraint"

instance (SqlDb db, PersistField a, Enum a) => Enum (Expr db r a) where
  toEnum :: Int -> Expr db r a
toEnum = String -> Int -> Expr db r a
forall a. HasCallStack => String -> a
error String
"toEnum: instance Enum (Expr db r a) is made only for Integral superclass constraint"
  fromEnum :: Expr db r a -> Int
fromEnum = String -> Expr db r a -> Int
forall a. HasCallStack => String -> a
error String
"fromEnum: instance Enum (Expr db r a) is made only for Integral superclass constraint"

instance (SqlDb db, PurePersistField a, Integral a) => Integral (Expr db r a) where
  quotRem :: Expr db r a -> Expr db r a -> (Expr db r a, Expr db r a)
quotRem Expr db r a
x Expr db r a
y = Expr db r a -> Expr db r a -> (Expr db r a, Expr db r a)
forall db r x a y.
(SqlDb db, ExpressionOf db r x a, ExpressionOf db r y a,
 Integral a) =>
x -> y -> (Expr db r a, Expr db r a)
quotRem' Expr db r a
x Expr db r a
y
  divMod :: Expr db r a -> Expr db r a -> (Expr db r a, Expr db r a)
divMod Expr db r a
x Expr db r a
y = (Expr db r a
div', Expr db r a
mod')
    where
      div' :: Expr db r a
div' = (RenderConfig -> Int -> Expr db r a) -> Expr db r a
forall db a r.
(SqlDb db, PersistField a) =>
(RenderConfig -> Int -> Expr db r a) -> Expr db r a
mkExprWithConf ((RenderConfig -> Int -> Expr db r a) -> Expr db r a)
-> (RenderConfig -> Int -> Expr db r a) -> Expr db r a
forall a b. (a -> b) -> a -> b
$ \RenderConfig
conf Int
_ ->
        let x' :: Expr db r a
x' = RenderConfig -> Expr db r a -> Expr db r a
forall db r a.
(SqlDb db, PersistField a) =>
RenderConfig -> Expr db r a -> Expr db r a
prerenderExpr RenderConfig
conf Expr db r a
x
            y' :: Expr db r a
y' = RenderConfig -> Expr db r a -> Expr db r a
forall db r a.
(SqlDb db, PersistField a) =>
RenderConfig -> Expr db r a -> Expr db r a
prerenderExpr RenderConfig
conf Expr db r a
y
         in [(Cond db r, Expr db r a)] -> Expr db r a -> Expr db r a
forall db r a a' b.
(SqlDb db, ExpressionOf db r a a', ExpressionOf db r b a') =>
[(Cond db r, a)] -> b -> Expr db r a'
case_
              [ (Expr db r a
x' Expr db r a -> a -> Cond db r
forall db r a b.
(Expression db r a, Expression db r b, Unifiable a b) =>
a -> b -> Cond db r
>. a
zero Cond db r -> Cond db r -> Cond db r
forall db r. Cond db r -> Cond db r -> Cond db r
&&. Expr db r a
y' Expr db r a -> a -> Cond db r
forall db r a b.
(Expression db r a, Expression db r b, Unifiable a b) =>
a -> b -> Cond db r
<. a
zero, (Expr db r a
x' Expr db r a -> Expr db r a -> Expr db r a
forall a. Num a => a -> a -> a
- Expr db r a
y' Expr db r a -> Expr db r a -> Expr db r a
forall a. Num a => a -> a -> a
- Expr db r a
1) Expr db r a -> Expr db r a -> Expr db r a
forall a. Integral a => a -> a -> a
`quot` Expr db r a
y'),
                (Expr db r a
x' Expr db r a -> a -> Cond db r
forall db r a b.
(Expression db r a, Expression db r b, Unifiable a b) =>
a -> b -> Cond db r
<. a
zero Cond db r -> Cond db r -> Cond db r
forall db r. Cond db r -> Cond db r -> Cond db r
&&. Expr db r a
y' Expr db r a -> a -> Cond db r
forall db r a b.
(Expression db r a, Expression db r b, Unifiable a b) =>
a -> b -> Cond db r
>. a
zero, (Expr db r a
x' Expr db r a -> Expr db r a -> Expr db r a
forall a. Num a => a -> a -> a
- Expr db r a
y' Expr db r a -> Expr db r a -> Expr db r a
forall a. Num a => a -> a -> a
+ Expr db r a
1) Expr db r a -> Expr db r a -> Expr db r a
forall a. Integral a => a -> a -> a
`quot` Expr db r a
y')
              ]
              (Expr db r a
x' Expr db r a -> Expr db r a -> Expr db r a
forall a. Integral a => a -> a -> a
`quot` Expr db r a
y')
      mod' :: Expr db r a
mod' = (RenderConfig -> Int -> Expr db r a) -> Expr db r a
forall db a r.
(SqlDb db, PersistField a) =>
(RenderConfig -> Int -> Expr db r a) -> Expr db r a
mkExprWithConf ((RenderConfig -> Int -> Expr db r a) -> Expr db r a)
-> (RenderConfig -> Int -> Expr db r a) -> Expr db r a
forall a b. (a -> b) -> a -> b
$ \RenderConfig
conf Int
_ ->
        let x' :: Expr db r a
x' = RenderConfig -> Expr db r a -> Expr db r a
forall db r a.
(SqlDb db, PersistField a) =>
RenderConfig -> Expr db r a -> Expr db r a
prerenderExpr RenderConfig
conf Expr db r a
x
            y' :: Expr db r a
y' = RenderConfig -> Expr db r a -> Expr db r a
forall db r a.
(SqlDb db, PersistField a) =>
RenderConfig -> Expr db r a -> Expr db r a
prerenderExpr RenderConfig
conf Expr db r a
y
         in [(Cond db r, Expr db r a)] -> Expr db r a -> Expr db r a
forall db r a a' b.
(SqlDb db, ExpressionOf db r a a', ExpressionOf db r b a') =>
[(Cond db r, a)] -> b -> Expr db r a'
case_
              [ ( Expr db r a
x' Expr db r a -> a -> Cond db r
forall db r a b.
(Expression db r a, Expression db r b, Unifiable a b) =>
a -> b -> Cond db r
>. a
zero Cond db r -> Cond db r -> Cond db r
forall db r. Cond db r -> Cond db r -> Cond db r
&&. Expr db r a
y' Expr db r a -> a -> Cond db r
forall db r a b.
(Expression db r a, Expression db r b, Unifiable a b) =>
a -> b -> Cond db r
<. a
zero Cond db r -> Cond db r -> Cond db r
forall db r. Cond db r -> Cond db r -> Cond db r
||. Expr db r a
x' Expr db r a -> a -> Cond db r
forall db r a b.
(Expression db r a, Expression db r b, Unifiable a b) =>
a -> b -> Cond db r
<. a
zero Cond db r -> Cond db r -> Cond db r
forall db r. Cond db r -> Cond db r -> Cond db r
&&. Expr db r a
y' Expr db r a -> a -> Cond db r
forall db r a b.
(Expression db r a, Expression db r b, Unifiable a b) =>
a -> b -> Cond db r
>. a
zero,
                  [(Cond db r, Expr db r a)] -> a -> Expr db r a
forall db r a a' b.
(SqlDb db, ExpressionOf db r a a', ExpressionOf db r b a') =>
[(Cond db r, a)] -> b -> Expr db r a'
case_ [((Expr db r a
x' Expr db r a -> Expr db r a -> Expr db r a
forall a. Integral a => a -> a -> a
`rem` Expr db r a
y') Expr db r a -> a -> Cond db r
forall db r a b.
(Expression db r a, Expression db r b, Unifiable a b) =>
a -> b -> Cond db r
/=. a
zero, Expr db r a
x' Expr db r a -> Expr db r a -> Expr db r a
forall a. Integral a => a -> a -> a
`rem` Expr db r a
y' Expr db r a -> Expr db r a -> Expr db r a
forall a. Num a => a -> a -> a
+ Expr db r a
y')] a
zero
                )
              ]
              (Expr db r a
x' Expr db r a -> Expr db r a -> Expr db r a
forall a. Integral a => a -> a -> a
`rem` Expr db r a
y')
      zero :: a
zero = a
0 a -> a -> a
forall a. a -> a -> a
`asTypeOf` (forall db r a. Expr db r a -> a
forall a. HasCallStack => a
undefined :: Expr db r a -> a) Expr db r a
x
  toInteger :: Expr db r a -> Integer
toInteger = String -> Expr db r a -> Integer
forall a. HasCallStack => String -> a
error String
"toInteger: instance Integral (Expr db r a) does not have implementation"

case_ ::
  (SqlDb db, ExpressionOf db r a a', ExpressionOf db r b a') =>
  -- | Conditions
  [(Cond db r, a)] ->
  -- | It is returned when none of conditions is true
  b ->
  Expr db r a'
case_ :: [(Cond db r, a)] -> b -> Expr db r a'
case_ [] b
else_ = UntypedExpr db r -> Expr db r a'
forall db r a. UntypedExpr db r -> Expr db r a
Expr (UntypedExpr db r -> Expr db r a')
-> UntypedExpr db r -> Expr db r a'
forall a b. (a -> b) -> a -> b
$ b -> UntypedExpr db r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr b
else_
case_ [(Cond db r, a)]
cases b
else_ = Snippet db r -> Expr db r a'
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet db r -> Expr db r a') -> Snippet db r -> Expr db r a'
forall a b. (a -> b) -> a -> b
$
  (RenderConfig -> Int -> [RenderS db r]) -> Snippet db r
forall db r.
(RenderConfig -> Int -> [RenderS db r]) -> Snippet db r
Snippet ((RenderConfig -> Int -> [RenderS db r]) -> Snippet db r)
-> (RenderConfig -> Int -> [RenderS db r]) -> Snippet db r
forall a b. (a -> b) -> a -> b
$ \RenderConfig
conf Int
_ ->
    [ RenderS db r
"case "
        RenderS db r -> RenderS db r -> RenderS db r
forall a. Semigroup a => a -> a -> a
<> RenderS db r -> [RenderS db r] -> RenderS db r
forall s. StringLike s => s -> [s] -> s
intercalateS (Char -> RenderS db r
forall a. StringLike a => Char -> a
fromChar Char
' ') (((Cond db r, a) -> RenderS db r)
-> [(Cond db r, a)] -> [RenderS db r]
forall a b. (a -> b) -> [a] -> [b]
map (RenderConfig -> (Cond db r, a) -> RenderS db r
forall db r a.
(SqlDb db, Expression db r a) =>
RenderConfig -> (Cond db r, a) -> RenderS db r
rend RenderConfig
conf) [(Cond db r, a)]
cases)
        RenderS db r -> RenderS db r -> RenderS db r
forall a. Semigroup a => a -> a -> a
<> RenderS db r
" else "
        RenderS db r -> RenderS db r -> RenderS db r
forall a. Semigroup a => a -> a -> a
<> RenderConfig -> UntypedExpr db r -> RenderS db r
forall db r.
SqlDb db =>
RenderConfig -> UntypedExpr db r -> RenderS db r
renderExpr RenderConfig
conf (b -> UntypedExpr db r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr b
else_)
        RenderS db r -> RenderS db r -> RenderS db r
forall a. Semigroup a => a -> a -> a
<> RenderS db r
" end"
    ]
  where
    rend :: RenderConfig -> (Cond db r, a) -> RenderS db r
rend RenderConfig
conf (Cond db r
cond, a
a) = case RenderConfig -> Cond db r -> Maybe (RenderS db r)
forall db r.
SqlDb db =>
RenderConfig -> Cond db r -> Maybe (RenderS db r)
renderCond RenderConfig
conf Cond db r
cond of
      Maybe (RenderS db r)
Nothing -> String -> RenderS db r
forall a. HasCallStack => String -> a
error String
"case_: empty condition"
      Just RenderS db r
cond' -> RenderS db r
"when " RenderS db r -> RenderS db r -> RenderS db r
forall a. Semigroup a => a -> a -> a
<> RenderS db r
cond' RenderS db r -> RenderS db r -> RenderS db r
forall a. Semigroup a => a -> a -> a
<> RenderS db r
" then " RenderS db r -> RenderS db r -> RenderS db r
forall a. Semigroup a => a -> a -> a
<> RenderConfig -> UntypedExpr db r -> RenderS db r
forall db r.
SqlDb db =>
RenderConfig -> UntypedExpr db r -> RenderS db r
renderExpr RenderConfig
conf (a -> UntypedExpr db r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr a
a)