git.iko.soy/rel8
on 97d89cf help sign in
rel8/src/Rel8/Expr.hs
133 lines 3.8 kB history raw
1{-# language DataKinds #-}
2{-# language DerivingStrategies #-}
3{-# language FlexibleInstances #-}
4{-# language GADTs #-}
5{-# language MultiParamTypeClasses #-}
6{-# language PolyKinds #-}
7{-# language RoleAnnotations #-}
8{-# language ScopedTypeVariables #-}
9{-# language StandaloneDeriving #-}
10{-# language StandaloneKindSignatures #-}
11{-# language TypeApplications #-}
12{-# language TypeFamilies #-}
13{-# language UndecidableInstances #-}
14{-# language UndecidableSuperClasses #-}
16module Rel8.Expr ( Expr(..) ) where
18-- base
19import Data.Kind ( Type )
20import Data.String ( IsString, fromString )
21import Prelude hiding ( null )
23-- opaleye
24import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
26-- rel8
27import Rel8.Expr.Function ( function, nullaryFunction )
28import Rel8.Expr.Null ( liftOpNull, nullify )
29import Rel8.Expr.Opaleye
30 ( castExpr
31 , fromPrimExpr
32 , mapPrimExpr
33 , zipPrimExprsWith
34 )
35import Rel8.Expr.Serialize ( litExpr )
36import Rel8.Schema.HTable.Identity ( HIdentity( HType ), HType )
37import Rel8.Schema.Null ( Nullity( Null, NotNull ), Sql, nullable )
38import Rel8.Schema.Result ( Result( R ) )
39import Rel8.Schema.Spec ( Spec( Spec ) )
40import Rel8.Table
41 ( Table, Columns, Context, fromColumns, toColumns
42 , FromExprs, fromResult, toResult
43 )
44import Rel8.Table.Recontextualize ( Recontextualize )
45import Rel8.Type ( DBType )
46import Rel8.Type.Monoid ( DBMonoid, memptyExpr )
47import Rel8.Type.Num ( DBFloating, DBFractional, DBNum )
48import Rel8.Type.Semigroup ( DBSemigroup, (<>.) )
51-- | Typed SQL expressions.
52type Expr :: k -> Type
53data Expr a where
54 Expr :: forall (a :: Type). !Opaleye.PrimExpr -> Expr a
55 E :: { unE :: !(Expr a) } -> Expr ('Spec a)
58deriving stock instance Show (Expr a)
61instance Sql DBSemigroup a => Semigroup (Expr a) where
62 (<>) = case nullable @a of
63 Null -> liftOpNull (<>.)
64 NotNull -> (<>.)
65 {-# INLINABLE (<>) #-}
68instance Sql DBMonoid a => Monoid (Expr a) where
69 mempty = case nullable @a of
70 Null -> nullify memptyExpr
71 NotNull -> memptyExpr
72 {-# INLINABLE mempty #-}
75instance (Sql IsString a, Sql DBType a) => IsString (Expr a) where
76 fromString = litExpr . case nullable @a of
77 Null -> Just . fromString
78 NotNull -> fromString
81instance Sql DBNum a => Num (Expr a) where
82 (+) = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:+))
83 (*) = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:*))
84 (-) = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:-))
86 abs = mapPrimExpr (Opaleye.UnExpr Opaleye.OpAbs)
87 negate = mapPrimExpr (Opaleye.UnExpr Opaleye.OpNegate)
89 signum = castExpr . mapPrimExpr (Opaleye.UnExpr (Opaleye.UnOpOther "SIGN"))
91 fromInteger = castExpr . fromPrimExpr . Opaleye.ConstExpr . Opaleye.IntegerLit
94instance Sql DBFractional a => Fractional (Expr a) where
95 (/) = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:/))
97 fromRational =
98 castExpr . Expr . Opaleye.ConstExpr . Opaleye.NumericLit . realToFrac
101instance Sql DBFloating a => Floating (Expr a) where
102 pi = nullaryFunction "PI"
103 exp = function "exp"
104 log = function "ln"
105 sqrt = function "sqrt"
106 (**) = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:^))
107 logBase = function "log"
108 sin = function "sin"
109 cos = function "cos"
110 tan = function "tan"
111 asin = function "asin"
112 acos = function "acos"
113 atan = function "atan"
114 sinh = function "sinh"
115 cosh = function "cosh"
116 tanh = function "tanh"
117 asinh = function "asinh"
118 acosh = function "acosh"
119 atanh = function "atanh"
122instance Sql DBType a => Table Expr (Expr a) where
123 type Columns (Expr a) = HType a
124 type Context (Expr a) = Expr
125 type FromExprs (Expr a) = a
127 toColumns a = HType (E a)
128 fromColumns (HType (E a)) = a
129 toResult a = HType (R a)
130 fromResult (HType (R a)) = a
133instance Sql DBType a => Recontextualize Expr Expr (Expr a) (Expr a)