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