From b4e560b1acd2f5f956697223b403c8c3b9f914cc Mon Sep 17 00:00:00 2001 From: Adam Bergmark Date: Wed, 1 Mar 2017 22:36:04 +0100 Subject: [PATCH] Pull coersion boilerplate out of Operators --- src/Silk/Opaleye/Operators.hs | 36 ++++++++++++++++---------------- src/Silk/Opaleye/ShowConstant.hs | 9 +++++++- 2 files changed, 26 insertions(+), 19 deletions(-) diff --git a/src/Silk/Opaleye/Operators.hs b/src/Silk/Opaleye/Operators.hs index 0b73bed..3af45cd 100644 --- a/src/Silk/Opaleye/Operators.hs +++ b/src/Silk/Opaleye/Operators.hs @@ -52,7 +52,7 @@ import qualified Opaleye.Column as C (fromNullable, isNull, null) import qualified Opaleye.Operators as O import Silk.Opaleye.Compat (PGIntegral, PGOrd, PGString) -import Silk.Opaleye.ShowConstant (ShowConstant (constant), PGRep, safeCoerceFromRep, safeCoerceToRep) +import Silk.Opaleye.ShowConstant (ShowConstant (constant), PGRep, safeCoerceBinOp, safeCoerceFromRep, safeCoerceToRep, safelyWrapped) infix 4 .== -- | Equality between columns, does not allow comparison on Nullable @@ -72,60 +72,60 @@ a ./= b = safeCoerceFromRep $ a O../= b infixr 2 .|| (.||) :: PGRep a ~ PGBool => Column a -> Column a -> Column a -a .|| b = safeCoerceFromRep $ safeCoerceToRep a O..|| safeCoerceToRep b +(.||) = safeCoerceBinOp (O..||) infixr 3 .&& (.&&) :: PGRep a ~ PGBool => Column a -> Column a -> Column a -a .&& b = safeCoerceFromRep $ safeCoerceToRep a O..&& safeCoerceToRep b +(.&&) = safeCoerceBinOp (O..&&) infix 4 .> (.>) :: PGOrd (PGRep a) => Column a -> Column a -> Column Bool -a .> b = safeCoerceFromRep $ safeCoerceToRep a O..> safeCoerceToRep b +(.>) = safeCoerceBinOp (O..>) infix 4 .>? (.>?) :: PGOrd (PGRep a) => Column (Nullable a) -> Column (Nullable a) -> Column Bool -a .>? b = safeCoerceFromRep $ safeCoerceToRep a O..> safeCoerceToRep b +(.>?) = safeCoerceBinOp (O..>) infix 4 .< (.<) :: PGOrd (PGRep a) => Column a -> Column a -> Column Bool -a .< b = safeCoerceFromRep $ safeCoerceToRep a O..< safeCoerceToRep b +(.<) = safeCoerceBinOp (O..<) infix 4 . Column (Nullable a) -> Column (Nullable a) -> Column Bool -a .= (.>=) :: PGOrd (PGRep a) => Column a -> Column a -> Column Bool -a .>= b = safeCoerceFromRep $ safeCoerceToRep a O..>= safeCoerceToRep b +(.>=) = safeCoerceBinOp (O..>=) infix 4 .>=? (.>=?) :: PGOrd (PGRep a) => Column (Nullable a) -> Column (Nullable a) -> Column Bool -a .>=? b = safeCoerceFromRep $ safeCoerceToRep a O..>= safeCoerceToRep b +(.>=?) = safeCoerceBinOp (O..>=) infix 4 .<= (.<=) :: PGOrd (PGRep a) => Column a -> Column a -> Column Bool -a .<= b = safeCoerceFromRep $ safeCoerceToRep a O..<= safeCoerceToRep b +(.<=) = safeCoerceBinOp (O..<=) infix 4 .<=? (.<=?) :: PGOrd (PGRep a) => Column (Nullable a) -> Column (Nullable a) -> Column Bool -a .<=? b = safeCoerceFromRep $ safeCoerceToRep a O..<= safeCoerceToRep b +(.<=?) = safeCoerceBinOp (O..<=) quot_ :: PGIntegral (PGRep a) => Column a -> Column a -> Column a -quot_ a b = safeCoerceFromRep $ safeCoerceToRep a `O.quot_` safeCoerceToRep b +quot_ = safeCoerceBinOp O.quot_ rem_ :: PGIntegral (PGRep a) => Column a -> Column a -> Column a -rem_ a b = safeCoerceFromRep $ safeCoerceToRep a `O.rem_` safeCoerceToRep b +rem_ = safeCoerceBinOp O.rem_ -- These upper :: PGRep a ~ PGText => Column a -> Column a -upper = safeCoerceFromRep . O.upper . safeCoerceToRep +upper = safelyWrapped O.upper lower :: PGRep a ~ PGText => Column a -> Column a -lower = safeCoerceFromRep . O.lower . safeCoerceToRep +lower = safelyWrapped O.lower like :: PGRep a ~ PGText => Column a -> Column a -> Column Bool -like a = safeCoerceFromRep . O.like (safeCoerceToRep a) . safeCoerceToRep +like = safelyWrapped . O.like . safeCoerceToRep charLength :: PGString (PGRep a) => Column a -> Column Int charLength = O.charLength . safeCoerceToRep @@ -135,7 +135,7 @@ trunc :: PGFractional (PGRep a) => Column a -> Column Int trunc (Column e) = Column (FunExpr "trunc" [e]) case_ :: ShowConstant a => [(Column Bool, Column a)] -> Column a -> Column a -case_ xs = safeCoerceFromRep . O.case_ (map (safeCoerceToRep *** safeCoerceToRep) xs) . safeCoerceToRep +case_ = safelyWrapped . O.case_ . map (safeCoerceToRep *** safeCoerceToRep) ifThenElse :: Column Bool -> Column a -> Column a -> Column a ifThenElse = O.ifThenElse . safeCoerceToRep @@ -166,7 +166,7 @@ isNull = safeCoerceFromRep . C.isNull -- | Boolean negation. not_ :: PGRep a ~ PGBool => Column a -> Column a -not_ = safeCoerceFromRep . O.not . safeCoerceToRep +not_ = safelyWrapped O.not -- | 'Nothing' for 'Column's. null_ :: Column (Nullable a) diff --git a/src/Silk/Opaleye/ShowConstant.hs b/src/Silk/Opaleye/ShowConstant.hs index 6943dcc..5b6e5be 100644 --- a/src/Silk/Opaleye/ShowConstant.hs +++ b/src/Silk/Opaleye/ShowConstant.hs @@ -14,6 +14,7 @@ module Silk.Opaleye.ShowConstant , safeCoerceFromRep , safelyWrapped , safeCoerce + , safeCoerceBinOp , emptyArray , singletonArray , arrayPrepend @@ -66,13 +67,19 @@ safeCoerceToRep = unsafeCoerceColumn safeCoerceFromRep :: PGRep a ~ b => Column b -> Column a safeCoerceFromRep = unsafeCoerceColumn --- Perform a db operation on the underlying type. +-- | Perform a db operation on the underlying type. safelyWrapped :: (Column (PGRep a) -> Column (PGRep b)) -> Column a -> Column b safelyWrapped f = safeCoerceFromRep . f . safeCoerceToRep +-- | Convert between two types that have the same representation. safeCoerce :: PGRep a ~ PGRep b => Column a -> Column b safeCoerce = safelyWrapped id +safeCoerceBinOp + :: (Column (PGRep a) -> Column (PGRep b) -> Column (PGRep c)) + -> (Column a -> Column b -> Column c) +safeCoerceBinOp op a b = safeCoerceFromRep $ safeCoerceToRep a `op` safeCoerceToRep b + -- | A class for Haskell values that can be converted to postgres -- literal constants.