git.iko.soy/rel8
on eb180fa help sign in
rel8/src/Rel8/Expr.hs
86 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, (<>.) )
43type role Expr representational
44type Expr :: Type -> Type
45newtype Expr a = Expr Opaleye.PrimExpr
46 deriving stock Show
49instance Sql DBSemigroup a => Semigroup (Expr a) where
50 (<>) = case nullabilization @a of
51 Nullable -> liftOpNullable (<>.)
52 NonNullable -> (<>.)
53 {-# INLINABLE (<>) #-}
56instance Sql DBMonoid a => Monoid (Expr a) where
57 mempty = case nullabilization @a of
58 Nullable -> nullify memptyExpr
59 NonNullable -> memptyExpr
60 {-# INLINABLE mempty #-}
63instance (Sql IsString a, Sql DBType a) => IsString (Expr a) where
64 fromString = litExpr . case nullabilization @a of
65 Nullable -> Just . fromString
66 NonNullable -> fromString
69instance Sql DBNum a => Num (Expr a) where
70 (+) = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:+))
71 (*) = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:*))
72 (-) = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:-))
74 abs = mapPrimExpr (Opaleye.UnExpr Opaleye.OpAbs)
75 negate = mapPrimExpr (Opaleye.UnExpr Opaleye.OpNegate)
77 signum = castExpr . mapPrimExpr (Opaleye.UnExpr (Opaleye.UnOpOther "SIGN"))
79 fromInteger = castExpr . fromPrimExpr . Opaleye.ConstExpr . Opaleye.IntegerLit
82instance Sql DBFractional a => Fractional (Expr a) where
83 (/) = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:/))
85 fromRational =
86 castExpr . Expr . Opaleye.ConstExpr . Opaleye.NumericLit . realToFrac