git.iko.soy/rel8
on 75d7b32 help sign in
rel8/src/Rel8/Expr.hs
124 lines 3.5 kB history raw
1{-# language DataKinds #-}
2{-# language DerivingStrategies #-}
3{-# language FlexibleInstances #-}
4{-# language MultiParamTypeClasses #-}
5{-# language ScopedTypeVariables #-}
6{-# language StandaloneKindSignatures #-}
7{-# language TypeApplications #-}
8{-# language TypeFamilies #-}
9{-# language UndecidableInstances #-}
11module Rel8.Expr
12 ( Expr(..)
13 )
14where
16-- base
17import Data.Functor.Identity ( Identity( Identity ) )
18import Data.String ( IsString, fromString )
19import Prelude hiding ( null )
21-- opaleye
22import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
24-- rel8
25import Rel8.Expr.Function ( function, nullaryFunction )
26import Rel8.Expr.Null ( liftOpNull, nullify )
27import Rel8.Expr.Opaleye
28 ( castExpr
29 , fromPrimExpr
30 , mapPrimExpr
31 , zipPrimExprsWith
32 )
33import Rel8.Expr.Serialize ( litExpr )
34import Rel8.Schema.HTable.Identity ( HIdentity( HIdentity ) )
35import qualified Rel8.Schema.Kind as K
36import Rel8.Schema.Null ( Nullity( Null, NotNull ), Sql, nullable )
37import Rel8.Table
38 ( Table, Columns, Context, fromColumns, toColumns
39 , FromExprs, fromResult, toResult
40 , Transpose
41 )
42import Rel8.Type ( DBType )
43import Rel8.Type.Monoid ( DBMonoid, memptyExpr )
44import Rel8.Type.Num ( DBFloating, DBFractional, DBNum )
45import Rel8.Type.Semigroup ( DBSemigroup, (<>.) )
48-- | Typed SQL expressions.
49type Expr :: K.Context
50newtype Expr a = Expr Opaleye.PrimExpr
51 deriving stock Show
54instance Sql DBSemigroup a => Semigroup (Expr a) where
55 (<>) = case nullable @a of
56 Null -> liftOpNull (<>.)
57 NotNull -> (<>.)
58 {-# INLINABLE (<>) #-}
61instance Sql DBMonoid a => Monoid (Expr a) where
62 mempty = case nullable @a of
63 Null -> nullify memptyExpr
64 NotNull -> memptyExpr
65 {-# INLINABLE mempty #-}
68instance (Sql IsString a, Sql DBType a) => IsString (Expr a) where
69 fromString = litExpr . case nullable @a of
70 Null -> Just . fromString
71 NotNull -> fromString
74instance Sql DBNum a => Num (Expr a) where
75 (+) = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:+))
76 (*) = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:*))
77 (-) = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:-))
79 abs = mapPrimExpr (Opaleye.UnExpr Opaleye.OpAbs)
80 negate = mapPrimExpr (Opaleye.UnExpr Opaleye.OpNegate)
82 signum = castExpr . mapPrimExpr (Opaleye.UnExpr (Opaleye.UnOpOther "SIGN"))
84 fromInteger = castExpr . fromPrimExpr . Opaleye.ConstExpr . Opaleye.IntegerLit
87instance Sql DBFractional a => Fractional (Expr a) where
88 (/) = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:/))
90 fromRational =
91 castExpr . Expr . Opaleye.ConstExpr . Opaleye.NumericLit . realToFrac
94instance Sql DBFloating a => Floating (Expr a) where
95 pi = nullaryFunction "PI"
96 exp = function "exp"
97 log = function "ln"
98 sqrt = function "sqrt"
99 (**) = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:^))
100 logBase = function "log"
101 sin = function "sin"
102 cos = function "cos"
103 tan = function "tan"
104 asin = function "asin"
105 acos = function "acos"
106 atan = function "atan"
107 sinh = function "sinh"
108 cosh = function "cosh"
109 tanh = function "tanh"
110 asinh = function "asinh"
111 acosh = function "acosh"
112 atanh = function "atanh"
115instance Sql DBType a => Table Expr (Expr a) where
116 type Columns (Expr a) = HIdentity a
117 type Context (Expr a) = Expr
118 type FromExprs (Expr a) = a
119 type Transpose to (Expr a) = to a
121 toColumns a = HIdentity a
122 fromColumns (HIdentity a) = a
123 toResult a = HIdentity (Identity a)
124 fromResult (HIdentity (Identity a)) = a