Unify function and nullaryFunction (#258)

This does away with the weird variadic arguments thing we had going on with `function`.

Functions with no arguments are now written as:

```haskell
now :: Expr UTCTime
now = function "now" ()
```

Functions with multiple arguments are now written as:

```haskell
quot :: Sql DBIntegral a => Expr a -> Expr a -> Expr a
quot n d = function "div" (n, d)
```

Single-argument functions are written exactly as before.

changelog.d/20230711_132437_shane.obrien_function.md

@@ -0,0 +1,38 @@
+<!--
+A new scriv changelog fragment.
+
+Uncomment the section that is right (remove the HTML comment wrapper).
+-->
+
+### Removed
+
+- Removed `nullaryFunction`. Instead `function` can be called with `()`.
+
+<!--
+### Added
+
+- A bullet item for the Added category.
+
+-->
+### Changed
+
+- `function` has been changed to accept a single argument (as opposed to variadic arguments). See [#258](https://github.com/circuithub/rel8/pull/258) for more details.
+
+<!--
+### Deprecated
+
+- A bullet item for the Deprecated category.
+
+-->
+<!--
+### Fixed
+
+- A bullet item for the Fixed category.
+
+-->
+<!--
+### Security
+
+- A bullet item for the Security category.
+
+-->

src/Rel8.hs

@@ -198,9 +198,8 @@ module Rel8
   , leastExpr, greatestExpr
 
     -- ** Functions
-  , Function
+  , Arguments
   , function
-  , nullaryFunction
   , binaryOperator
 
     -- * Queries

src/Rel8/Expr.hs

@@ -24,7 +24,7 @@ import Prelude hiding ( null )
 import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
 
 -- rel8
-import Rel8.Expr.Function ( function, nullaryFunction )
+import Rel8.Expr.Function (function)
 import Rel8.Expr.Null ( liftOpNull, nullify )
 import Rel8.Expr.Opaleye
   ( castExpr
@@ -94,12 +94,12 @@ instance Sql DBFractional a => Fractional (Expr a) where
 
 
 instance Sql DBFloating a => Floating (Expr a) where
-  pi = nullaryFunction "PI"
+  pi = function "PI" ()
   exp = function "exp"
   log = function "ln"
   sqrt = function "sqrt"
   (**) = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:^))
-  logBase = function "log"
+  logBase a b = function "log" (a, b)
   sin = function "sin"
   cos = function "cos"
   tan = function "tan"

src/Rel8/Expr/Function.hs

@@ -7,8 +7,7 @@
 {-# language UndecidableInstances #-}
 
 module Rel8.Expr.Function
-  ( Function, function
-  , nullaryFunction
+  ( Arguments, function
   , binaryOperator
   )
 where
@@ -21,43 +20,41 @@ import Prelude
 import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
 
 -- rel8
-import {-# SOURCE #-} Rel8.Expr ( Expr( Expr ) )
+import {-# SOURCE #-} Rel8.Expr (Expr)
 import Rel8.Expr.Opaleye
   ( castExpr
   , fromPrimExpr, toPrimExpr, zipPrimExprsWith
   )
+import Rel8.Schema.HTable (hfoldMap)
 import Rel8.Schema.Null ( Sql )
 import Rel8.Schema.QualifiedName (QualifiedName, ppQualifiedName)
+import Rel8.Table (Table, toColumns)
 import Rel8.Type ( DBType )
 
 
--- | This type class exists to allow 'function' to have arbitrary arity. It's
--- mostly an implementation detail, and typical uses of 'Function' shouldn't
--- need this to be specified.
-type Function :: Type -> Type -> Constraint
-class Function arg res where
-  applyArgument :: ([Opaleye.PrimExpr] -> Opaleye.PrimExpr) -> arg -> res
+-- | This type class is basically @'Table' 'Expr'@, where each column of the
+-- 'Table' is an argument to the function, but it also has an additional
+-- instance for @()@ for calling functions with no arguments.
+type Arguments :: Type -> Constraint
+class Arguments a where
+  arguments :: a -> [Opaleye.PrimExpr]
 
 
-instance (arg ~ Expr a, Sql DBType b) => Function arg (Expr b) where
-  applyArgument f a = castExpr $ fromPrimExpr $ f [toPrimExpr a]
+instance Table Expr a => Arguments a where
+  arguments = hfoldMap (pure . toPrimExpr) . toColumns
 
 
-instance (arg ~ Expr a, Function args res) => Function arg (args -> res) where
-  applyArgument f a = applyArgument (f . (toPrimExpr a :))
+instance {-# OVERLAPS #-} Arguments () where
+  arguments _ = []
 
 
--- | Construct an n-ary function that produces an 'Expr' that when called runs
--- a SQL function.
-function :: Function args result => QualifiedName -> args -> result
-function = applyArgument . Opaleye.FunExpr . show . ppQualifiedName
-
-
--- | Construct a function call for functions with no arguments.
-nullaryFunction :: Sql DBType a => QualifiedName -> Expr a
-nullaryFunction qualified = castExpr $ Expr (Opaleye.FunExpr name [])
+-- | @'function' name arguments@ runs the PostgreSQL function @name@ with
+-- the arguments @arguments@ returning an @'Expr' a@.
+function :: (Arguments arguments, Sql DBType a)
+  => QualifiedName -> arguments -> Expr a
+function qualified = castExpr . fromPrimExpr . Opaleye.FunExpr name . arguments
   where
-    name = show $ ppQualifiedName qualified
+    name = show (ppQualifiedName qualified)
 
 
 -- | Construct an expression by applying an infix binary operator to two

src/Rel8/Expr/Num.hs

@@ -19,7 +19,7 @@ import Prelude ( (+), (-), fst, negate, signum, snd )
 -- rel
 import Rel8.Expr ( Expr( Expr ) )
 import Rel8.Expr.Eq ( (==.) )
-import Rel8.Expr.Function ( function )
+import Rel8.Expr.Function (function)
 import Rel8.Expr.Opaleye ( castExpr )
 import Rel8.Schema.Null ( Homonullable, Sql )
 import Rel8.Table.Bool ( bool )
@@ -72,13 +72,13 @@ divMod n d = bool qr (q - 1, r + d) (signum r ==. negate (signum d))
 -- PostgreSQL, which behaves like Haskell's 'Prelude.quot' rather than
 -- 'Prelude.div'.
 quot :: Sql DBIntegral a => Expr a -> Expr a -> Expr a
-quot = function "div"
+quot n d = function "div" (n, d)
 
 
 -- | Corresponds to the @mod()@ function in PostgreSQL, which behaves like
 -- Haskell's 'Prelude.rem' rather than 'Prelude.mod'.
 rem :: Sql DBIntegral a => Expr a -> Expr a -> Expr a
-rem = function "mod"
+rem n d = function "mod" (n, d)
 
 
 -- | Simultaneous 'quot' and 'rem'.

src/Rel8/Expr/Text.hs

@@ -35,7 +35,7 @@ import Data.ByteString ( ByteString )
 
 -- rel8
 import Rel8.Expr ( Expr )
-import Rel8.Expr.Function ( binaryOperator, function, nullaryFunction )
+import Rel8.Expr.Function (binaryOperator, function)
 
 -- text
 import Data.Text (Text)
@@ -121,7 +121,7 @@ ascii = function "ascii"
 
 -- | Corresponds to the @btrim@ function.
 btrim :: Expr Text -> Maybe (Expr Text) -> Expr Text
-btrim a (Just b) = function "btrim" a b
+btrim a (Just b) = function "btrim" (a, b)
 btrim a Nothing = function "btrim" a
 
 
@@ -132,27 +132,27 @@ chr = function "chr"
 
 -- | Corresponds to the @convert@ function.
 convert :: Expr ByteString -> Expr Text -> Expr Text -> Expr ByteString
-convert = function "convert"
+convert a b c = function "convert" (a, b, c)
 
 
 -- | Corresponds to the @convert_from@ function.
 convertFrom :: Expr ByteString -> Expr Text -> Expr Text
-convertFrom = function "convert_from"
+convertFrom a b = function "convert_from" (a, b)
 
 
 -- | Corresponds to the @convert_to@ function.
 convertTo :: Expr Text -> Expr Text -> Expr ByteString
-convertTo = function "convert_to"
+convertTo a b = function "convert_to" (a, b)
 
 
 -- | Corresponds to the @decode@ function.
 decode :: Expr Text -> Expr Text -> Expr ByteString
-decode = function "decode"
+decode a b = function "decode" (a, b)
 
 
 -- | Corresponds to the @encode@ function.
 encode :: Expr ByteString -> Expr Text -> Expr Text
-encode = function "encode"
+encode a b = function "encode" (a, b)
 
 
 -- | Corresponds to the @initcap@ function.
@@ -162,7 +162,7 @@ initcap = function "initcap"
 
 -- | Corresponds to the @left@ function.
 left :: Expr Text -> Expr Int32 -> Expr Text
-left = function "left"
+left a b = function "left" (a, b)
 
 
 -- | Corresponds to the @length@ function.
@@ -172,18 +172,18 @@ length = function "length"
 
 -- | Corresponds to the @length@ function.
 lengthEncoding :: Expr ByteString -> Expr Text -> Expr Int32
-lengthEncoding = function "length"
+lengthEncoding a b = function "length" (a, b)
 
 
 -- | Corresponds to the @lpad@ function.
 lpad :: Expr Text -> Expr Int32 -> Maybe (Expr Text) -> Expr Text
-lpad a b (Just c) = function "lpad" a b c
-lpad a b Nothing = function "lpad" a b
+lpad a b (Just c) = function "lpad" (a, b, c)
+lpad a b Nothing = function "lpad" (a, b)
 
 
 -- | Corresponds to the @ltrim@ function.
 ltrim :: Expr Text -> Maybe (Expr Text) -> Expr Text
-ltrim a (Just b) = function "ltrim" a b
+ltrim a (Just b) = function "ltrim" (a, b)
 ltrim a Nothing = function "ltrim" a
 
 
@@ -194,7 +194,7 @@ md5 = function "md5"
 
 -- | Corresponds to the @pg_client_encoding()@ expression.
 pgClientEncoding :: Expr Text
-pgClientEncoding = nullaryFunction "pg_client_encoding"
+pgClientEncoding = function "pg_client_encoding" ()
 
 
 -- | Corresponds to the @quote_ident@ function.
@@ -215,25 +215,25 @@ quoteNullable = function "quote_nullable"
 -- | Corresponds to the @regexp_replace@ function.
 regexpReplace :: ()
   => Expr Text -> Expr Text -> Expr Text -> Maybe (Expr Text) -> Expr Text
-regexpReplace a b c (Just d) = function "regexp_replace" a b c d
-regexpReplace a b c Nothing = function "regexp_replace" a b c
+regexpReplace a b c (Just d) = function "regexp_replace" (a, b, c, d)
+regexpReplace a b c Nothing = function "regexp_replace" (a, b, c)
 
 
 -- | Corresponds to the @regexp_split_to_array@ function.
 regexpSplitToArray :: ()
   => Expr Text -> Expr Text -> Maybe (Expr Text) -> Expr [Text]
-regexpSplitToArray a b (Just c) = function "regexp_split_to_array" a b c
-regexpSplitToArray a b Nothing = function "regexp_split_to_array" a b
+regexpSplitToArray a b (Just c) = function "regexp_split_to_array" (a, b, c)
+regexpSplitToArray a b Nothing = function "regexp_split_to_array" (a, b)
 
 
 -- | Corresponds to the @repeat@ function.
 repeat :: Expr Text -> Expr Int32 -> Expr Text
-repeat = function "repeat"
+repeat a b = function "repeat" (a, b)
 
 
 -- | Corresponds to the @replace@ function.
 replace :: Expr Text -> Expr Text -> Expr Text -> Expr Text
-replace = function "replace"
+replace a b c = function "replace" (a, b, c)
 
 
 -- | Corresponds to the @reverse@ function.
@@ -243,40 +243,40 @@ reverse = function "reverse"
 
 -- | Corresponds to the @right@ function.
 right :: Expr Text -> Expr Int32 -> Expr Text
-right = function "right"
+right a b = function "right" (a, b)
 
 
 -- | Corresponds to the @rpad@ function.
 rpad :: Expr Text -> Expr Int32 -> Maybe (Expr Text) -> Expr Text
-rpad a b (Just c) = function "rpad" a b c
-rpad a b Nothing = function "rpad" a b
+rpad a b (Just c) = function "rpad" (a, b, c)
+rpad a b Nothing = function "rpad" (a, b)
 
 
 -- | Corresponds to the @rtrim@ function.
 rtrim :: Expr Text -> Maybe (Expr Text) -> Expr Text
-rtrim a (Just b) = function "rtrim" a b
+rtrim a (Just b) = function "rtrim" (a, b)
 rtrim a Nothing = function "rtrim" a
 
 
 -- | Corresponds to the @split_part@ function.
 splitPart :: Expr Text -> Expr Text -> Expr Int32 -> Expr Text
-splitPart = function "split_part"
+splitPart a b c = function "split_part" (a, b, c)
 
 
 -- | Corresponds to the @strpos@ function.
 strpos :: Expr Text -> Expr Text -> Expr Int32
-strpos = function "strpos"
+strpos a b = function "strpos" (a, b)
 
 
 -- | Corresponds to the @substr@ function.
 substr :: Expr Text -> Expr Int32 -> Maybe (Expr Int32) -> Expr Text
-substr a b (Just c) = function "substr" a b c
-substr a b Nothing = function "substr" a b
+substr a b (Just c) = function "substr" (a, b, c)
+substr a b Nothing = function "substr" (a, b)
 
 
 -- | Corresponds to the @translate@ function.
 translate :: Expr Text -> Expr Text -> Expr Text -> Expr Text
-translate = function "translate"
+translate a b c = function "translate" (a, b, c)
 
 
 -- | @like x y@ corresponds to the expression @y LIKE x@.

src/Rel8/Expr/Time.hs

@@ -32,7 +32,7 @@ import Prelude
 
 -- rel8
 import Rel8.Expr ( Expr )
-import Rel8.Expr.Function ( binaryOperator, nullaryFunction )
+import Rel8.Expr.Function (binaryOperator, function)
 import Rel8.Expr.Opaleye ( castExpr, unsafeCastExpr, unsafeLiteral )
 
 -- time
@@ -73,7 +73,7 @@ subtractDays = flip (binaryOperator "-")
 
 -- | Corresponds to @now()@.
 now :: Expr UTCTime
-now = nullaryFunction "now"
+now = function "now" ()
 
 
 -- | Add a time interval to a point in time, yielding a new point in time.