diff --git a/src/Database/Esqueleto/Internal/Sql.hs b/src/Database/Esqueleto/Internal/Sql.hs index bc40553..e76fe3b 100644 --- a/src/Database/Esqueleto/Internal/Sql.hs +++ b/src/Database/Esqueleto/Internal/Sql.hs @@ -22,6 +22,7 @@ module Database.Esqueleto.Internal.Sql , delete , update -- * The guts + , unsafeSqlBinOp , rawSelectSource , runSource , rawExecute @@ -276,18 +277,18 @@ instance Esqueleto SqlQuery SqlExpr SqlPersist where not_ (ERaw p f) = ERaw Never $ \esc -> let (b, vals) = f esc in ("NOT " <> parensM p b, vals) - (==.) = binop " = " - (>=.) = binop " >= " - (>.) = binop " > " - (<=.) = binop " <= " - (<.) = binop " < " - (!=.) = binop " != " - (&&.) = binop " AND " - (||.) = binop " OR " - (+.) = binop " + " - (-.) = binop " - " - (/.) = binop " / " - (*.) = binop " * " + (==.) = unsafeSqlBinOp " = " + (>=.) = unsafeSqlBinOp " >= " + (>.) = unsafeSqlBinOp " > " + (<=.) = unsafeSqlBinOp " <= " + (<.) = unsafeSqlBinOp " < " + (!=.) = unsafeSqlBinOp " != " + (&&.) = unsafeSqlBinOp " AND " + (||.) = unsafeSqlBinOp " OR " + (+.) = unsafeSqlBinOp " + " + (-.) = unsafeSqlBinOp " - " + (/.) = unsafeSqlBinOp " / " + (*.) = unsafeSqlBinOp " * " set ent upds = Q $ W.tell mempty { sdSetClause = map apply upds } where @@ -308,7 +309,7 @@ setAux :: (PersistEntity val, PersistField typ) => EntityField val typ -> (SqlExpr (Entity val) -> SqlExpr (Value typ)) -> SqlExpr (Update val) -setAux field mkVal = ESet $ \ent -> binop " = " name (mkVal ent) +setAux field mkVal = ESet $ \ent -> unsafeSqlBinOp " = " name (mkVal ent) where name = ERaw Never $ \esc -> (fieldName esc field, mempty) sub :: PersistField a => Mode -> SqlQuery (SqlExpr (Value a)) -> SqlExpr (Value a) @@ -317,8 +318,24 @@ sub mode query = ERaw Parens $ \esc -> first parens (toRawSql mode esc query) fromDBName :: Connection -> DBName -> TLB.Builder fromDBName conn = TLB.fromText . escapeName conn -binop :: TLB.Builder -> SqlExpr (Value a) -> SqlExpr (Value b) -> SqlExpr (Value c) -binop op (ERaw p1 f1) (ERaw p2 f2) = ERaw Parens f + +---------------------------------------------------------------------- + + +-- | (Internal) Create a custom binary operator. You /should/ +-- /not/ use this function directly since its type is very +-- general, you should always use it with an explicit type +-- signature. For example: +-- +-- @ +-- (==.) :: SqlExpr (Value a) -> SqlExpr (Value a) -> SqlExpr (Value Bool) +-- (==.) = unsafeSqlBinOp " = " +-- @ +-- +-- In the example above, we constraint the arguments to be of the +-- same type and constraint the result to be a boolean value. +unsafeSqlBinOp :: TLB.Builder -> SqlExpr (Value a) -> SqlExpr (Value b) -> SqlExpr (Value c) +unsafeSqlBinOp op (ERaw p1 f1) (ERaw p2 f2) = ERaw Parens f where f esc = let (b1, vals1) = f1 esc (b2, vals2) = f2 esc