git.iko.soy/rel8
on fb21075 help sign in
rel8/src/Rel8/Expr.hs
128 lines 3.6 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
17 ( Expr(..)
18 , Col( DB, unDB )
19 )
20where
22-- base
23import Data.Functor.Identity ( Identity )
24import Data.Kind ( Type )
25import Data.String ( IsString, fromString )
26import Prelude hiding ( null )
28-- opaleye
29import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
31-- rel8
32import Rel8.Expr.Null ( liftOpNull, nullify )
33import Rel8.Expr.Opaleye
34 ( castExpr
35 , fromPrimExpr
36 , mapPrimExpr
37 , zipPrimExprsWith
38 )
39import Rel8.Expr.Serialize ( litExpr )
40import Rel8.Schema.Context ( Interpretation, Col )
41import Rel8.Schema.Context.Label ( Labelable, labeler, unlabeler )
42import Rel8.Schema.HTable.Type ( HType( HType ) )
43import Rel8.Schema.Null ( Nullity( Null, NotNull ), Sql, nullable )
44import Rel8.Schema.Result ( Result )
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 :: k -> Type
57data Expr a where
58 Expr :: k ~ Type => !Opaleye.PrimExpr -> Expr (a :: k)
61deriving stock instance Show (Expr a)
64instance Sql DBSemigroup a => Semigroup (Expr a) where
65 (<>) = case nullable @a of
66 Null -> liftOpNull (<>.)
67 NotNull -> (<>.)
68 {-# INLINABLE (<>) #-}
71instance Sql DBMonoid a => Monoid (Expr a) where
72 mempty = case nullable @a of
73 Null -> nullify memptyExpr
74 NotNull -> memptyExpr
75 {-# INLINABLE mempty #-}
78instance (Sql IsString a, Sql DBType a) => IsString (Expr a) where
79 fromString = litExpr . case nullable @a of
80 Null -> Just . fromString
81 NotNull -> fromString
84instance Sql DBNum a => Num (Expr a) where
85 (+) = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:+))
86 (*) = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:*))
87 (-) = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:-))
89 abs = mapPrimExpr (Opaleye.UnExpr Opaleye.OpAbs)
90 negate = mapPrimExpr (Opaleye.UnExpr Opaleye.OpNegate)
92 signum = castExpr . mapPrimExpr (Opaleye.UnExpr (Opaleye.UnOpOther "SIGN"))
94 fromInteger = castExpr . fromPrimExpr . Opaleye.ConstExpr . Opaleye.IntegerLit
97instance Sql DBFractional a => Fractional (Expr a) where
98 (/) = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:/))
100 fromRational =
101 castExpr . Expr . Opaleye.ConstExpr . Opaleye.NumericLit . realToFrac
104instance Interpretation Expr where
105 data Col Expr _spec where
106 DB :: {unDB :: Expr a} -> Col Expr ('Spec labels necessity a)
109instance Sql DBType a => Table Expr (Expr a) where
110 type Columns (Expr a) = HType a
111 type Context (Expr a) = Expr
113 toColumns a = HType (DB a)
114 fromColumns (HType (DB a)) = a
117instance Sql DBType a => Recontextualize Expr Expr (Expr a) (Expr a)
120instance Sql DBType a => Recontextualize Expr Result (Expr a) (Identity a)
123instance Sql DBType a => Recontextualize Result Expr (Identity a) (Expr a)
126instance Labelable Expr where
127 labeler (DB a) = DB a
128 unlabeler (DB a) = DB a