on eb180fa help sign in
rel8/src/Rel8/Expr/Function.hs
91 lines 2.4 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 ( Sql )
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, Sql DBType b) => Function arg (Expr b) where
38 applyArgument f a = castExpr $ fromPrimExpr $ f [toPrimExpr a]
41instance (arg ~ Expr a, Function args res) => Function arg (args -> res) where
42 applyArgument f a = applyArgument (f . (toPrimExpr a :))
45-- | Construct an n-ary function that produces an 'Expr' that when called runs
46-- a SQL function.
47--
48-- For example, here's how we can wrap PostgreSQL's @factorial@ function:
49--
50-- >>> :{
51-- factorial :: Expr Int64 -> Expr Data.Scientific.Scientific
52-- factorial = function "factorial"
53-- :}
54--
55-- >>> select c $ pure $ factorial 5
56-- [120.0]
57--
58-- The same approach works for any number of arguments:
59--
60-- >>> :{
61-- power :: Expr Float -> Expr Float -> Expr Double
62-- power = function "power"
63-- :}
64--
65-- >>> select c $ pure $ power 9 3
66-- [729.0]
67function :: Function args result => String -> args -> result
68function = applyArgument . Opaleye.FunExpr
71-- | Construct a function call for functions with no arguments.
72--
73-- For example, we can call the database function @pi()@ by using
74-- @nullaryFunction@:
75--
76-- >>> :{
77-- sqlPi :: Expr Double
78-- sqlPi = nullaryFunction "pi"
79-- :}
80--
81-- >>> select c $ pure $ sqlPi
82-- [3.141592653589793]
83nullaryFunction :: Sql DBType a => String -> Expr a
84nullaryFunction name = castExpr $ Expr (Opaleye.FunExpr name [])
87-- | Construct an expression by applying an infix binary operator to two
88-- operands.
89binaryOperator :: Sql DBType c => String -> Expr a -> Expr b -> Expr c
90binaryOperator operator a b =
91 castExpr $ zipPrimExprsWith (Opaleye.BinExpr (Opaleye.OpOther operator)) a b