on e150ff4 help sign in
rel8/src/Rel8/Expr/Function.hs
59 lines 1.6 kB history raw
1{-# language FlexibleContexts #-}
2{-# language FlexibleInstances #-}
3{-# language MultiParamTypeClasses #-}
4{-# language StandaloneKindSignatures #-}
5{-# language TypeFamilies #-}
6{-# language UndecidableInstances #-}
8module Rel8.Expr.Function
9 ( Function, function
10 , nullaryFunction
11 , binaryOperator
12 )
13where
15-- base
16import Data.Kind ( Constraint, Type )
17import Prelude
19-- opaleye
20import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
22-- rel8
23import Rel8.Expr ( Expr( Expr ) )
24import Rel8.Expr.Opaleye
25 ( castExpr
26 , fromPrimExpr, toPrimExpr, zipPrimExprsWith
27 )
28import Rel8.Schema.Nullability ( Nullabilizes )
29import Rel8.Type ( DBType )
32type Function :: Type -> Type -> Constraint
33class Function arg res where
34 applyArgument :: ([Opaleye.PrimExpr] -> Opaleye.PrimExpr) -> arg -> res
37instance (arg ~ Expr a, DBType db, Nullabilizes db b) => Function arg (Expr b)
38 where
39 applyArgument f a = castExpr $ fromPrimExpr $ f [toPrimExpr a]
42instance (arg ~ Expr a, Function args res) => Function arg (args -> res) where
43 applyArgument f a = applyArgument (f . (toPrimExpr a :))
46function :: Function args result => String -> args -> result
47function = applyArgument . Opaleye.FunExpr
50nullaryFunction :: (DBType db, Nullabilizes db a) => String -> Expr a
51nullaryFunction name = castExpr $ Expr (Opaleye.FunExpr name [])
54-- | Construct an expression by applying an infix binary operator to two
55-- operands.
56binaryOperator :: (DBType db, Nullabilizes db c)
57 => String -> Expr a -> Expr b -> Expr c
58binaryOperator operator a b =
59 castExpr $ zipPrimExprsWith (Opaleye.BinExpr (Opaleye.OpOther operator)) a b