git.iko.soy/rel8
on 593e21b help sign in
rel8/src/Rel8/Expr.hs
125 lines 3.5 kB history raw
1{-# language DataKinds #-}
2{-# language DerivingStrategies #-}
3{-# language FlexibleInstances #-}
4{-# language GADTs #-}
5{-# language MultiParamTypeClasses #-}
6{-# language RoleAnnotations #-}
7{-# language ScopedTypeVariables #-}
8{-# language StandaloneKindSignatures #-}
9{-# language TypeApplications #-}
10{-# language TypeFamilies #-}
11{-# language UndecidableInstances #-}
12{-# language UndecidableSuperClasses #-}
14module Rel8.Expr
15 ( Expr(..)
16 , Col( DB, unDB )
17 )
18where
20-- base
21import Data.Functor.Identity ( Identity )
22import Data.Kind ( Type )
23import Data.String ( IsString, fromString )
24import Prelude hiding ( null )
26-- opaleye
27import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
29-- rel8
30import Rel8.Expr.Null ( liftOpNullable, nullify )
31import Rel8.Expr.Opaleye
32 ( castExpr
33 , fromPrimExpr
34 , mapPrimExpr
35 , zipPrimExprsWith
36 )
37import Rel8.Expr.Serialize ( litExpr )
38import Rel8.Schema.Context ( Interpretation, Col )
39import Rel8.Schema.Context.Label ( Labelable, labeler, unlabeler )
40import Rel8.Schema.HTable.Type ( HType( HType ) )
41import Rel8.Schema.Nullability
42 ( Nullability( Nullable, NonNullable )
43 , Sql, nullabilization
44 )
45import Rel8.Schema.Spec ( Spec( Spec ) )
46import Rel8.Table ( Table, Columns, Context, fromColumns, toColumns )
47import Rel8.Table.Recontextualize ( Recontextualize )
48import Rel8.Type ( DBType )
49import Rel8.Type.Monoid ( DBMonoid, memptyExpr )
50import Rel8.Type.Num ( DBFractional, DBNum )
51import Rel8.Type.Semigroup ( DBSemigroup, (<>.) )
54-- | Typed SQL expressions.
55type role Expr representational
56type Expr :: Type -> Type
57newtype Expr a = Expr Opaleye.PrimExpr
58 deriving stock Show
61instance Sql DBSemigroup a => Semigroup (Expr a) where
62 (<>) = case nullabilization @a of
63 Nullable -> liftOpNullable (<>.)
64 NonNullable -> (<>.)
65 {-# INLINABLE (<>) #-}
68instance Sql DBMonoid a => Monoid (Expr a) where
69 mempty = case nullabilization @a of
70 Nullable -> nullify memptyExpr
71 NonNullable -> memptyExpr
72 {-# INLINABLE mempty #-}
75instance (Sql IsString a, Sql DBType a) => IsString (Expr a) where
76 fromString = litExpr . case nullabilization @a of
77 Nullable -> Just . fromString
78 NonNullable -> 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 Interpretation Expr where
102 data Col Expr _spec where
103 DB :: {unDB :: Expr a} -> Col Expr ('Spec labels necessity a)
106instance Sql DBType a => Table Expr (Expr a) where
107 type Columns (Expr a) = HType a
108 type Context (Expr a) = Expr
110 toColumns a = HType (DB a)
111 fromColumns (HType (DB a)) = a
114instance Sql DBType a => Recontextualize Expr Expr (Expr a) (Expr a)
117instance Sql DBType a => Recontextualize Expr Identity (Expr a) (Identity a)
120instance Sql DBType a => Recontextualize Identity Expr (Identity a) (Expr a)
123instance Labelable Expr where
124 labeler (DB a) = DB a
125 unlabeler (DB a) = DB a