haskell/esqueleto
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add instance of UnsafeSqlFunctionArgument () (#159)

Browse Source 
* Add instance of UnsafeSqlFunctionArgument ()

* Use now, clean a warn
This commit is contained in:
Matt Parsons 2019-10-29 10:03:42 -06:00 committed by GitHub
parent c2ecf9c1a4
commit 096a251c39
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
5 changed files with 44 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
changelog.md
View File

@ -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
========

2
esqueleto.cabal
View File

@ -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.
.

17
src/Database/Esqueleto/Internal/Internal.hs
View File

@ -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
-- can supply just the constructor itself, or a value of the type - the library is capable of figuring
-- | 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
-- 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 =>

30
src/Database/Esqueleto/PostgreSQL.hs
View File

@ -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),
MonadIO m,
PersistEntity val) =>
KnowResult a ~ (Unique val),
MonadIO m,
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),
MonadIO m,
PersistEntity val) =>
KnowResult a ~ (Unique val),
MonadIO m,
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)

10
test/PostgreSQL/Test.hs
View File

@ -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_