git.iko.soy/rel8
on 3c5f54c help sign in
rel8/src/Rel8/Expr/Function.hs
81 lines 2.1 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 , unsafeBinaryOperator
13 )
14where
16-- base
17import Data.Kind ( Constraint, Type )
18import Prelude
20-- opaleye
21import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
23-- rel8
24import Rel8.Expr ( Expr( Expr ) )
25import Rel8.Expr.Opaleye
26 ( castExpr
27 , fromPrimExpr, toPrimExpr, zipPrimExprsWith
28 , unsafeZipPrimExprsWith
29 )
30import Rel8.Kind.Bool ( KnownBool, IsList )
31import Rel8.Schema.Nullability ( Nullabilizes )
32import Rel8.Type ( DBType )
35type Function :: Type -> Type -> Constraint
36class Function arg res where
37 applyArgument :: ([Opaleye.PrimExpr] -> Opaleye.PrimExpr) -> arg -> res
40instance
41 ( arg ~ Expr a
42 , Nullabilizes _a a, KnownBool (IsList _a)
43 , DBType _b, Nullabilizes _b b, KnownBool (IsList _b)
44 )
45 => Function arg (Expr b)
46 where
47 applyArgument f a = castExpr $ fromPrimExpr $ f [toPrimExpr a]
50instance
51 ( arg ~ Expr a
52 , Nullabilizes _a a, KnownBool (IsList _a)
53 , Function args res
54 ) =>
55 Function arg (args -> res)
56 where
57 applyArgument f a = applyArgument (f . (toPrimExpr a :))
60function :: Function args result => String -> args -> result
61function = applyArgument . Opaleye.FunExpr
64nullaryFunction :: (DBType db, Nullabilizes db a) => String -> Expr a
65nullaryFunction name = castExpr $ Expr (Opaleye.FunExpr name [])
68binaryOperator ::
69 ( Nullabilizes _a a, KnownBool (IsList _a)
70 , Nullabilizes _b b, KnownBool (IsList _b)
71 , DBType _c, Nullabilizes _c c, KnownBool (IsList _c)
72 )
73 => String -> Expr a -> Expr b -> Expr c
74binaryOperator operator a b =
75 castExpr $ zipPrimExprsWith (Opaleye.BinExpr (Opaleye.OpOther operator)) a b
78unsafeBinaryOperator :: (DBType _c, Nullabilizes _c c)
79 => String -> Expr a -> Expr b -> Expr c
80unsafeBinaryOperator operator a b =
81 castExpr $ unsafeZipPrimExprsWith (Opaleye.BinExpr (Opaleye.OpOther operator)) a b