mirror of
https://github.com/circuithub/rel8.git
synced 2024-09-11 16:05:41 +03:00
Add more raw/unsafe escape hatches
- `rawFunction`, `rawBinaryOperator`, `rawAggregateFunction`, `unsafeCoerceExpr`, `unsafePrimExpr`, `unsafeSubscript`, `unsafeSubscripts` — these give more options for generating SQL expressions that Rel8 does not support natively.
This commit is contained in:
parent
e214b75565
commit
087d41e584
4
changelog.d/20240701_173914_shane.obrien_raw.md
Normal file
4
changelog.d/20240701_173914_shane.obrien_raw.md
Normal file
@ -0,0 +1,4 @@
|
||||
### Added
|
||||
|
||||
- `rawFunction`, `rawBinaryOperator`, `rawAggregateFunction`, `unsafeCoerceExpr`, `unsafePrimExpr`, `unsafeSubscript`, `unsafeSubscripts` — these give more options for generating SQL expressions that Rel8 does not support natively.
|
||||
|
@ -99,6 +99,7 @@ library
|
||||
Rel8.Expr.Sequence
|
||||
Rel8.Expr.Serialize
|
||||
Rel8.Expr.Show
|
||||
Rel8.Expr.Subscript
|
||||
Rel8.Expr.Window
|
||||
|
||||
Rel8.FCF
|
||||
|
@ -169,7 +169,9 @@ module Rel8
|
||||
, Sql
|
||||
, litExpr
|
||||
, unsafeCastExpr
|
||||
, unsafeCoerceExpr
|
||||
, unsafeLiteral
|
||||
, unsafePrimExpr
|
||||
|
||||
-- ** @null@
|
||||
, NotNull
|
||||
@ -206,6 +208,8 @@ module Rel8
|
||||
, function
|
||||
, binaryOperator
|
||||
, queryFunction
|
||||
, rawFunction
|
||||
, rawBinaryOperator
|
||||
|
||||
-- * Queries
|
||||
, Query
|
||||
@ -293,6 +297,7 @@ module Rel8
|
||||
, and, andOn
|
||||
, or, orOn
|
||||
, aggregateFunction
|
||||
, rawAggregateFunction
|
||||
|
||||
, mode, modeOn
|
||||
, percentile, percentileOn
|
||||
@ -410,7 +415,7 @@ import Rel8.Expr.Default
|
||||
import Rel8.Expr.Eq
|
||||
import Rel8.Expr.Function
|
||||
import Rel8.Expr.Null
|
||||
import Rel8.Expr.Opaleye (unsafeCastExpr, unsafeLiteral)
|
||||
import Rel8.Expr.Opaleye (unsafeCastExpr, unsafeCoerceExpr, unsafeLiteral, unsafePrimExpr)
|
||||
import Rel8.Expr.Ord
|
||||
import Rel8.Expr.Order
|
||||
import Rel8.Expr.Serialize
|
||||
|
@ -3,6 +3,7 @@
|
||||
|
||||
module Rel8.Aggregate.Function (
|
||||
aggregateFunction,
|
||||
rawAggregateFunction,
|
||||
) where
|
||||
|
||||
-- base
|
||||
@ -31,10 +32,14 @@ aggregateFunction ::
|
||||
(Table Expr i, Sql DBType a) =>
|
||||
QualifiedName ->
|
||||
Aggregator1 i (Expr a)
|
||||
aggregateFunction name =
|
||||
aggregateFunction name = castExpr <$> rawAggregateFunction name
|
||||
|
||||
|
||||
rawAggregateFunction :: Table Expr i => QualifiedName -> Aggregator1 i (Expr a)
|
||||
rawAggregateFunction name =
|
||||
unsafeMakeAggregator
|
||||
id
|
||||
(castExpr . fromPrimExpr . fromColumn)
|
||||
(fromPrimExpr . fromColumn)
|
||||
Empty
|
||||
(Opaleye.makeAggrExplicit unpackspec
|
||||
(Opaleye.AggrOther (showQualifiedName name)))
|
||||
|
@ -13,6 +13,10 @@ module Rel8.Array
|
||||
, index1, index1Expr
|
||||
, last1, last1Expr
|
||||
, length1, length1Expr
|
||||
|
||||
-- ** Unsafe
|
||||
, unsafeSubscript
|
||||
, unsafeSubscripts
|
||||
)
|
||||
where
|
||||
|
||||
@ -22,5 +26,6 @@ import Prelude hiding (head, last, length)
|
||||
-- rel8
|
||||
import Rel8.Expr.List
|
||||
import Rel8.Expr.NonEmpty
|
||||
import Rel8.Expr.Subscript
|
||||
import Rel8.Table.List
|
||||
import Rel8.Table.NonEmpty
|
||||
|
@ -24,7 +24,7 @@ import Rel8.Expr.Opaleye ( fromPrimExpr )
|
||||
-- @DEFAULT@ value. Trying to use @unsafeDefault@ where there is no default
|
||||
-- will cause a runtime crash
|
||||
--
|
||||
-- 3. @DEFAULT@ values can not be transformed. For example, the innocuous Rel8
|
||||
-- 3. @DEFAULT@ values cannot be transformed. For example, the innocuous Rel8
|
||||
-- code @unsafeDefault + 1@ will crash, despite type checking.
|
||||
--
|
||||
-- Also note, PostgreSQL's syntax rules mean that @DEFAULT@ can only appear in
|
||||
|
@ -11,7 +11,9 @@ module Rel8.Expr.Function
|
||||
( Arguments
|
||||
, function
|
||||
, primFunction
|
||||
, rawFunction
|
||||
, binaryOperator
|
||||
, rawBinaryOperator
|
||||
)
|
||||
where
|
||||
|
||||
@ -22,19 +24,20 @@ import Prelude
|
||||
-- opaleye
|
||||
import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
|
||||
|
||||
-- pretty
|
||||
import Text.PrettyPrint (parens, text)
|
||||
|
||||
-- rel8
|
||||
import {-# SOURCE #-} Rel8.Expr (Expr)
|
||||
import Rel8.Expr.Opaleye
|
||||
( castExpr
|
||||
, fromPrimExpr, toPrimExpr, zipPrimExprsWith
|
||||
)
|
||||
import Rel8.Schema.Escape (escape)
|
||||
import Rel8.Schema.HTable (hfoldMap)
|
||||
import Rel8.Schema.Null ( Sql )
|
||||
import Rel8.Schema.QualifiedName (QualifiedName (..), showQualifiedName)
|
||||
import Rel8.Schema.QualifiedName
|
||||
( QualifiedName (..)
|
||||
, showQualifiedName
|
||||
, showQualifiedOperator
|
||||
|
||||
)
|
||||
import Rel8.Table (Table, toColumns)
|
||||
import Rel8.Type ( DBType )
|
||||
|
||||
@ -59,7 +62,13 @@ instance {-# OVERLAPS #-} Arguments () where
|
||||
-- the arguments @arguments@ returning an @'Expr' a@.
|
||||
function :: (Arguments arguments, Sql DBType a)
|
||||
=> QualifiedName -> arguments -> Expr a
|
||||
function qualified = castExpr . fromPrimExpr . primFunction qualified
|
||||
function qualified = castExpr . rawFunction qualified
|
||||
|
||||
|
||||
-- | A less safe version of 'function' that does not wrap the return value in
|
||||
-- a cast.
|
||||
rawFunction :: Arguments arguments => QualifiedName -> arguments -> Expr a
|
||||
rawFunction qualified = fromPrimExpr . primFunction qualified
|
||||
|
||||
|
||||
primFunction :: Arguments arguments
|
||||
@ -72,14 +81,13 @@ primFunction qualified = Opaleye.FunExpr name . arguments
|
||||
-- | Construct an expression by applying an infix binary operator to two
|
||||
-- operands.
|
||||
binaryOperator :: Sql DBType c => QualifiedName -> Expr a -> Expr b -> Expr c
|
||||
binaryOperator operator a b =
|
||||
castExpr $ zipPrimExprsWith (Opaleye.BinExpr (Opaleye.OpOther name)) a b
|
||||
binaryOperator operator a b = castExpr $ rawBinaryOperator operator a b
|
||||
|
||||
|
||||
-- | A less safe version of 'binaryOperator' that does not wrap the return
|
||||
-- value in a cast.
|
||||
rawBinaryOperator :: QualifiedName -> Expr a -> Expr b -> Expr c
|
||||
rawBinaryOperator operator a b =
|
||||
zipPrimExprsWith (Opaleye.BinExpr (Opaleye.OpOther name)) a b
|
||||
where
|
||||
name = showQualifiedOperator operator
|
||||
|
||||
|
||||
showQualifiedOperator :: QualifiedName -> String
|
||||
showQualifiedOperator QualifiedName {schema = mschema, ..} = case mschema of
|
||||
Nothing -> name
|
||||
Just schema ->
|
||||
show $ text "OPERATOR" <> parens (escape schema <> text "." <> text name)
|
||||
|
@ -9,6 +9,8 @@
|
||||
module Rel8.Expr.Opaleye
|
||||
( castExpr, unsafeCastExpr
|
||||
, scastExpr, sunsafeCastExpr
|
||||
, unsafeCoerceExpr
|
||||
, unsafePrimExpr
|
||||
, unsafeLiteral
|
||||
, fromPrimExpr, toPrimExpr, mapPrimExpr, zipPrimExprsWith, traversePrimExpr
|
||||
, toColumn, fromColumn, traverseFieldP
|
||||
@ -44,6 +46,22 @@ unsafeCastExpr = case typeInformation @(Unnullify b) of
|
||||
TypeInformation {typeName} -> sunsafeCastExpr typeName
|
||||
|
||||
|
||||
-- | Change the type of an 'Expr', without a cast. Even more unsafe than
|
||||
-- 'unsafeCastExpr'. Only use this if you are certain that the @typeName@s of
|
||||
-- @a@ and @b@ refer to exactly the same PostgreSQL type.
|
||||
unsafeCoerceExpr :: Expr a -> Expr b
|
||||
unsafeCoerceExpr (Expr a) = Expr a
|
||||
|
||||
|
||||
-- | Import a raw 'Opaleye.PrimExpr' from @opaleye@, without a cast.
|
||||
--
|
||||
-- This is an escape hatch, and can be used if Rel8 cannot adequately express
|
||||
-- the expression you need. If you find yourself using this function, please
|
||||
-- let us know, as it may indicate that something is missing from Rel8!
|
||||
unsafePrimExpr :: Opaleye.PrimExpr -> Expr a
|
||||
unsafePrimExpr = fromPrimExpr
|
||||
|
||||
|
||||
scastExpr :: TypeInformation (Unnullify a) -> Expr a -> Expr a
|
||||
scastExpr TypeInformation {typeName} = sunsafeCastExpr typeName
|
||||
|
||||
@ -56,9 +74,9 @@ sunsafeCastExpr name =
|
||||
|
||||
-- | Unsafely construct an expression from literal SQL.
|
||||
--
|
||||
-- This is an escape hatch, and can be used if Rel8 can not adequately express
|
||||
-- the query you need. If you find yourself using this function, please let us
|
||||
-- know, as it may indicate that something is missing from Rel8!
|
||||
-- This is an escape hatch, and can be used if Rel8 cannot adequately express
|
||||
-- the expression you need. If you find yourself using this function, please let
|
||||
-- us know, as it may indicate that something is missing from Rel8!
|
||||
unsafeLiteral :: String -> Expr a
|
||||
unsafeLiteral = Expr . Opaleye.ConstExpr . Opaleye.OtherLit
|
||||
|
||||
|
65
src/Rel8/Expr/Subscript.hs
Normal file
65
src/Rel8/Expr/Subscript.hs
Normal file
@ -0,0 +1,65 @@
|
||||
{-# language FlexibleContexts #-}
|
||||
{-# language MonoLocalBinds #-}
|
||||
|
||||
module Rel8.Expr.Subscript
|
||||
( unsafeSubscript
|
||||
, unsafeSubscripts
|
||||
)
|
||||
where
|
||||
|
||||
-- base
|
||||
import Data.Foldable (foldl')
|
||||
import Prelude
|
||||
|
||||
-- opaleye
|
||||
import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
|
||||
|
||||
-- rel8
|
||||
import Rel8.Expr (Expr)
|
||||
import Rel8.Expr.Opaleye (fromPrimExpr, toPrimExpr)
|
||||
import Rel8.Schema.HTable (hfoldMap)
|
||||
import Rel8.Schema.Null (Sql, Unnullify)
|
||||
import Rel8.Table (Table, toColumns)
|
||||
import Rel8.Type (DBType, typeInformation)
|
||||
import Rel8.Type.Array (extractArrayElement)
|
||||
import Rel8.Type.Information (TypeInformation)
|
||||
|
||||
|
||||
-- | @'unsafeSubscript' a i@ will generate the SQL @a[i]@.
|
||||
--
|
||||
-- Note that this function is not type checked and the generated SQL has no
|
||||
-- casts. This is only intended an escape hatch to be used if Rel8 cannot
|
||||
-- otherwise express the expression you need. If you find yourself using this
|
||||
-- function, please let us know, as it may indicate that something is missing
|
||||
-- from Rel8!
|
||||
unsafeSubscript :: Sql DBType b => Expr a -> Expr i -> Expr b
|
||||
unsafeSubscript = sunsafeSubscript typeInformation
|
||||
|
||||
|
||||
-- | @'unsafeSubscripts' a (i, j)@ will generate the SQL @a[i][j]@.
|
||||
--
|
||||
-- Note that this function is not type checked and the generated SQL has no
|
||||
-- casts. This is only intended an escape hatch to be used if Rel8 cannot
|
||||
-- otherwise express the expression you need. If you find yourself using this
|
||||
-- function, please let us know, as it may indicate that something is missing
|
||||
-- from Rel8!
|
||||
unsafeSubscripts :: (Table Expr i, Sql DBType b) => Expr a -> i -> Expr b
|
||||
unsafeSubscripts = sunsafeSubscripts typeInformation
|
||||
|
||||
|
||||
sunsafeSubscript :: TypeInformation (Unnullify b) -> Expr a -> Expr i -> Expr b
|
||||
sunsafeSubscript info array i =
|
||||
fromPrimExpr . extractArrayElement info $
|
||||
Opaleye.ArrayIndex (toPrimExpr array) (toPrimExpr i)
|
||||
|
||||
|
||||
sunsafeSubscripts :: Table Expr i => TypeInformation (Unnullify b) -> Expr a -> i -> Expr b
|
||||
sunsafeSubscripts info array i =
|
||||
fromPrimExpr $ extractArrayElement info $ primSubscripts array indices
|
||||
where
|
||||
indices = hfoldMap (pure . toPrimExpr) $ toColumns i
|
||||
|
||||
|
||||
primSubscripts :: Expr a -> [Opaleye.PrimExpr] -> Opaleye.PrimExpr
|
||||
primSubscripts array indices =
|
||||
foldl' Opaleye.ArrayIndex (toPrimExpr array) indices
|
@ -8,6 +8,7 @@ module Rel8.Schema.QualifiedName
|
||||
( QualifiedName (..)
|
||||
, ppQualifiedName
|
||||
, showQualifiedName
|
||||
, showQualifiedOperator
|
||||
)
|
||||
where
|
||||
|
||||
@ -17,7 +18,7 @@ import Data.String (IsString, fromString)
|
||||
import Prelude
|
||||
|
||||
-- pretty
|
||||
import Text.PrettyPrint (Doc, text)
|
||||
import Text.PrettyPrint (Doc, parens, text)
|
||||
|
||||
-- rel8
|
||||
import Rel8.Schema.Escape (escape)
|
||||
@ -51,4 +52,11 @@ ppQualifiedName QualifiedName {schema = mschema, ..} = case mschema of
|
||||
|
||||
|
||||
showQualifiedName :: QualifiedName -> String
|
||||
showQualifiedName = show . ppQualifiedName
|
||||
showQualifiedName = show . ppQualifiedName
|
||||
|
||||
|
||||
showQualifiedOperator :: QualifiedName -> String
|
||||
showQualifiedOperator QualifiedName {schema = mschema, ..} = case mschema of
|
||||
Nothing -> name
|
||||
Just schema ->
|
||||
show $ text "OPERATOR" <> parens (escape schema <> text "." <> text name)
|
||||
|
Loading…
Reference in New Issue
Block a user