{-# language DataKinds #-}
{-# language DerivingStrategies #-}
{-# language FlexibleContexts #-}
{-# language FlexibleInstances #-}
{-# language MultiParamTypeClasses #-}
{-# language ScopedTypeVariables #-}
{-# language StandaloneKindSignatures #-}
{-# language TypeApplications #-}
{-# language TypeFamilies #-}
{-# language UndecidableInstances #-}
module Rel8.Expr
( Expr(..)
)
where
import Data.Functor.Identity ( Identity( Identity ) )
import Data.String ( IsString, fromString )
import Prelude hiding ( null )
import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
import Rel8.Expr.Function ( function, nullaryFunction )
import Rel8.Expr.Null ( liftOpNull, nullify )
import Rel8.Expr.Opaleye
( castExpr
, fromPrimExpr
, mapPrimExpr
, zipPrimExprsWith
)
import Rel8.Expr.Serialize ( litExpr )
import Rel8.Schema.HTable.Identity ( HIdentity( HIdentity ) )
import qualified Rel8.Schema.Kind as K
import Rel8.Schema.Null ( Nullity( Null, NotNull ), Sql, nullable )
import Rel8.Table
( Table, Columns, Context, fromColumns, toColumns
, FromExprs, fromResult, toResult
, Transpose
)
import Rel8.Type ( DBType )
import Rel8.Type.Monoid ( DBMonoid, memptyExpr )
import Rel8.Type.Num ( DBFloating, DBFractional, DBNum )
import Rel8.Type.Semigroup ( DBSemigroup, (<>.) )
type Expr :: K.Context
newtype Expr a = Expr Opaleye.PrimExpr
deriving stock Int -> Expr a -> ShowS
forall a. Int -> Expr a -> ShowS
forall a. [Expr a] -> ShowS
forall a. Expr a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Expr a] -> ShowS
$cshowList :: forall a. [Expr a] -> ShowS
show :: Expr a -> String
$cshow :: forall a. Expr a -> String
showsPrec :: Int -> Expr a -> ShowS
$cshowsPrec :: forall a. Int -> Expr a -> ShowS
Show
instance Sql DBSemigroup a => Semigroup (Expr a) where
<> :: Expr a -> Expr a -> Expr a
(<>) = case forall a. Nullable a => Nullity a
nullable @a of
Nullity a
Null -> forall c a b.
DBType c =>
(Expr a -> Expr b -> Expr c)
-> Expr (Maybe a) -> Expr (Maybe b) -> Expr (Maybe c)
liftOpNull forall a. DBSemigroup a => Expr a -> Expr a -> Expr a
(<>.)
Nullity a
NotNull -> forall a. DBSemigroup a => Expr a -> Expr a -> Expr a
(<>.)
{-# INLINABLE (<>) #-}
instance Sql DBMonoid a => Monoid (Expr a) where
mempty :: Expr a
mempty = case forall a. Nullable a => Nullity a
nullable @a of
Nullity a
Null -> forall a. NotNull a => Expr a -> Expr (Maybe a)
nullify forall a. DBMonoid a => Expr a
memptyExpr
Nullity a
NotNull -> forall a. DBMonoid a => Expr a
memptyExpr
{-# INLINABLE mempty #-}
instance (Sql IsString a, Sql DBType a) => IsString (Expr a) where
fromString :: String -> Expr a
fromString = forall a. Sql DBType a => a -> Expr a
litExpr forall b c a. (b -> c) -> (a -> b) -> a -> c
. case forall a. Nullable a => Nullity a
nullable @a of
Nullity a
Null -> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString
Nullity a
NotNull -> forall a. IsString a => String -> a
fromString
instance Sql DBNum a => Num (Expr a) where
+ :: Expr a -> Expr a -> Expr a
(+) = forall a b c.
(PrimExpr -> PrimExpr -> PrimExpr) -> Expr a -> Expr b -> Expr c
zipPrimExprsWith (BinOp -> PrimExpr -> PrimExpr -> PrimExpr
Opaleye.BinExpr BinOp
(Opaleye.:+))
* :: Expr a -> Expr a -> Expr a
(*) = forall a b c.
(PrimExpr -> PrimExpr -> PrimExpr) -> Expr a -> Expr b -> Expr c
zipPrimExprsWith (BinOp -> PrimExpr -> PrimExpr -> PrimExpr
Opaleye.BinExpr BinOp
(Opaleye.:*))
(-) = forall a b c.
(PrimExpr -> PrimExpr -> PrimExpr) -> Expr a -> Expr b -> Expr c
zipPrimExprsWith (BinOp -> PrimExpr -> PrimExpr -> PrimExpr
Opaleye.BinExpr BinOp
(Opaleye.:-))
abs :: Expr a -> Expr a
abs = forall a b. (PrimExpr -> PrimExpr) -> Expr a -> Expr b
mapPrimExpr (UnOp -> PrimExpr -> PrimExpr
Opaleye.UnExpr UnOp
Opaleye.OpAbs)
negate :: Expr a -> Expr a
negate = forall a b. (PrimExpr -> PrimExpr) -> Expr a -> Expr b
mapPrimExpr (UnOp -> PrimExpr -> PrimExpr
Opaleye.UnExpr UnOp
Opaleye.OpNegate)
signum :: Expr a -> Expr a
signum = forall a. Sql DBType a => Expr a -> Expr a
castExpr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (PrimExpr -> PrimExpr) -> Expr a -> Expr b
mapPrimExpr (UnOp -> PrimExpr -> PrimExpr
Opaleye.UnExpr (String -> UnOp
Opaleye.UnOpOther String
"SIGN"))
fromInteger :: Integer -> Expr a
fromInteger = forall a. Sql DBType a => Expr a -> Expr a
castExpr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PrimExpr -> Expr a
fromPrimExpr forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> PrimExpr
Opaleye.ConstExpr forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
Opaleye.IntegerLit
instance Sql DBFractional a => Fractional (Expr a) where
/ :: Expr a -> Expr a -> Expr a
(/) = forall a b c.
(PrimExpr -> PrimExpr -> PrimExpr) -> Expr a -> Expr b -> Expr c
zipPrimExprsWith (BinOp -> PrimExpr -> PrimExpr -> PrimExpr
Opaleye.BinExpr BinOp
(Opaleye.:/))
fromRational :: Rational -> Expr a
fromRational =
forall a. Sql DBType a => Expr a -> Expr a
castExpr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PrimExpr -> Expr a
Expr forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> PrimExpr
Opaleye.ConstExpr forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> Literal
Opaleye.NumericLit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Real a, Fractional b) => a -> b
realToFrac
instance Sql DBFloating a => Floating (Expr a) where
pi :: Expr a
pi = forall a. Sql DBType a => String -> Expr a
nullaryFunction String
"PI"
exp :: Expr a -> Expr a
exp = forall args result.
Function args result =>
String -> args -> result
function String
"exp"
log :: Expr a -> Expr a
log = forall args result.
Function args result =>
String -> args -> result
function String
"ln"
sqrt :: Expr a -> Expr a
sqrt = forall args result.
Function args result =>
String -> args -> result
function String
"sqrt"
** :: Expr a -> Expr a -> Expr a
(**) = forall a b c.
(PrimExpr -> PrimExpr -> PrimExpr) -> Expr a -> Expr b -> Expr c
zipPrimExprsWith (BinOp -> PrimExpr -> PrimExpr -> PrimExpr
Opaleye.BinExpr BinOp
(Opaleye.:^))
logBase :: Expr a -> Expr a -> Expr a
logBase = forall args result.
Function args result =>
String -> args -> result
function String
"log"
sin :: Expr a -> Expr a
sin = forall args result.
Function args result =>
String -> args -> result
function String
"sin"
cos :: Expr a -> Expr a
cos = forall args result.
Function args result =>
String -> args -> result
function String
"cos"
tan :: Expr a -> Expr a
tan = forall args result.
Function args result =>
String -> args -> result
function String
"tan"
asin :: Expr a -> Expr a
asin = forall args result.
Function args result =>
String -> args -> result
function String
"asin"
acos :: Expr a -> Expr a
acos = forall args result.
Function args result =>
String -> args -> result
function String
"acos"
atan :: Expr a -> Expr a
atan = forall args result.
Function args result =>
String -> args -> result
function String
"atan"
sinh :: Expr a -> Expr a
sinh = forall args result.
Function args result =>
String -> args -> result
function String
"sinh"
cosh :: Expr a -> Expr a
cosh = forall args result.
Function args result =>
String -> args -> result
function String
"cosh"
tanh :: Expr a -> Expr a
tanh = forall args result.
Function args result =>
String -> args -> result
function String
"tanh"
asinh :: Expr a -> Expr a
asinh = forall args result.
Function args result =>
String -> args -> result
function String
"asinh"
acosh :: Expr a -> Expr a
acosh = forall args result.
Function args result =>
String -> args -> result
function String
"acosh"
atanh :: Expr a -> Expr a
atanh = forall args result.
Function args result =>
String -> args -> result
function String
"atanh"
instance Sql DBType a => Table Expr (Expr a) where
type Columns (Expr a) = HIdentity a
type Context (Expr a) = Expr
type FromExprs (Expr a) = a
type Transpose to (Expr a) = to a
toColumns :: Expr a -> Columns (Expr a) Expr
toColumns Expr a
a = forall a (context :: Context). context a -> HIdentity a context
HIdentity Expr a
a
fromColumns :: Columns (Expr a) Expr -> Expr a
fromColumns (HIdentity Expr a
a) = Expr a
a
toResult :: FromExprs (Expr a) -> Columns (Expr a) Result
toResult FromExprs (Expr a)
a = forall a (context :: Context). context a -> HIdentity a context
HIdentity (forall a. a -> Identity a
Identity FromExprs (Expr a)
a)
fromResult :: Columns (Expr a) Result -> FromExprs (Expr a)
fromResult (HIdentity (Identity a
a)) = a
a