git.iko.soy/rel8
on 8fefc24 help sign in
rel8/src/Rel8/Expr.hs
84 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 , Nullabilizes, 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 (DBSemigroup db, Nullabilizes db a) => Semigroup (Expr a) where
50 (<>) = case nullabilization @a of
51 Nullable -> liftOpNullable (<>.)
52 NonNullable -> (<>.)
55instance (DBMonoid db, Nullabilizes db a) => Monoid (Expr a) where
56 mempty = case nullabilization @a of
57 Nullable -> nullify memptyExpr
58 NonNullable -> memptyExpr
61instance (IsString db, DBType db, Nullabilizes db a) => IsString (Expr a) where
62 fromString = litExpr . case nullabilization @a of
63 Nullable -> Just . fromString
64 NonNullable -> fromString
67instance (DBNum db, Nullabilizes db a) => Num (Expr a) where
68 (+) = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:+))
69 (*) = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:*))
70 (-) = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:-))
72 abs = mapPrimExpr (Opaleye.UnExpr Opaleye.OpAbs)
73 negate = mapPrimExpr (Opaleye.UnExpr Opaleye.OpNegate)
75 signum = castExpr . mapPrimExpr (Opaleye.UnExpr (Opaleye.UnOpOther "SIGN"))
77 fromInteger = castExpr . fromPrimExpr . Opaleye.ConstExpr . Opaleye.IntegerLit
80instance (DBFractional db, Nullabilizes db a) => Fractional (Expr a) where
81 (/) = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:/))
83 fromRational =
84 castExpr . Expr . Opaleye.ConstExpr . Opaleye.NumericLit . realToFrac