git.iko.soy/rel8
on f3daaff help sign in
rel8/src/Rel8/Expr.hs
87 lines 2.4 kB history raw
1{-# language DataKinds #-}
2{-# language DerivingStrategies #-}
3{-# language FlexibleContexts #-}
4{-# language GADTs #-}
5{-# language RoleAnnotations #-}
6{-# language ScopedTypeVariables #-}
7{-# language StandaloneKindSignatures #-}
8{-# language TypeApplications #-}
9{-# language UndecidableInstances #-}
11module Rel8.Expr
12 ( Expr(..)
13 )
14where
16-- base
17import Data.Kind ( Type )
18import Data.String ( IsString, fromString )
19import Prelude hiding ( null )
21-- opaleye
22import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
24-- rel8
25import Rel8.Expr.Null ( liftOpNullable, nullify )
26import Rel8.Expr.Opaleye
27 ( castExpr
28 , fromPrimExpr
29 , mapPrimExpr
30 , zipPrimExprsWith
31 )
32import Rel8.Expr.Serialize ( litExpr )
33import Rel8.Schema.Nullability
34 ( Nullability( Nullable, NonNullable )
35 , Sql, nullabilization
36 )
37import Rel8.Type ( DBType )
38import Rel8.Type.Monoid ( DBMonoid, memptyExpr )
39import Rel8.Type.Num ( DBFractional, DBNum )
40import Rel8.Type.Semigroup ( DBSemigroup, (<>.) )
43-- | Typed SQL expressions.
44type role Expr representational
45type Expr :: Type -> Type
46newtype Expr a = Expr Opaleye.PrimExpr
47 deriving stock Show
50instance Sql DBSemigroup a => Semigroup (Expr a) where
51 (<>) = case nullabilization @a of
52 Nullable -> liftOpNullable (<>.)
53 NonNullable -> (<>.)
54 {-# INLINABLE (<>) #-}
57instance Sql DBMonoid a => Monoid (Expr a) where
58 mempty = case nullabilization @a of
59 Nullable -> nullify memptyExpr
60 NonNullable -> memptyExpr
61 {-# INLINABLE mempty #-}
64instance (Sql IsString a, Sql DBType a) => IsString (Expr a) where
65 fromString = litExpr . case nullabilization @a of
66 Nullable -> Just . fromString
67 NonNullable -> fromString
70instance Sql DBNum a => Num (Expr a) where
71 (+) = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:+))
72 (*) = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:*))
73 (-) = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:-))
75 abs = mapPrimExpr (Opaleye.UnExpr Opaleye.OpAbs)
76 negate = mapPrimExpr (Opaleye.UnExpr Opaleye.OpNegate)
78 signum = castExpr . mapPrimExpr (Opaleye.UnExpr (Opaleye.UnOpOther "SIGN"))
80 fromInteger = castExpr . fromPrimExpr . Opaleye.ConstExpr . Opaleye.IntegerLit
83instance Sql DBFractional a => Fractional (Expr a) where
84 (/) = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:/))
86 fromRational =
87 castExpr . Expr . Opaleye.ConstExpr . Opaleye.NumericLit . realToFrac