Add instance of UnsafeSqlFunctionArgument () (#159)

* Add instance of UnsafeSqlFunctionArgument ()

* Use now, clean a warn

changelog.md

@@ -1,3 +1,10 @@
+3.2.1
+========
+
+- @parsonsmatt
+  = [#159](https://github.com/bitemyapp/esqueleto/pull/159): Add an instance of `UnsafeSqlFunction ()` for 0-argument SQL
+  functions.
+
 3.2.0
 ========
 

esqueleto.cabal

@@ -1,7 +1,7 @@
 cabal-version: 1.12
 
 name:           esqueleto
-version:        3.2.0
+version:        3.2.1
 synopsis:       Type-safe EDSL for SQL queries on persistent backends.
 description:    @esqueleto@ is a bare bones, type-safe EDSL for SQL queries that works with unmodified @persistent@ SQL backends.  Its language closely resembles SQL, so you don't have to learn new concepts, just new syntax, and it's fairly easy to predict the generated SQL and optimize it for your backend. Most kinds of errors committed when writing SQL are caught as compile-time errors---although it is possible to write type-checked @esqueleto@ queries that fail at runtime.
                 .

src/Database/Esqueleto/Internal/Internal.hs

@@ -1053,12 +1053,12 @@ instance FinalResult (Unique val) where
 instance (FinalResult b) => FinalResult (a -> b) where
   finalR f = finalR (f undefined)
 
--- | Convert a constructor for a 'Unique' key on a record to the 'UniqueDef' that defines it. You 
+-- | Convert a constructor for a 'Unique' key on a record to the 'UniqueDef' that defines it. You
--- can supply just the constructor itself, or a value of the type - the library is capable of figuring 
+-- can supply just the constructor itself, or a value of the type - the library is capable of figuring
 -- it out from there.
 --
 -- @since 3.1.3
-toUniqueDef :: forall a val. (KnowResult a ~ (Unique val), PersistEntity val,FinalResult a) => 
+toUniqueDef :: forall a val. (KnowResult a ~ (Unique val), PersistEntity val,FinalResult a) =>
   a -> UniqueDef
 toUniqueDef uniqueConstructor = uniqueDef
   where
@@ -1071,9 +1071,9 @@ toUniqueDef uniqueConstructor = uniqueDef
     uniqueDef = head . filter filterF . entityUniques . entityDef $ proxy
 
 -- | Render updates to be use in a SET clause for a given sql backend.
--- 
+--
 -- @since 3.1.3
-renderUpdates :: (BackendCompatible SqlBackend backend) => 
+renderUpdates :: (BackendCompatible SqlBackend backend) =>
     backend
     -> [SqlExpr (Update val)]
     -> (TLB.Builder, [PersistValue])
@@ -2025,6 +2025,13 @@ unsafeSqlCastAs _ (ECompositeKey _) = throw (CompositeKeyErr SqlCastAsError)
 
 class UnsafeSqlFunctionArgument a where
   toArgList :: a -> [SqlExpr (Value ())]
+
+-- | Useful for 0-argument functions, like @now@ in Postgresql.
+--
+-- @since 3.2.1
+instance UnsafeSqlFunctionArgument () where
+  toArgList _ = []
+
 instance (a ~ Value b) => UnsafeSqlFunctionArgument (SqlExpr a) where
   toArgList = (:[]) . veryUnsafeCoerceSqlExprValue
 instance UnsafeSqlFunctionArgument a =>

src/Database/Esqueleto/PostgreSQL.hs

@@ -35,7 +35,7 @@ import           Data.Time.Clock                              (UTCTime)
 import           Database.Esqueleto.Internal.Language         hiding (random_)
 import           Database.Esqueleto.Internal.PersistentImport hiding (upsert, upsertBy)
 import           Database.Esqueleto.Internal.Sql
-import           Database.Esqueleto.Internal.Internal         (EsqueletoError(..), CompositeKeyError(..), 
+import           Database.Esqueleto.Internal.Internal         (EsqueletoError(..), CompositeKeyError(..),
                                                               UnexpectedCaseError(..), SetClause, Ident(..),
                                                               uncommas, FinalResult(..), toUniqueDef,
                                                               KnowResult, renderUpdates)
@@ -44,7 +44,7 @@ import           Data.List.NonEmpty                           ( NonEmpty( (:|) )
 import           Data.Int                                     (Int64)
 import           Data.Proxy                                   (Proxy(..))
 import           Control.Arrow                                ((***), first)
-import           Control.Exception                            (Exception, throw, throwIO)
+import           Control.Exception                            (throw)
 import           Control.Monad                                (void)
 import           Control.Monad.IO.Class                       (MonadIO (..))
 import qualified Control.Monad.Trans.Reader                   as R
@@ -169,7 +169,7 @@ chr :: SqlString s => SqlExpr (Value Int) -> SqlExpr (Value s)
 chr = unsafeSqlFunction "chr"
 
 now_ :: SqlExpr (Value UTCTime)
-now_ = unsafeSqlValue "NOW()"
+now_ = unsafeSqlFunction "NOW" ()
 
 upsert :: (MonadIO m,
       PersistEntity record,
@@ -200,7 +200,7 @@ upsertBy :: (MonadIO m,
 upsertBy uniqueKey record updates = do
   sqlB <- R.ask
   maybe
-    (throw (UnexpectedCaseErr OperationNotSupported)) -- Postgres backend should have connUpsertSql, if this error is thrown, check changes on persistent 
+    (throw (UnexpectedCaseErr OperationNotSupported)) -- Postgres backend should have connUpsertSql, if this error is thrown, check changes on persistent
     (handler sqlB)
     (connUpsertSql sqlB)
   where
@@ -230,7 +230,7 @@ upsertBy uniqueKey record updates = do
 --     deriving Eq Show
 -- |]
 --
--- insertSelectWithConflict 
+-- insertSelectWithConflict
 --   UniqueFoo -- (UniqueFoo undefined) or (UniqueFoo anyNumber) would also work
 --   (from $ \b ->
 --     return $ Foo <# (b ^. BarNum)
@@ -240,18 +240,18 @@ upsertBy uniqueKey record updates = do
 --   )
 -- @
 --
--- Inserts to table Foo all Bar.num values and in case of conflict SomeFooUnique, 
+-- Inserts to table Foo all Bar.num values and in case of conflict SomeFooUnique,
 -- the conflicting value is updated to the current plus the excluded.
 --
 -- @since 3.1.3
 insertSelectWithConflict :: forall a m val. (
     FinalResult a,
-    KnowResult a ~ (Unique val), 
+    KnowResult a ~ (Unique val),
-    MonadIO m, 
+    MonadIO m,
-    PersistEntity val) => 
+    PersistEntity val) =>
   a
   -- ^ Unique constructor or a unique, this is used just to get the name of the postgres constraint, the value(s) is(are) never used, so if you have a unique "MyUnique 0", "MyUnique undefined" would work as well.
-  -> SqlQuery (SqlExpr (Insertion val)) 
+  -> SqlQuery (SqlExpr (Insertion val))
   -- ^ Insert query.
   -> (SqlExpr (Entity val) -> SqlExpr (Entity val) -> [SqlExpr (Update val)])
   -- ^ A list of updates to be applied in case of the constraint being violated. The expression takes the current and excluded value to produce the updates.
@@ -263,11 +263,11 @@ insertSelectWithConflict unique query = void . insertSelectWithConflictCount uni
 -- @since 3.1.3
 insertSelectWithConflictCount :: forall a val m. (
     FinalResult a,
-    KnowResult a ~ (Unique val), 
+    KnowResult a ~ (Unique val),
-    MonadIO m, 
+    MonadIO m,
-    PersistEntity val) => 
+    PersistEntity val) =>
   a
-  -> SqlQuery (SqlExpr (Insertion val)) 
+  -> SqlQuery (SqlExpr (Insertion val))
   -> (SqlExpr (Entity val) -> SqlExpr (Entity val) -> [SqlExpr (Update val)])
   -> SqlWriteT m Int64
 insertSelectWithConflictCount unique query conflictQuery = do
@@ -292,7 +292,7 @@ insertSelectWithConflictCount unique query conflictQuery = do
         TLB.fromText "ON CONFLICT ON CONSTRAINT \"",
         constraint,
         TLB.fromText "\" DO "
-      ] ++ if null updates then [TLB.fromText "NOTHING"] else [      
+      ] ++ if null updates then [TLB.fromText "NOTHING"] else [
         TLB.fromText "UPDATE SET ",
         updatesTLB
       ]),values)

test/PostgreSQL/Test.hs

@@ -25,7 +25,7 @@ import qualified Data.List as L
 import Data.Ord (comparing)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as TE
-import Data.Time.Clock (getCurrentTime, diffUTCTime)
+import Data.Time.Clock (getCurrentTime, diffUTCTime, UTCTime)
 import Database.Esqueleto hiding (random_)
 import qualified Database.Esqueleto.Internal.Sql as ES
 import Database.Esqueleto.PostgreSQL (random_)
@@ -493,6 +493,14 @@ testPostgresModule = do
         [Value (ret :: String)] <- select $ return (EP.chr (val 65))
         liftIO $ ret `shouldBe` "A"
 
+    it "allows unit for functions" $ do
+      vals <- run $ do
+        let
+          fn :: SqlExpr (Value UTCTime)
+          fn = ES.unsafeSqlFunction "now" ()
+        select $ pure fn
+      vals `shouldSatisfy` ((1 ==) . length)
+
     it "works with now" $
       run $ do
         nowDb <- select $ return EP.now_