From 4514ec0390941c136fd8c4837452202c41b404a1 Mon Sep 17 00:00:00 2001
From: Anton Ekblad <anton@ekblad.cc>
Date: Wed, 8 May 2019 13:20:41 +0200
Subject: [PATCH] Support backend-specific functionality; JSON support for
 postgres.

Squashed commit of the following:

commit c3791db7e06edf0c338d082958073945cd274f39
Author: Anton Ekblad <anton@ekblad.cc>
Date:   Wed May 8 03:35:35 2019 +0200

    JSON support.

commit c675b1c7447f108908a4c7795848f91352770e19
Author: Anton Ekblad <anton@ekblad.cc>
Date:   Tue May 7 15:43:48 2019 +0200

    Add unsafe operator function, to define custom SQL operators.

commit 45d71ae1c791f1b93bada94b52e6e40015c8f2eb
Author: Anton Ekblad <anton@ekblad.cc>
Date:   Wed May 1 02:49:35 2019 +0200

    Add unsafe sink function.

commit c3083c016794bf0c26217c75b9570ce49c2aa9d9
Author: Anton Ekblad <anton@ekblad.cc>
Date:   Wed May 1 02:18:35 2019 +0200

    Fix prepared statement type inference with constrained backend.

commit f64c4d069ca3eb574539efdd754939b92b4297a5
Author: Anton Ekblad <anton@ekblad.cc>
Date:   Mon Apr 29 21:31:28 2019 +0200

    Parameterise SeldaT over backend. #80
---
 Makefile                                      |  23 ++--
 cabal.project                                 |   1 +
 selda-json/selda-json.cabal                   |  29 +++++
 selda-json/src/Database/Selda/JSON.hs         |  42 ++++++
 selda-postgresql/selda-postgresql.cabal       |  11 +-
 .../src/Database/Selda/PostgreSQL.hs          |  27 +++-
 .../src/Database/Selda/PostgreSQL/Encoding.hs |  15 ++-
 selda-sqlite/src/Database/Selda/SQLite.hs     |  13 +-
 selda-tests/selda-tests.cabal                 |   8 +-
 selda-tests/test/RunTests.hs                  |  13 +-
 selda-tests/test/Tables.hs                    |   4 +-
 selda-tests/test/Tests/JSON.hs                | 122 ++++++++++++++++++
 selda-tests/test/Tests/MultiConn.hs           |  20 +--
 selda-tests/test/Tests/Mutable.hs             |  10 ++
 selda-tests/test/Tests/Query.hs               |   8 +-
 selda-tests/test/Tests/Validation.hs          |  20 +--
 selda-tests/test/Utils.hs                     |   6 +-
 selda/src/Database/Selda/Backend.hs           |   2 +-
 selda/src/Database/Selda/Backend/Internal.hs  |  40 +++---
 selda/src/Database/Selda/Caching.hs           |   2 +-
 selda/src/Database/Selda/Exp.hs               |  35 ++---
 selda/src/Database/Selda/Frontend.hs          |  44 +++----
 selda/src/Database/Selda/Migrations.hs        |  20 +--
 selda/src/Database/Selda/Nullable.hs          |   6 +-
 selda/src/Database/Selda/Prepared.hs          |  24 ++--
 selda/src/Database/Selda/SQL/Print.hs         |  31 ++---
 selda/src/Database/Selda/SQL/Print/Config.hs  |   2 +
 selda/src/Database/Selda/SqlType.hs           |  21 +--
 selda/src/Database/Selda/Unsafe.hs            |  42 +++++-
 29 files changed, 470 insertions(+), 171 deletions(-)
 create mode 100644 selda-json/selda-json.cabal
 create mode 100644 selda-json/src/Database/Selda/JSON.hs
 create mode 100644 selda-tests/test/Tests/JSON.hs

diff --git a/Makefile b/Makefile
index 36b1ca38..4bf31150 100644
--- a/Makefile
+++ b/Makefile
@@ -1,4 +1,4 @@
-PACKAGES=selda selda-sqlite selda-postgresql
+PACKAGES=selda selda-sqlite selda-postgresql selda-json
 .PHONY: help build license deps travischeck haddock check test selda pgtest sqlite postgres repl upload-selda upload
 
 help:
@@ -17,13 +17,7 @@ help:
 	@echo "haddock      - build Haddock docs"
 	@echo "tags         - build tags file for emacs"
 
-build: selda sqlite postgres
-
-selda:
-	cp -f LICENSE ./selda/LICENSE
-	cp -f README.md ./selda/README.md
-	cabal v2-build selda
-	make tags ; true
+build: selda sqlite postgres json
 
 travischeck:
 	echo '{-# LANGUAGE OverloadedStrings #-}' > selda-tests/PGConnectInfo.hs
@@ -58,13 +52,26 @@ pgtest: selda postgres
 	cd ./selda-tests && cabal v2-configure --enable-tests -fpostgres
 	cd ./selda-tests && cabal v2-test
 
+selda:
+	cp -f LICENSE ./selda/LICENSE
+	cp -f README.md ./selda/README.md
+	cabal v2-build selda
+	make tags ; true
+
+json:
+	cp -f LICENSE ./selda/LICENSE
+	cabal v2-build selda-json
+	make tags ; true
+
 sqlite:
 	cp -f LICENSE ./selda-sqlite/LICENSE
 	cabal v2-build selda-sqlite
+	make tags ; true
 
 postgres:
 	cp -f LICENSE ./selda-postgresql/LICENSE
 	cabal v2-build selda-postgresql
+	make tags ; true
 
 repl:
 	cabal v2-repl --ghc-options="-XOverloadedStrings" selda
diff --git a/cabal.project b/cabal.project
index 497ba16e..41641d0c 100644
--- a/cabal.project
+++ b/cabal.project
@@ -3,4 +3,5 @@ packages:
   selda-sqlite/
   selda-postgresql/
   selda-tests/
+  selda-json/
   ./
\ No newline at end of file
diff --git a/selda-json/selda-json.cabal b/selda-json/selda-json.cabal
new file mode 100644
index 00000000..88123651
--- /dev/null
+++ b/selda-json/selda-json.cabal
@@ -0,0 +1,29 @@
+cabal-version:       >=1.10
+name:                selda-json
+version:             0.1.0.0
+synopsis:            JSON support for the Selda database library.
+-- description:
+homepage:            https://selda.link
+-- bug-reports:
+license:             MIT
+license-file:        LICENSE
+author:              Anton Ekblad
+maintainer:          anton@ekblad.cc
+-- copyright:
+category:            Database
+build-type:          Simple
+extra-source-files:  CHANGELOG.md
+
+library
+  exposed-modules:
+    Database.Selda.JSON
+  -- other-modules:
+  -- other-extensions:
+  build-depends:
+      aeson      >=1.0  && <1.5
+    , base       >=4.8  && <5
+    , bytestring >=0.10 && <0.11
+    , selda      >=0.4  && <0.5
+    , text       >=1.0   && <1.3
+  hs-source-dirs:      src
+  default-language:    Haskell2010
diff --git a/selda-json/src/Database/Selda/JSON.hs b/selda-json/src/Database/Selda/JSON.hs
new file mode 100644
index 00000000..4a8b107b
--- /dev/null
+++ b/selda-json/src/Database/Selda/JSON.hs
@@ -0,0 +1,42 @@
+{-# LANGUAGE GADTs, OverloadedStrings #-}
+module Database.Selda.JSON (JSONBackend (..)) where
+import Database.Selda (Text, Col, Inner)
+import Database.Selda.Backend
+import Database.Selda.Unsafe (sink, sink2)
+import Data.Aeson (Value (Null), encode, decode')
+import qualified Data.ByteString.Lazy as BSL (ByteString, fromStrict, toStrict)
+import Data.Text.Encoding (encodeUtf8)
+
+class JSONValue a
+instance JSONValue Value
+instance JSONValue a => JSONValue (Maybe a)
+
+-- | Any backend that supports JSON lookups in queries.
+class JSONBackend b where
+  -- | Look up the given key in the given JSON column.
+  (~>) :: JSONValue a => Col b a -> Col b Text -> Col b (Maybe Value)
+  infixl 8 ~>
+
+  -- | Convert the given JSON column to plain text.
+  jsonToText :: Col b Value -> Col b Text
+
+instance JSONBackend b => JSONBackend (Inner b) where
+  (~>) = sink2 (~>)
+  jsonToText = sink jsonToText
+
+decodeError :: Show a => a -> b
+decodeError x = error $ "fromSql: json column with invalid json: " ++ show x
+
+typeError :: Show a => a -> b
+typeError x = error $ "fromSql: json column with non-text value: " ++ show x
+
+textToLazyBS :: Text -> BSL.ByteString
+textToLazyBS = BSL.fromStrict . encodeUtf8
+
+instance SqlType Value where
+  mkLit = LCustom TJSON . LBlob . BSL.toStrict . encode
+  sqlType _ = TJSON
+  defaultValue = mkLit Null
+  fromSql (SqlBlob t)   = maybe (decodeError t) id (decode' $ BSL.fromStrict t)
+  fromSql (SqlString t) = maybe (decodeError t) id (decode' $ textToLazyBS t)
+  fromSql x             = typeError x
diff --git a/selda-postgresql/selda-postgresql.cabal b/selda-postgresql/selda-postgresql.cabal
index 89d00419..b0cdb30c 100644
--- a/selda-postgresql/selda-postgresql.cabal
+++ b/selda-postgresql/selda-postgresql.cabal
@@ -28,11 +28,12 @@ library
     OverloadedStrings
     CPP
   build-depends:
-      base              >=4.8 && <5
-    , bytestring        >=0.9 && <0.11
-    , exceptions        >=0.8 && <0.11
-    , selda             >=0.4 && <0.5
-    , text              >=1.0 && <1.3
+      base       >=4.8 && <5
+    , bytestring >=0.9 && <0.11
+    , exceptions >=0.8 && <0.11
+    , selda      >=0.4 && <0.5
+    , selda-json >=0.1 && <0.2
+    , text       >=1.0 && <1.3
   if !flag(haste)
     build-depends:
         postgresql-binary >=0.12 && <0.13
diff --git a/selda-postgresql/src/Database/Selda/PostgreSQL.hs b/selda-postgresql/src/Database/Selda/PostgreSQL.hs
index 07ce7509..9b374d4c 100644
--- a/selda-postgresql/src/Database/Selda/PostgreSQL.hs
+++ b/selda-postgresql/src/Database/Selda/PostgreSQL.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE OverloadedStrings, RecordWildCards, GADTs, CPP #-}
 -- | PostgreSQL backend for Selda.
 module Database.Selda.PostgreSQL
-  ( PGConnectInfo (..)
+  ( PG, PGConnectInfo (..)
   , withPostgreSQL, on, auth
   , pgOpen, pgOpen', seldaClose
   , pgConnString, pgPPConfig
@@ -12,6 +12,8 @@ import Data.Monoid
 import Data.ByteString (ByteString)
 import qualified Data.Text as T
 import Database.Selda.Backend hiding (toText)
+import Database.Selda.JSON
+import Database.Selda.Unsafe (cast, operator)
 import Control.Monad.Catch
 import Control.Monad.IO.Class
 
@@ -26,6 +28,12 @@ import Database.Selda.PostgreSQL.Encoding
 import Database.PostgreSQL.LibPQ hiding (user, pass, db, host)
 #endif
 
+data PG
+
+instance JSONBackend PG where
+  (~>) = operator "->"
+  jsonToText = cast
+
 -- | PostgreSQL connection information.
 data PGConnectInfo = PGConnectInfo
   { -- | Host to connect to.
@@ -96,7 +104,9 @@ pgConnString PGConnectInfo{..} = mconcat
 --   The database connection is guaranteed to be closed when the computation
 --   terminates.
 withPostgreSQL :: (MonadIO m, MonadMask m)
-               => PGConnectInfo -> SeldaT m a -> m a
+               => PGConnectInfo
+               -> SeldaT PG m a
+               -> m a
 #ifdef __HASTE__
 withPostgreSQL _ _ = return $ error "withPostgreSQL called in JS context"
 #else
@@ -106,11 +116,14 @@ withPostgreSQL ci m = bracket (pgOpen ci) seldaClose (runSeldaT m)
 -- | Open a new PostgreSQL connection. The connection will persist across
 --   calls to 'runSeldaT', and must be explicitly closed using 'seldaClose'
 --   when no longer needed.
-pgOpen :: (MonadIO m, MonadMask m) => PGConnectInfo -> m SeldaConnection
+pgOpen :: (MonadIO m, MonadMask m) => PGConnectInfo -> m (SeldaConnection PG)
 pgOpen ci = pgOpen' (pgSchema ci) (pgConnString ci)
 
 pgPPConfig :: PPConfig
-pgOpen' :: (MonadIO m, MonadMask m) => Maybe T.Text -> ByteString -> m SeldaConnection
+pgOpen' :: (MonadIO m, MonadMask m)
+        => Maybe T.Text
+        -> ByteString
+        -> m (SeldaConnection PG)
 #ifdef __HASTE__
 pgOpen' _ _ = return $ error "pgOpen' called in JS context"
 pgPPConfig = error "pgPPConfig evaluated in JS context"
@@ -155,7 +168,6 @@ pgPPConfig = defPPConfig
 
     pgTypeRenameHook _ TDateTime = "timestamp with time zone"
     pgTypeRenameHook _ TTime     = "time with time zone"
-    pgTypeRenameHook _ TUUID     = "uuid"
     pgTypeRenameHook f ty        = f ty
 
     pgColAttrsHook :: SqlTypeRep -> [ColAttr] -> ([ColAttr] -> T.Text) -> T.Text
@@ -172,7 +184,7 @@ pgPPConfig = defPPConfig
 
 -- | Create a `SeldaBackend` for PostgreSQL `Connection`
 pgBackend :: Connection   -- ^ PostgreSQL connection object.
-          -> SeldaBackend
+          -> SeldaBackend PG
 pgBackend c = SeldaBackend
   { runStmt         = \q ps -> right <$> pgQueryRunner c False q ps
   , runStmtWithPK   = \q ps -> left <$> pgQueryRunner c True q ps
@@ -423,6 +435,7 @@ mkTypeRep "boolean"                  = Right TBool
 mkTypeRep "date"                     = Right TDate
 mkTypeRep "time with time zone"      = Right TTime
 mkTypeRep "uuid"                     = Right TUUID
+mkTypeRep "jsonb"                    = Right TJSON
 mkTypeRep typ                        = Left typ
 
 -- | Custom column types for postgres.
@@ -432,6 +445,8 @@ pgColType _ TInt      = "INT8"
 pgColType _ TFloat    = "FLOAT8"
 pgColType _ TDateTime = "TIMESTAMP"
 pgColType _ TBlob     = "BYTEA"
+pgColType _ TUUID     = "UUID"
+pgColType _ TJSON     = "JSONB"
 pgColType cfg t       = ppType cfg t
 
 -- | Custom attribute types for postgres.
diff --git a/selda-postgresql/src/Database/Selda/PostgreSQL/Encoding.hs b/selda-postgresql/src/Database/Selda/PostgreSQL/Encoding.hs
index 16423022..f5ccc77f 100644
--- a/selda-postgresql/src/Database/Selda/PostgreSQL/Encoding.hs
+++ b/selda-postgresql/src/Database/Selda/PostgreSQL/Encoding.hs
@@ -29,7 +29,8 @@ import Data.Int (Int16, Int32, Int64)
 
 -- | OIDs for all types used by Selda.
 blobType, boolType, intType, int32Type, int16Type, textType, doubleType,
-  dateType, timeType, timestampType, nameType, varcharType, uuidType :: Oid
+  dateType, timeType, timestampType, nameType, varcharType, uuidType,
+  jsonbType :: Oid
 boolType      = Oid 16
 intType       = Oid 20
 int32Type     = Oid 23
@@ -43,6 +44,7 @@ timestampType = Oid 1184
 blobType      = Oid 17
 varcharType   = Oid 1043
 uuidType      = Oid 2950
+jsonbType     = Oid 3802
 
 bytes :: Enc.Encoding -> BS.ByteString
 bytes = Enc.encodingBytes
@@ -64,7 +66,10 @@ fromSqlValue (LUUID x)     = Just (uuidType, bytes $ Enc.uuid x, Binary)
 fromSqlValue (LBlob b)     = Just (blobType, bytes $ Enc.bytea_strict b, Binary)
 fromSqlValue (LNull)       = Nothing
 fromSqlValue (LJust x)     = fromSqlValue x
-fromSqlValue (LCustom l)   = fromSqlValue l
+fromSqlValue (LCustom TJSON (LBlob b)) = Just ( jsonbType
+                                              , bytes $ Enc.jsonb_bytes b
+                                              , Binary)
+fromSqlValue (LCustom _ l) = fromSqlValue l
 
 -- | Get the corresponding OID for an SQL type representation.
 fromSqlType :: SqlTypeRep -> Oid
@@ -78,6 +83,7 @@ fromSqlType TTime     = timeType
 fromSqlType TBlob     = blobType
 fromSqlType TRowID    = intType
 fromSqlType TUUID     = uuidType
+fromSqlType TJSON     = jsonbType
 
 -- | Convert the given postgres return value and type to an @SqlValue@.
 toSqlValue :: Oid -> BS.ByteString -> SqlValue
@@ -88,17 +94,18 @@ toSqlValue t val
   | t == int16Type     = SqlInt     $ fromIntegral $ parse (Dec.int :: Value Int16) val
   | t == doubleType    = SqlFloat   $ parse Dec.float8 val
   | t == blobType      = SqlBlob    $ parse Dec.bytea_strict val
-  | t == uuidType      = SqlBlob    $ toBS $ parse Dec.uuid val
+  | t == uuidType      = SqlBlob    $ uuid2bs $ parse Dec.uuid val
   | t == timestampType = SqlUTCTime $ parse parseTimestamp val
   | t == timeType      = SqlTime    $ toTime $ parse parseTime val
   | t == dateType      = SqlDate    $ parse Dec.date val
+  | t == jsonbType     = SqlBlob    $ parse (Dec.jsonb_bytes pure) val
   | t `elem` textish   = SqlString  $ parse Dec.text_strict val
   | otherwise          = error $ "BUG: result with unknown type oid: " ++ show t
   where
     parseTimestamp = Dec.timestamptz_int <|> Dec.timestamptz_float
     parseTime = Dec.timetz_int <|> Dec.timetz_float
     toTime (tod, tz) = snd $ localToUTCTimeOfDay tz tod
-    toBS = LBS.toStrict . UUID.toByteString
+    uuid2bs = LBS.toStrict . UUID.toByteString
     textish = [textType, nameType, varcharType]
 
 parse :: Value a -> BS.ByteString -> a
diff --git a/selda-sqlite/src/Database/Selda/SQLite.hs b/selda-sqlite/src/Database/Selda/SQLite.hs
index 57df4b35..879cc000 100644
--- a/selda-sqlite/src/Database/Selda/SQLite.hs
+++ b/selda-sqlite/src/Database/Selda/SQLite.hs
@@ -1,7 +1,8 @@
 {-# LANGUAGE GADTs, CPP, OverloadedStrings #-}
 -- | SQLite3 backend for Selda.
 module Database.Selda.SQLite
-  ( withSQLite
+  ( SQLite
+  , withSQLite
   , sqliteOpen, seldaClose
   , sqliteBackend
   ) where
@@ -19,10 +20,12 @@ import Database.SQLite3
 import System.Directory (makeAbsolute)
 #endif
 
+data SQLite
+
 -- | Open a new connection to an SQLite database.
 --   The connection is reusable across calls to `runSeldaT`, and must be
 --   explicitly closed using 'seldaClose' when no longer needed.
-sqliteOpen :: (MonadIO m, MonadMask m) => FilePath -> m SeldaConnection
+sqliteOpen :: (MonadIO m, MonadMask m) => FilePath -> m (SeldaConnection SQLite)
 #ifdef __HASTE__
 sqliteOpen _ = error "sqliteOpen called in JS context"
 #else
@@ -41,7 +44,7 @@ sqliteOpen file = do
 
 -- | Perform the given computation over an SQLite database.
 --   The database is guaranteed to be closed when the computation terminates.
-withSQLite :: (MonadIO m, MonadMask m) => FilePath -> SeldaT m a -> m a
+withSQLite :: (MonadIO m, MonadMask m) => FilePath -> SeldaT SQLite m a -> m a
 #ifdef __HASTE__
 withSQLite _ _ = return $ error "withSQLite called in JS context"
 
@@ -58,7 +61,7 @@ withSQLite file m = bracket (sqliteOpen file) seldaClose (runSeldaT m)
 --   any and all safety guarantees made by the Selda API.
 --   Caching functionality in particular WILL break.
 --   Proceed with extreme caution.
-sqliteBackend :: Database -> SeldaBackend
+sqliteBackend :: Database -> SeldaBackend SQLite
 sqliteBackend db = SeldaBackend
   { runStmt         = \q ps -> snd <$> sqliteQueryRunner db q ps
   , runStmtWithPK   = \q ps -> fst <$> sqliteQueryRunner db q ps
@@ -198,7 +201,7 @@ toSqlData (LBool b)     = SQLInteger $ if b then 1 else 0
 toSqlData (LBlob b)     = SQLBlob b
 toSqlData (LNull)       = SQLNull
 toSqlData (LJust x)     = toSqlData x
-toSqlData (LCustom l)   = toSqlData l
+toSqlData (LCustom _ l) = toSqlData l
 toSqlData (LUUID x)     = SQLBlob (toStrict $ toByteString x)
 
 fromSqlData :: SQLData -> SqlValue
diff --git a/selda-tests/selda-tests.cabal b/selda-tests/selda-tests.cabal
index 4b05da4e..2cc3b876 100644
--- a/selda-tests/selda-tests.cabal
+++ b/selda-tests/selda-tests.cabal
@@ -25,18 +25,21 @@ test-suite selda-testsuite
   other-modules:
     Tables
     Utils
+    Tests.JSON
     Tests.MultiConn
     Tests.Mutable
     Tests.NonDB
     Tests.Query
     Tests.Validation
   build-depends:
-      base       >=4.8  && <5
+      aeson
+    , base       >=4.8  && <5
     , bytestring >=0.10 && <0.11
     , directory  >=1.2  && <1.4
     , exceptions >=0.8  && <0.11
     , HUnit      >=1.4  && <1.7
     , selda
+    , selda-json
     , text       >=1.1  && <1.3
     , time       >=1.4  && <1.10
     , random     >=1.1  && <1.2
@@ -44,9 +47,10 @@ test-suite selda-testsuite
   if flag(postgres)
     other-modules: PGConnectInfo
     build-depends: selda-postgresql
-    cpp-options:   -DPOSTGRES
+    cpp-options:   -DPOSTGRES -DTEST_JSON -DBACKEND=PG
   else
     build-depends: selda-sqlite
+    cpp-options: -DSQLITE -DBACKEND=SQLite
   hs-source-dirs:
     test, .
   default-language:
diff --git a/selda-tests/test/RunTests.hs b/selda-tests/test/RunTests.hs
index da633615..5463dc33 100644
--- a/selda-tests/test/RunTests.hs
+++ b/selda-tests/test/RunTests.hs
@@ -13,6 +13,11 @@ import Tests.NonDB (noDBTests)
 import Tests.MultiConn (multiConnTests)
 import Tables (teardown)
 
+#ifdef TEST_JSON
+import Tests.JSON (jsonQueryTests)
+#endif
+import Tests.JSON (jsonTests)
+
 #ifdef POSTGRES
 -- To test the PostgreSQL backend, specify the connection info for the server
 -- as PGConnectInfo.pgConnectInfo :: PGConnectInfo.
@@ -22,7 +27,6 @@ import PGConnectInfo (pgConnectInfo)
 import Database.Selda.SQLite
 #endif
 
-
 main = do
   tmpdir <- getTemporaryDirectory
   let dbfile = tmpdir ++ "/" ++ "__selda_test_tmp.sqlite"
@@ -34,10 +38,11 @@ main = do
 
 -- | Run the given computation over the given SQLite file. If the file exists,
 --   it will be removed first.
-freshEnv :: FilePath -> SeldaM a -> IO a
 #ifdef POSTGRES
+freshEnv :: FilePath -> SeldaM PG a -> IO a
 freshEnv _ m = withPostgreSQL pgConnectInfo $ teardown >> m
 #else
+freshEnv :: FilePath -> SeldaM SQLite a -> IO a
 freshEnv file m = do
   exists <- doesFileExist file
   when exists $ removeFile file
@@ -54,6 +59,10 @@ allTests f = TestList
   , "mutable tests (caching)"  ~: mutableTests caching
   , "cache + transaction race" ~: invalidateCacheAfterTransaction run
   , "multi-connection tests"   ~: multiConnTests open
+  , "mandatory json tests"     ~: jsonTests (freshEnv f)
+#ifdef TEST_JSON
+  , "json query tests"         ~: jsonQueryTests (freshEnv f)
+#endif
   ]
   where
     caching m = freshEnv f (setLocalCache 1000 >> m)
diff --git a/selda-tests/test/Tables.hs b/selda-tests/test/Tables.hs
index 2f859960..3ab856e3 100644
--- a/selda-tests/test/Tables.hs
+++ b/selda-tests/test/Tables.hs
@@ -62,7 +62,7 @@ commentItems =
   , (def, Nothing     , "Anonymous spam comment")
   ]
 
-setup :: SeldaT IO ()
+setup :: MonadSelda m => m ()
 setup = do
   createTable people
   createTable modPeople
@@ -73,7 +73,7 @@ setup = do
   insert_ addresses addressItems
   insert_ comments commentItems
 
-teardown :: SeldaT IO ()
+teardown :: MonadSelda m => m ()
 teardown = do
   tryDropTable people
   tryDropTable modPeople
diff --git a/selda-tests/test/Tests/JSON.hs b/selda-tests/test/Tests/JSON.hs
new file mode 100644
index 00000000..a77f488d
--- /dev/null
+++ b/selda-tests/test/Tests/JSON.hs
@@ -0,0 +1,122 @@
+{-# LANGUAGE DeriveGeneric, OverloadedStrings #-}
+module Tests.JSON (jsonTests, jsonQueryTests) where
+import Database.Selda hiding (Result)
+import Database.Selda.JSON
+import Database.Selda.Nullable (nonNull)
+import Control.Monad
+import Data.Aeson
+import qualified Data.ByteString.Lazy as BSL (fromStrict)
+import Data.Text.Encoding (encodeUtf8)
+import Data.List (sort)
+import Test.HUnit
+import Tables (Person (..), peopleItems)
+import Utils
+
+data JSONPerson = JSONPerson
+  { id :: ID JSONPerson
+  , nameKey :: Text
+  , json :: Value
+  } deriving Generic
+instance SqlRow JSONPerson
+
+instance ToJSON Person
+instance FromJSON Person
+
+flipWithM_ :: Monad m => [a] -> [b] -> (a -> b -> m c) -> m ()
+flipWithM_ xs ys f = zipWithM_ f xs ys
+
+jsonPeople :: Table JSONPerson
+jsonPeople = table "jsonPeople" [s_id :- autoPrimary]
+s_id :*: s_nameKey :*: s_json = selectors jsonPeople
+
+jsonTests :: (SeldaM b () -> IO ()) -> Test
+jsonTests freshEnv = test
+  [ "json is properly inserted"    ~: freshEnv insertJson
+  , "json is properly returned"    ~: freshEnv selectJson
+  ]
+
+jsonQueryTests :: JSONBackend b => (SeldaM b () -> IO ()) -> Test
+jsonQueryTests freshEnv = test
+  [ "can select json properties"   ~: freshEnv selectJsonProp
+  , "select dynamic json property" ~: freshEnv selectJsonPropDynamic
+  , "convert json to string"       ~: freshEnv json2String
+  , "missing property yields null" ~: freshEnv missingProp
+  , "chained lookup"               ~: freshEnv chainedLookup
+  ]
+
+
+numPeopleItems :: Int
+numPeopleItems = length peopleItems
+
+withJsonTable :: (Int -> SeldaM b a) -> SeldaM b a
+withJsonTable go = do
+  tryDropTable jsonPeople
+  createTable jsonPeople
+  count <- insert jsonPeople $ map (JSONPerson def "name" . toJSON) peopleItems
+  x <- go count
+  dropTable jsonPeople
+  return x
+
+withJsonTable' :: SeldaM b a -> SeldaM b a
+withJsonTable' go = withJsonTable (const go)
+
+insertJson =
+  withJsonTable $ assEq "wrong number of rows inserted" numPeopleItems
+
+selectJson = withJsonTable' $ do
+  vals <- query $ s_json `from` select jsonPeople
+  let vals' = [v | Success v <- map fromJSON vals]
+  assEq "wrong number of rows returned" numPeopleItems (length vals)
+  assEq "some json conversions failed" (length vals) (length vals')
+  flipWithM_ (sort peopleItems) (sort vals') $ \expected actual -> do
+    assEq "got wrong element from query" expected actual
+
+selectJsonProp :: JSONBackend b => SeldaM b ()
+selectJsonProp = withJsonTable' $ do
+  vals <- query $ do
+    json_person <- s_json `from` select jsonPeople
+    return $ json_person ~> "name"
+  let vals' = [s | Just (String s) <- vals]
+  assEq "wrong number of rows returned" numPeopleItems (length vals)
+  assEq "some json conversions failed" (length vals) (length vals')
+  assEq "wrong list of names returned" (sort $ map name peopleItems) (sort vals')
+
+selectJsonPropDynamic :: JSONBackend b => SeldaM b ()
+selectJsonPropDynamic = withJsonTable' $ do
+  vals <- query $ do
+    person <- select jsonPeople
+    return $ person ! s_json ~> person ! s_nameKey
+  let vals' = [s | Just (String s) <- vals]
+  assEq "wrong number of rows returned" numPeopleItems (length vals)
+  assEq "some json conversions failed" (length vals) (length vals')
+  assEq "wrong list of names returned" (sort $ map name peopleItems) (sort vals')
+
+json2String :: JSONBackend b => SeldaM b ()
+json2String = withJsonTable' $ do
+  vals <- query $ do
+    json_person <- s_json `from` select jsonPeople
+    return $ jsonToText json_person
+  let vals' = [x | Just x <- map (decode . BSL.fromStrict . encodeUtf8) vals]
+  assEq "wrong number of rows returned" numPeopleItems (length vals)
+  assEq "some json conversions failed" (length vals) (length vals')
+  assEq "wrong list of people returned" (sort peopleItems) (sort vals')
+
+missingProp :: JSONBackend b => SeldaM b ()
+missingProp = withJsonTable' $ do
+  vals <- query $ do
+    json_person <- s_json `from` select jsonPeople
+    return $ json_person ~> "this property does not exist"
+  assEq "wrong number of rows returned" numPeopleItems (length vals)
+  forM_ vals $ \actual -> do
+    assEq "some rows were not null" Nothing actual
+
+chainedLookup :: JSONBackend b => SeldaM b ()
+chainedLookup = withJsonTable' $ do
+    update jsonPeople (const true) (`with` [s_json := literal newJson])
+    val <- fmap head . query $ do
+      json_person <- s_json `from` select jsonPeople
+      x <- nonNull (json_person ~> "foo" ~> "bar")
+      return (jsonToText x)
+    assEq "wrong value returned" "42" val
+  where
+    Just newJson = decode "{\"foo\": {\"bar\": 42}}" :: Maybe Value
diff --git a/selda-tests/test/Tests/MultiConn.hs b/selda-tests/test/Tests/MultiConn.hs
index 69cf800f..7e55473b 100644
--- a/selda-tests/test/Tests/MultiConn.hs
+++ b/selda-tests/test/Tests/MultiConn.hs
@@ -10,7 +10,7 @@ import Test.HUnit
 import Utils
 import Tables
 
-multiConnTests :: IO SeldaConnection -> Test
+multiConnTests :: IO (SeldaConnection b) -> Test
 multiConnTests open = test
   [ "setup with runSeldaT" ~: open >>= runSeldaT (teardown >> setup)
   , "connection unusable post-close" ~: postClose open
@@ -24,7 +24,7 @@ multiConnTests open = test
   , "teardown with runSeldaT" ~: open >>= runSeldaT teardown
   ]
 
-postClose :: IO SeldaConnection -> IO ()
+postClose :: IO (SeldaConnection b) -> IO ()
 postClose open = do
   conn <- open
   seldaClose conn
@@ -34,7 +34,7 @@ postClose open = do
     Left (DbError{}) -> return ()
     _                -> liftIO $ assertFailure "post-close error not thrown"
 
-reuse :: IO SeldaConnection -> IO ()
+reuse :: IO (SeldaConnection b) -> IO ()
 reuse open = do
   conn <- open
   res1 <- flip runSeldaT conn $ do
@@ -46,7 +46,7 @@ reuse open = do
   assertEqual "wrong result from second query" ["Kobayashi"] res2
   seldaClose conn
 
-simultaneousConnections :: IO SeldaConnection -> IO ()
+simultaneousConnections :: IO (SeldaConnection b) -> IO ()
 simultaneousConnections open = do
   [c1, c2] <- sequence [open, open]
   res1 <- flip runSeldaT c1 $ do
@@ -58,7 +58,7 @@ simultaneousConnections open = do
   assertEqual "wrong result from second query" ["Kobayashi"] res2
   mapM_ seldaClose [c1, c2]
 
-simultaneousWrites :: IO SeldaConnection -> IO ()
+simultaneousWrites :: IO (SeldaConnection b) -> IO ()
 simultaneousWrites open = do
     c1 <- open
     c2 <- open
@@ -78,7 +78,7 @@ simultaneousWrites open = do
   where
     withC c1 c2 f = f c1 >> f c2
 
-serialized :: IO SeldaConnection -> IO ()
+serialized :: IO (SeldaConnection b) -> IO ()
 serialized open = do
   conn <- open
   ref <- newIORef 0
@@ -94,7 +94,7 @@ serialized open = do
   seldaClose conn
   assertEqual "concurrent use of the same connection" 0 res
 
-twoConnsNotSerialized :: IO SeldaConnection -> IO ()
+twoConnsNotSerialized :: IO (SeldaConnection b) -> IO ()
 twoConnsNotSerialized open = do
   [c1, c2] <- sequence [open, open]
   ref <- newIORef 0
@@ -110,7 +110,7 @@ twoConnsNotSerialized open = do
   mapM_ seldaClose [c1, c2]
   assertEqual "unrelated connections were serialized" 1 res
 
-reuseAfterException :: IO SeldaConnection -> IO ()
+reuseAfterException :: IO (SeldaConnection b) -> IO ()
 reuseAfterException open = do
   conn <- open
   res <- try $ flip runSeldaT conn $ do
@@ -124,7 +124,7 @@ reuseAfterException open = do
       assertEqual "got wrong result after exception" ["Miyu"] res'
 
 {-# NOINLINE allNamesLike #-}
-allNamesLike :: Int -> Text -> SeldaM [Text]
+allNamesLike :: Int -> Text -> SeldaM b [Text]
 allNamesLike = prepared $ \len s -> do
   p <- select people
   restrict (length_ (p ! pName) .> 0)
@@ -136,7 +136,7 @@ allNamesLike = prepared $ \len s -> do
   order (p ! pName) ascending
   return (p ! pName)
 
-reusePrepared :: IO SeldaConnection -> IO ()
+reusePrepared :: IO (SeldaConnection b) -> IO ()
 reusePrepared open = do
   [c1, c2] <- sequence [open, open]
   r11 <- runSeldaT (allNamesLike 4 "%L%") c1
diff --git a/selda-tests/test/Tests/Mutable.hs b/selda-tests/test/Tests/Mutable.hs
index 9273a302..4b14444b 100644
--- a/selda-tests/test/Tests/Mutable.hs
+++ b/selda-tests/test/Tests/Mutable.hs
@@ -21,6 +21,7 @@ import Tables
 import Data.Monoid
 #endif
 
+mutableTests :: (SeldaM b () -> IO ()) -> Test
 mutableTests freshEnv = test
   [ "tryDrop never fails"            ~: freshEnv tryDropNeverFails
   , "tryCreate never fails"          ~: freshEnv tryCreateNeverFails
@@ -74,8 +75,12 @@ mutableTests freshEnv = test
   , "migrate table with index"       ~: freshEnv migrateIndex
   ]
 
+tryDropNeverFails :: SeldaM b ()
 tryDropNeverFails = teardown
+
+tryCreateNeverFails :: SeldaM b ()
 tryCreateNeverFails = tryCreateTable comments >> tryCreateTable comments
+
 dropFailsOnMissing = assertFail $ dropTable comments
 createFailsOnDuplicate = createTable people >> assertFail (createTable people)
 
@@ -158,6 +163,7 @@ transactionCompletes = do
     c1 = "チョロゴン"
     c2 = "メイド最高！"
 
+transactionRollsBack :: SeldaM b ()
 transactionRollsBack = do
   setup
   res <- try $ transaction $ do
@@ -282,6 +288,7 @@ dupeInsertThrowsSeldaError = do
     comments' = table "comments" [Single cId :- primary]
     cId :*: cName :*: cComment = selectors comments'
 
+dupeInsert2ThrowsSeldaError :: SeldaM b ()
 dupeInsert2ThrowsSeldaError = do
   setup
   insert_ comments [(def, Just "Kobayashi", "チョロゴン")]
@@ -291,6 +298,7 @@ dupeInsert2ThrowsSeldaError = do
     Left _ -> return ()
     _      -> liftIO $ assertFailure "SeldaError not thrown"
 
+dupeUpdateThrowsSeldaError :: SeldaM b ()
 dupeUpdateThrowsSeldaError = do
   setup
   insert_ comments
@@ -825,8 +833,10 @@ uuidQueries = do
     x <- select uuidTable
     restrict (x ! unsafeSelector 0 .== literal a)
     return x
+  dropTable uuidTable
   assEq "wrong uuid returned" a a'
 
+migrateIndex :: SeldaM b ()
 migrateIndex = do
     tryDropTable tbl1
     createTable tbl1
diff --git a/selda-tests/test/Tests/Query.hs b/selda-tests/test/Tests/Query.hs
index b4315144..bacace8f 100644
--- a/selda-tests/test/Tests/Query.hs
+++ b/selda-tests/test/Tests/Query.hs
@@ -10,6 +10,7 @@ import Test.HUnit
 import Utils
 import Tables
 
+queryTests :: (SeldaM b () -> IO ()) -> Test
 queryTests run = test
   [ "setup succeeds" ~: run setup
   , "simple select" ~: run simpleSelect
@@ -301,7 +302,7 @@ testSuchThat = do
   assEq "got wrong result" ["Link" :*: "Velvet"] res
 
 {-# NOINLINE allShortNames #-}
-allShortNames :: SeldaM [Text]
+allShortNames :: SeldaM b [Text]
 allShortNames = prepared $ do
   p <- select people
   restrict (length_ (p ! pName) .<= 4)
@@ -319,7 +320,7 @@ preparedNoArgs = do
 
 {-# NOINLINE allNamesLike #-}
 -- Extra restricts to force the presence of a few non-argument parameters.
-allNamesLike :: Int -> Text -> SeldaM [Text]
+allNamesLike :: Int -> Text -> SeldaM b [Text]
 allNamesLike = prepared $ \len s -> do
   p <- select people
   restrict (length_ (p ! pName) .> 0)
@@ -533,7 +534,7 @@ coalesceRow = do
       , Just "Velvet"
       ]
 
-
+coalesceEquality :: SeldaM b ()
 coalesceEquality = do
   ["Link"] <- query $ do
     person <- select people
@@ -545,6 +546,7 @@ coalesceEquality = do
     return (person ! pName)
   return ()
 
+coalesceNum :: SeldaM b ()
 coalesceNum = do
   [Just 250 :*: Just 126 :*: Just 124] <- query $ do
     _ <- selectValues [Only (1 :: Int)]
diff --git a/selda-tests/test/Tests/Validation.hs b/selda-tests/test/Tests/Validation.hs
index f5c1fb28..ca47e712 100644
--- a/selda-tests/test/Tests/Validation.hs
+++ b/selda-tests/test/Tests/Validation.hs
@@ -13,6 +13,7 @@ import Test.HUnit
 import Utils
 import Tables
 
+validationTests :: (SeldaM b () -> IO ()) -> [Test]
 validationTests freshEnv =
   [ "nul identifiers fail"                ~: freshEnv nulIdentifiersFail
   , "empty identifiers are caught"        ~: freshEnv emptyIdentifiersFail
@@ -30,8 +31,8 @@ validationTests freshEnv =
   ]
 
 nulIdentifiersFail = do
-  e1 <- try (createTable nulTable) :: SeldaM (Either ValidationError ())
-  e2 <- try (createTable nulColTable) :: SeldaM (Either ValidationError ())
+  e1 <- try (createTable nulTable) :: SeldaM b (Either ValidationError ())
+  e2 <- try (createTable nulColTable) :: SeldaM b (Either ValidationError ())
   case (e1, e2) of
     (Left _, Left _) -> return ()
     _                -> liftIO $ assertFailure "ValidationError not thrown"
@@ -43,8 +44,8 @@ nulIdentifiersFail = do
     nulColTable = tableFieldMod "nul_col_table" [] (const "col_\0")
 
 emptyIdentifiersFail = do
-  e1 <- try (createTable noNameTable) :: SeldaM (Either ValidationError ())
-  e2 <- try (createTable noColNameTable) :: SeldaM (Either ValidationError ())
+  e1 <- try (createTable noNameTable) :: SeldaM b (Either ValidationError ())
+  e2 <- try (createTable noColNameTable) :: SeldaM b (Either ValidationError ())
   case (e1, e2) of
     (Left _, Left _)   -> return ()
     (Right _, Left _)  -> liftIO $ assertFailure "empty table name not caught"
@@ -58,7 +59,7 @@ emptyIdentifiersFail = do
     noColNameTable = tableFieldMod "table with empty col name" [] (const "")
 
 duplicateColsFail = do
-  e <- try (createTable dupes) :: SeldaM (Either ValidationError ())
+  e <- try (createTable dupes) :: SeldaM b (Either ValidationError ())
   case e of
     Left _ -> return ()
     _      -> liftIO $ assertFailure "ValidationError not thrown"
@@ -73,8 +74,8 @@ sel_snd :: (SqlType a, SqlType b) => Selector (a, b) b
 sel_snd = unsafeSelector 1
 
 duplicatePKsFail = do
-  e1 <- try (createTable dupes1) :: SeldaM (Either ValidationError ())
-  e2 <- try (createTable dupes2) :: SeldaM (Either ValidationError ())
+  e1 <- try (createTable dupes1) :: SeldaM b (Either ValidationError ())
+  e2 <- try (createTable dupes2) :: SeldaM b (Either ValidationError ())
   case (e1, e2) of
     (Left _, Left _) -> return ()
     _                -> liftIO $ assertFailure "ValidationError not thrown"
@@ -91,7 +92,7 @@ duplicatePKsFail = do
       ]
 
 nonUniqueFKFails = do
-    res <- try (createTable addressesWithFK) :: SeldaM (Either ValidationError ())
+    res <- try (createTable addressesWithFK) :: SeldaM b (Either ValidationError ())
     case res of
       Left _  -> return ()
       Right _ -> liftIO $ assertFailure "ValidationError not thrown"
@@ -101,6 +102,7 @@ nonUniqueFKFails = do
       [ sel_fst :- foreignKey comments cComment
       ]
 
+nonPrimaryUniqueFK :: SeldaM b ()
 nonPrimaryUniqueFK = do
     createTable uniquePeople
     createTable addressesWithFK
@@ -115,6 +117,7 @@ nonPrimaryUniqueFK = do
       [ sel_fst :- foreignKey uniquePeople upName
       ]
 
+nullableUnique :: SeldaM b ()
 nullableUnique = do
     createTable uniquePeople
     dropTable uniquePeople
@@ -267,6 +270,7 @@ validateMultiPk = do
 
     (one :*: two) = selectors tbl1
 
+validateTimestamp :: SeldaM b ()
 validateTimestamp = do
     tryDropTable tbl
     createTable tbl
diff --git a/selda-tests/test/Utils.hs b/selda-tests/test/Utils.hs
index f5639826..9375b0b1 100644
--- a/selda-tests/test/Utils.hs
+++ b/selda-tests/test/Utils.hs
@@ -5,7 +5,7 @@ import Database.Selda
 import Test.HUnit
 
 -- | Assert that the given computation should fail.
-assertFail :: SeldaT IO a -> SeldaT IO ()
+assertFail :: SeldaM b a -> SeldaM b ()
 assertFail m = do
   res <- try m
   case res of
@@ -13,9 +13,9 @@ assertFail m = do
     _                      -> liftIO $ assertFailure "computation did not fail"
 
 -- | @SeldaT@ wrapper for 'assertEqual'.
-assEq :: (Show a, Eq a) => String -> a -> a -> SeldaT IO ()
+assEq :: (Show a, Eq a) => String -> a -> a -> SeldaM b ()
 assEq s expect actual = liftIO $ assertEqual s expect actual
 
 -- | @SeldaT@ wrapper for 'assertBool'.
-ass :: String -> Bool -> SeldaT IO ()
+ass :: String -> Bool -> SeldaM b ()
 ass s pred = liftIO $ assertBool s pred
diff --git a/selda/src/Database/Selda/Backend.hs b/selda/src/Database/Selda/Backend.hs
index 43c1f2d6..1da2115a 100644
--- a/selda/src/Database/Selda/Backend.hs
+++ b/selda/src/Database/Selda/Backend.hs
@@ -27,7 +27,7 @@ import Database.Selda.Types
 --   Closing a connection while in use is undefined.
 --   Passing a closed connection to 'runSeldaT' results in a 'SeldaError'
 --   being thrown. Closing a connection more than once is a no-op.
-seldaClose :: MonadIO m => SeldaConnection -> m ()
+seldaClose :: MonadIO m => SeldaConnection b -> m ()
 seldaClose c = liftIO $ mask_ $ do
   closed <- atomicModifyIORef' (connClosed c) $ \closed -> (True, closed)
   unless closed $ closeConnection (connBackend c) c
diff --git a/selda/src/Database/Selda/Backend/Internal.hs b/selda/src/Database/Selda/Backend/Internal.hs
index b58668f9..9b39a9e1 100644
--- a/selda/src/Database/Selda/Backend/Internal.hs
+++ b/selda/src/Database/Selda/Backend/Internal.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving, DefaultSignatures, CPP #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving, DefaultSignatures, CPP, TypeFamilies #-}
 -- | Internal backend API.
 --   Using anything exported from this module may or may not invalidate any
 --   safety guarantees made by Selda; use at your own peril.
@@ -94,9 +94,9 @@ data SeldaStmt = SeldaStmt
  , stmtTables :: ![TableName]
  }
 
-data SeldaConnection = SeldaConnection
+data SeldaConnection b = SeldaConnection
   { -- | The backend used by the current connection.
-    connBackend :: !SeldaBackend
+    connBackend :: !(SeldaBackend b)
 
     -- | A string uniquely identifying the database used by this connection.
     --   This could be, for instance, a PostgreSQL connection
@@ -116,7 +116,7 @@ data SeldaConnection = SeldaConnection
 
 -- | Create a new Selda connection for the given backend and database
 --   identifier string.
-newConnection :: MonadIO m => SeldaBackend -> Text -> m SeldaConnection
+newConnection :: MonadIO m => SeldaBackend b -> Text -> m (SeldaConnection b)
 newConnection back dbid =
   liftIO $ SeldaConnection back dbid <$> newIORef M.empty
                                      <*> newIORef False
@@ -124,7 +124,7 @@ newConnection back dbid =
 
 -- | Get all statements and their corresponding identifiers for the current
 --   connection.
-allStmts :: SeldaConnection -> IO [(StmtID, Dynamic)]
+allStmts :: SeldaConnection b -> IO [(StmtID, Dynamic)]
 allStmts =
   fmap (map (\(k, v) -> (k, stmtHandle v)) . M.toList) . readIORef . connStmts
 
@@ -186,7 +186,7 @@ tableInfo t = TableInfo
       ]
 
 -- | A collection of functions making up a Selda backend.
-data SeldaBackend = SeldaBackend
+data SeldaBackend b = SeldaBackend
   { -- | Execute an SQL statement.
     runStmt :: Text -> [Param] -> IO (Int, [[SqlValue]])
 
@@ -210,7 +210,7 @@ data SeldaBackend = SeldaBackend
   , ppConfig :: PPConfig
 
     -- | Close the currently open connection.
-  , closeConnection :: SeldaConnection -> IO ()
+  , closeConnection :: SeldaConnection b -> IO ()
 
     -- | Unique identifier for this backend.
   , backendId :: BackendID
@@ -225,9 +225,9 @@ data SeldaBackend = SeldaBackend
   , disableForeignKeys :: Bool -> IO ()
   }
 
-data SeldaState = SeldaState
+data SeldaState b = SeldaState
   { -- | Connection in use by the current computation.
-    stConnection :: !SeldaConnection
+    stConnection :: !(SeldaConnection b)
 
     -- | Tables modified by the current transaction.
     --   Invariant: always @Just xs@ during a transaction, and always
@@ -242,9 +242,12 @@ data SeldaState = SeldaState
 --   invoked. If you want to use Selda's built-in caching mechanism, you will
 --   need to implement these operations yourself.
 class MonadIO m => MonadSelda m where
+  -- | Type of database backend used by @m@.
+  type Backend m
+
   -- | Get the connection in use by the computation.
   --   Must always return the same connection during a transaction.
-  seldaConnection :: m SeldaConnection
+  seldaConnection :: m (SeldaConnection (Backend m))
 
   -- | Invalidate the given table as soon as the current transaction finishes.
   --   Invalidate the table immediately if no transaction is ongoing.
@@ -277,19 +280,21 @@ class MonadIO m => MonadSelda m where
   {-# MINIMAL seldaConnection #-}
 
 -- | Get the backend in use by the computation.
-seldaBackend :: MonadSelda m => m SeldaBackend
+seldaBackend :: MonadSelda m => m (SeldaBackend (Backend m))
 seldaBackend = connBackend <$> seldaConnection
 
 -- | Monad transformer adding Selda SQL capabilities.
-newtype SeldaT m a = S {unS :: StateT SeldaState m a}
+newtype SeldaT b m a = S {unS :: StateT (SeldaState b) m a}
   deriving ( Functor, Applicative, Monad, MonadIO
-           , MonadThrow, MonadCatch, MonadMask, MonadTrans
+           , MonadThrow, MonadCatch, MonadMask
 #if MIN_VERSION_base(4, 9, 0)
            , MonadFail
 #endif
            )
 
-instance (MonadIO m, MonadMask m) => MonadSelda (SeldaT m) where
+instance (MonadIO m, MonadMask m) => MonadSelda (SeldaT b m) where
+  type Backend (SeldaT b m) = b
+
   seldaConnection = S $ fmap stConnection get
 
   invalidateTable tbl = S $ do
@@ -311,11 +316,14 @@ instance (MonadIO m, MonadMask m) => MonadSelda (SeldaT m) where
     return x
 
 -- | The simplest form of Selda computation; 'SeldaT' specialized to 'IO'.
-type SeldaM = SeldaT IO
+type SeldaM b = SeldaT b IO
 
 -- | Run a Selda transformer. Backends should use this to implement their
 --   @withX@ functions.
-runSeldaT :: (MonadIO m, MonadMask m) => SeldaT m a -> SeldaConnection -> m a
+runSeldaT :: (MonadIO m, MonadMask m)
+          => SeldaT b m a
+          -> SeldaConnection b
+          -> m a
 runSeldaT m c =
     bracket (liftIO $ takeMVar (connLock c))
             (const $ liftIO $ putMVar (connLock c) ())
diff --git a/selda/src/Database/Selda/Caching.hs b/selda/src/Database/Selda/Caching.hs
index cb005a5f..886a1b96 100644
--- a/selda/src/Database/Selda/Caching.hs
+++ b/selda/src/Database/Selda/Caching.hs
@@ -55,7 +55,7 @@ instance Hashable (Lit a) where
   hashWithSalt s (LBlob x)     = hashWithSalt s x
   hashWithSalt s (LJust x)     = hashWithSalt s x
   hashWithSalt _ (LNull)       = 0
-  hashWithSalt s (LCustom l)   = hashWithSalt s l
+  hashWithSalt s (LCustom _ l) = hashWithSalt s l
   hashWithSalt s (LUUID x)     = hashWithSalt s x
 
 hashUTCTime :: Int -> UTCTime -> Int
diff --git a/selda/src/Database/Selda/Exp.hs b/selda/src/Database/Selda/Exp.hs
index d10f303e..87d66cc4 100644
--- a/selda/src/Database/Selda/Exp.hs
+++ b/selda/src/Database/Selda/Exp.hs
@@ -27,7 +27,7 @@ hideRenaming (Some c)    = Untyped c
 data Exp sql a where
   Col     :: !ColName -> Exp sql a
   Lit     :: !(Lit a) -> Exp sql a
-  BinOp   :: !(BinOp a b) -> !(Exp sql a) -> !(Exp sql a) -> Exp sql b
+  BinOp   :: !(BinOp a b c) -> !(Exp sql a) -> !(Exp sql b) -> Exp sql c
   UnOp    :: !(UnOp a b) -> !(Exp sql a) -> Exp sql b
   NulOp   :: !(NulOp a) -> Exp sql a
   Fun2    :: !Text -> !(Exp sql a) -> !(Exp sql b) -> Exp sql c
@@ -38,7 +38,7 @@ data Exp sql a where
   InQuery :: !(Exp sql a) -> !sql -> Exp sql Bool
 
 data NulOp a where
-  Fun0   :: Text -> NulOp a
+  Fun0 :: !Text -> NulOp a
 
 data UnOp a b where
   Abs    :: UnOp a a
@@ -46,22 +46,23 @@ data UnOp a b where
   Neg    :: UnOp a a
   Sgn    :: UnOp a a
   IsNull :: UnOp (Maybe a) Bool
-  Fun    :: Text -> UnOp a b
+  Fun    :: !Text -> UnOp a b
 
-data BinOp a b where
-  Gt    :: BinOp a Bool
-  Lt    :: BinOp a Bool
-  Gte   :: BinOp a Bool
-  Lte   :: BinOp a Bool
-  Eq    :: BinOp a Bool
-  Neq   :: BinOp a Bool
-  And   :: BinOp Bool Bool
-  Or    :: BinOp Bool Bool
-  Add   :: BinOp a a
-  Sub   :: BinOp a a
-  Mul   :: BinOp a a
-  Div   :: BinOp a a
-  Like  :: BinOp Text Bool
+data BinOp a b c where
+  Gt   :: BinOp a a Bool
+  Lt   :: BinOp a a Bool
+  Gte  :: BinOp a a Bool
+  Lte  :: BinOp a a Bool
+  Eq   :: BinOp a a Bool
+  Neq  :: BinOp a a Bool
+  And  :: BinOp Bool Bool Bool
+  Or   :: BinOp Bool Bool Bool
+  Add  :: BinOp a a a
+  Sub  :: BinOp a a a
+  Mul  :: BinOp a a a
+  Div  :: BinOp a a a
+  Like :: BinOp Text Text Bool
+  CustomOp :: !Text -> BinOp a b c
 
 -- | Any type which may contain column names.
 class Names a where
diff --git a/selda/src/Database/Selda/Frontend.hs b/selda/src/Database/Selda/Frontend.hs
index 3d9f5bf8..7716222f 100644
--- a/selda/src/Database/Selda/Frontend.hs
+++ b/selda/src/Database/Selda/Frontend.hs
@@ -30,7 +30,7 @@ import Control.Monad.IO.Class
 --   transformer on top of some other monad.
 --   Selda transformers are entered using backend-specific @withX@ functions,
 --   such as 'withSQLite' from the SQLite backend.
-query :: (MonadSelda m, Result a) => Query s a -> m [Res a]
+query :: (MonadSelda m, Result a) => Query (Backend m) a -> m [Res a]
 query q = do
   backend <- seldaBackend
   queryWith (runStmt backend) q
@@ -39,7 +39,7 @@ query q = do
 --   Returns the number of inserted rows.
 queryInto :: (MonadSelda m, Relational a)
           => Table a
-          -> Query s (Row s a)
+          -> Query (Backend m) (Row (Backend m) a)
           -> m Int
 queryInto tbl q = do
     backend <- seldaBackend
@@ -109,12 +109,10 @@ tryInsert tbl row = do
 --
 --   Note that this may perform two separate queries: one update, potentially
 --   followed by one insert.
-upsert :: ( MonadSelda m
-          , Relational a
-          )
+upsert :: (MonadSelda m, Relational a)
        => Table a
-       -> (Row s a -> Col s Bool)
-       -> (Row s a -> Row s a)
+       -> (Row (Backend m) a -> Col (Backend m) Bool)
+       -> (Row (Backend m) a -> Row (Backend m) a)
        -> [a]
        -> m (Maybe (ID a))
 upsert tbl check upd rows = transaction $ do
@@ -130,22 +128,18 @@ upsert tbl check upd rows = transaction $ do
 --   If called on a table which doesn't have an auto-incrementing primary key,
 --   @Just id@ is always returned on successful insert, where @id@ is a row
 --   identifier guaranteed to not match any row in any table.
-insertUnless :: ( MonadSelda m
-                , Relational a
-                )
+insertUnless :: (MonadSelda m, Relational a)
              => Table a
-             -> (Row s a -> Col s Bool)
+             -> (Row (Backend m) a -> Col (Backend m) Bool)
              -> [a]
              -> m (Maybe (ID a))
 insertUnless tbl check rows = upsert tbl check id rows
 
 -- | Like 'insertUnless', but performs the insert when at least one row matches
 --   the predicate.
-insertWhen :: ( MonadSelda m
-              , Relational a
-              )
+insertWhen :: (MonadSelda m, Relational a)
            => Table a
-           -> (Row s a -> Col s Bool)
+           -> (Row (Backend m) a -> Col (Backend m) Bool)
            -> [a]
            -> m (Maybe (ID a))
 insertWhen tbl check rows = transaction $ do
@@ -179,9 +173,9 @@ insertWithPK t cs = do
 -- | Update the given table using the given update function, for all rows
 --   matching the given predicate. Returns the number of updated rows.
 update :: (MonadSelda m, Relational a)
-       => Table a                 -- ^ Table to update.
-       -> (Row s a -> Col s Bool) -- ^ Predicate.
-       -> (Row s a -> Row s a)    -- ^ Update function.
+       => Table a                                     -- ^ Table to update.
+       -> (Row (Backend m) a -> Col (Backend m) Bool) -- ^ Predicate.
+       -> (Row (Backend m) a -> Row (Backend m) a)    -- ^ Update function.
        -> m Int
 update tbl check upd = do
   cfg <- ppConfig <$> seldaBackend
@@ -192,8 +186,8 @@ update tbl check upd = do
 -- | Like 'update', but doesn't return the number of updated rows.
 update_ :: (MonadSelda m, Relational a)
        => Table a
-       -> (Row s a -> Col s Bool)
-       -> (Row s a -> Row s a)
+       -> (Row (Backend m) a -> Col (Backend m) Bool)
+       -> (Row (Backend m) a -> Row (Backend m) a)
        -> m ()
 update_ tbl check upd = void $ update tbl check upd
 
@@ -201,7 +195,7 @@ update_ tbl check upd = void $ update tbl check upd
 --   Returns the number of deleted rows.
 deleteFrom :: (MonadSelda m, Relational a)
            => Table a
-           -> (Row s a -> Col s Bool)
+           -> (Row (Backend m) a -> Col (Backend m) Bool)
            -> m Int
 deleteFrom tbl f = do
   cfg <- ppConfig <$> seldaBackend
@@ -212,7 +206,7 @@ deleteFrom tbl f = do
 -- | Like 'deleteFrom', but does not return the number of deleted rows.
 deleteFrom_ :: (MonadSelda m, Relational a)
             => Table a
-            -> (Row s a -> Col s Bool)
+            -> (Row (Backend m) a -> Col (Backend m) Bool)
             -> m ()
 deleteFrom_ tbl f = void $ deleteFrom tbl f
 
@@ -288,8 +282,8 @@ setLocalCache :: MonadIO m => Int -> m ()
 setLocalCache = liftIO . setMaxItems
 
 -- | Build the final result from a list of result columns.
-queryWith :: forall s m a. (MonadSelda m, Result a)
-          => QueryRunner (Int, [[SqlValue]]) -> Query s a -> m [Res a]
+queryWith :: forall m a. (MonadSelda m, Result a)
+          => QueryRunner (Int, [[SqlValue]]) -> Query (Backend m) a -> m [Res a]
 queryWith qr q = do
   conn <- seldaConnection
   let backend = connBackend conn
@@ -325,5 +319,5 @@ exec q ps = do
   liftIO $ execIO backend q ps
 
 -- | Like 'exec', but in 'IO'.
-execIO :: SeldaBackend -> Text -> [Param] -> IO Int
+execIO :: SeldaBackend b -> Text -> [Param] -> IO Int
 execIO backend q ps = fmap fst $ runStmt backend q ps
diff --git a/selda/src/Database/Selda/Migrations.hs b/selda/src/Database/Selda/Migrations.hs
index 98228ae6..76ffe5d9 100644
--- a/selda/src/Database/Selda/Migrations.hs
+++ b/selda/src/Database/Selda/Migrations.hs
@@ -22,16 +22,16 @@ import Database.Selda.Validation
 -- >   , Migration m2_from m2_to m2_upgrade
 -- >   , ...
 -- >   ]
-data Migration where
+data Migration backend where
   Migration :: (Relational a, Relational b)
             => Table a
             -> Table b
-            -> (Row s a -> Query s (Row s b))
-            -> Migration
+            -> (Row backend a -> Query backend (Row backend b))
+            -> Migration backend
 
 -- | A migration step is zero or more migrations that need to be performed in
 --   a single transaction in order to keep the database consistent.
-type MigrationStep = [Migration]
+type MigrationStep backend = [Migration backend]
 
 -- | Migrate the first table into the second, using the given function to
 --   migrate all records to the new schema.
@@ -43,17 +43,17 @@ type MigrationStep = [Migration]
 migrate :: (MonadSelda m, MonadMask m, Relational a, Relational b)
         => Table a -- ^ Table to migrate from.
         -> Table b -- ^ Table to migrate to.
-        -> (Row () a -> Row () b)
+        -> (Row (Backend m) a -> Row (Backend m) b)
                    -- ^ Mapping from old to new table.
         -> m ()
-migrate t1 t2 upg = migrateM t1 t2 ((pure :: a -> Query () a) . upg)
+migrate t1 t2 upg = migrateM t1 t2 (pure . upg)
 
 -- | Like 'migrate', but allows the column upgrade to access
 --   the entire database.
 migrateM :: (MonadSelda m, MonadMask m, Relational a, Relational b)
          => Table a
          -> Table b
-         -> (Row s a -> Query s (Row s b))
+         -> (Row (Backend m) a -> Query (Backend m) (Row (Backend m) b))
          -> m ()
 migrateM t1 t2 upg = migrateAll True [Migration t1 t2 upg]
 
@@ -65,7 +65,7 @@ wrap enforceFKs
 -- | Perform all given migrations as a single transaction.
 migrateAll :: (MonadSelda m, MonadMask m)
            => Bool -- ^ Enforce foreign keys during migration?
-           -> MigrationStep -- ^ Migration step to perform.
+           -> MigrationStep (Backend m) -- ^ Migration step to perform.
            -> m ()
 migrateAll fks =
   wrap fks . mapM_ (\(Migration t1 t2 upg) -> migrateInternal t1 t2 upg)
@@ -85,7 +85,7 @@ migrateAll fks =
 --   @c2@ is indexed with index method @bar@.
 autoMigrate :: (MonadSelda m, MonadMask m)
             => Bool -- ^ Enforce foreign keys during migration?
-            -> [MigrationStep] -- ^ Migration steps to perform.
+            -> [MigrationStep (Backend m)] -- ^ Migration steps to perform.
             -> m ()
 autoMigrate _ [] = do
   return ()
@@ -114,7 +114,7 @@ autoMigrate fks steps = wrap fks $ do
 migrateInternal :: (MonadSelda m, MonadThrow m, Relational a, Relational b)
                 => Table a
                 -> Table b
-                -> (Row s a -> Query s (Row s b))
+                -> (Row (Backend m) a -> Query (Backend m) (Row (Backend m) b))
                 -> m ()
 migrateInternal t1 t2 upg = do
     validateTable t1
diff --git a/selda/src/Database/Selda/Nullable.hs b/selda/src/Database/Selda/Nullable.hs
index 11c083b8..b7166ad6 100644
--- a/selda/src/Database/Selda/Nullable.hs
+++ b/selda/src/Database/Selda/Nullable.hs
@@ -26,7 +26,7 @@ type family NonNull a where
 -- | Unconditionally convert a nullable value into a non-nullable one,
 --   using the standard SQL null-coalescing behavior.
 fromNullable :: SqlType (NonNull a) => Col s a -> Col s (NonNull a)
-fromNullable = cast
+fromNullable = unsafeCoerce
 
 (?==), (?/=) :: (a :?~ b, SqlType a) => Col s a -> Col s b -> Col s (Maybe Bool)
 
@@ -72,9 +72,9 @@ infixl 9 ?!
 nonNull :: SqlType a => Col s (Maybe a) -> Query s (Col s a)
 nonNull x = do
   restrict (not_ $ isNull x)
-  return (cast x)
+  return (fromNullable x)
 
 -- | Restrict a query using a nullable expression.
 --   Equivalent to @restrict . ifNull false@.
 restrict' :: Col s (Maybe Bool) -> Query s ()
-restrict' = restrict . cast
+restrict' = restrict . fromNullable
diff --git a/selda/src/Database/Selda/Prepared.hs b/selda/src/Database/Selda/Prepared.hs
index 0e501ab9..8e6d6018 100644
--- a/selda/src/Database/Selda/Prepared.hs
+++ b/selda/src/Database/Selda/Prepared.hs
@@ -34,7 +34,7 @@ type family ResultT f where
 
 type family Equiv q f where
   Equiv (Col s a -> q) (a -> f) = Equiv q f
-  Equiv (Query s a)    (m [b])  = Res a ~ b
+  Equiv (Query s a)    (m [b])  = (Res a ~ b, Backend m ~ s)
 
 type CompResult = (Text, [Either Int Param], [SqlTypeRep], [TableName])
 
@@ -114,8 +114,10 @@ instance (Typeable a, MonadSelda m, a ~ Res (ResultT q), Result (ResultT q)) =>
             return $ map (buildResult (Proxy :: Proxy (ResultT q))) (snd res)
 
 instance (SqlType a, Preparable b) => Preparable (Col s a -> b) where
-  mkQuery n f ts = mkQuery (n+1) (f x) (sqlType (Proxy :: Proxy a) : ts)
-    where x = One $ Lit $ LCustom (throw (Placeholder n) :: Lit a)
+  mkQuery n f ts = mkQuery (n+1) (f x) (t : ts)
+    where
+      t = sqlType (Proxy :: Proxy a)
+      x = One $ Lit $ LCustom t (throw (Placeholder n) :: Lit a)
 
 instance Result a => Preparable (Query s a) where
   mkQuery _ q types = do
@@ -145,16 +147,20 @@ instance Result a => Preparable (Query s a) where
 --   queries aren't re-prepared more than absolutely necessary,
 --   consider adding a @NOINLINE@ annotation to each prepared function.
 --
+--   Note that when using a constrained backend type variable (i.e.
+--   @foo :: Bar b => SeldaM b [Int]@), optimizations must be enabled for
+--   prepared statements to be effective.
+--
 --   A usage example:
 --
--- > ages :: Table (Text :*: Int)
--- > ages = table "ages" $ primary "name" :*: required "age"
+-- > persons :: Table (Text, Int)
+-- > (persons, name :*: age) = tableWithSelectors "ages" [name :- primary]
 -- >
 -- > {-# NOINLINE ageOf #-}
 -- > ageOf :: Text -> SeldaM [Int]
 -- > ageOf = prepared $ \n -> do
--- >   (name :*: age) <- select ages
--- >   restrict $ name .== n
+-- >   person <- select ages
+-- >   restrict $ (person!name .== n)
 -- >   return age
 {-# NOINLINE prepared #-}
 prepared :: (Preparable q, Prepare q f, Equiv q f) => q -> f
@@ -192,5 +198,5 @@ inspectParams _ [] = do
 
 -- | Force a parameter deep enough to determine whether it is a placeholder.
 forceParam :: Param -> Param
-forceParam p@(Param (LCustom x)) | x `seq` True = p
-forceParam p                                    = p
+forceParam p@(Param (LCustom _ x)) | x `seq` True = p
+forceParam p                                      = p
diff --git a/selda/src/Database/Selda/SQL/Print.hs b/selda/src/Database/Selda/SQL/Print.hs
index 0fecbd0b..7359bb16 100644
--- a/selda/src/Database/Selda/SQL/Print.hs
+++ b/selda/src/Database/Selda/SQL/Print.hs
@@ -260,7 +260,7 @@ ppUnOp op c = do
     IsNull -> "(" <> c' <> ") IS NULL"
     Fun f  -> f <> "(" <> c' <> ")"
 
-ppBinOp :: BinOp a b -> Exp SQL a -> Exp SQL a -> PP Text
+ppBinOp :: BinOp a b c -> Exp SQL a -> Exp SQL b -> PP Text
 ppBinOp op a b = do
     a' <- ppCol a
     b' <- ppCol b
@@ -271,17 +271,18 @@ ppBinOp op a b = do
     paren (Lit{}) c = c
     paren _ c       = "(" <> c <> ")"
 
-    ppOp :: BinOp a b -> Text
-    ppOp Gt    = ">"
-    ppOp Lt    = "<"
-    ppOp Gte   = ">="
-    ppOp Lte   = "<="
-    ppOp Eq    = "="
-    ppOp Neq   = "!="
-    ppOp And   = "AND"
-    ppOp Or    = "OR"
-    ppOp Add   = "+"
-    ppOp Sub   = "-"
-    ppOp Mul   = "*"
-    ppOp Div   = "/"
-    ppOp Like  = "LIKE"
+    ppOp :: BinOp a b c -> Text
+    ppOp Gt   = ">"
+    ppOp Lt   = "<"
+    ppOp Gte  = ">="
+    ppOp Lte  = "<="
+    ppOp Eq   = "="
+    ppOp Neq  = "!="
+    ppOp And  = "AND"
+    ppOp Or   = "OR"
+    ppOp Add  = "+"
+    ppOp Sub  = "-"
+    ppOp Mul  = "*"
+    ppOp Div  = "/"
+    ppOp Like = "LIKE"
+    ppOp (CustomOp s) = s
diff --git a/selda/src/Database/Selda/SQL/Print/Config.hs b/selda/src/Database/Selda/SQL/Print/Config.hs
index c1277e81..d4da19f7 100644
--- a/selda/src/Database/Selda/SQL/Print/Config.hs
+++ b/selda/src/Database/Selda/SQL/Print/Config.hs
@@ -66,6 +66,7 @@ defPPConfig = PPConfig
     }
 
 -- | Default compilation for SQL types.
+--   By default, anything we don't know is just a blob.
 defType :: SqlTypeRep -> Text
 defType TText     = "TEXT"
 defType TRowID    = "INTEGER"
@@ -77,6 +78,7 @@ defType TDate     = "DATE"
 defType TTime     = "TIME"
 defType TBlob     = "BLOB"
 defType TUUID     = "BLOB"
+defType TJSON     = "BLOB"
 
 -- | Default compilation for a column attribute.
 defColAttr :: ColAttr -> Text
diff --git a/selda/src/Database/Selda/SqlType.hs b/selda/src/Database/Selda/SqlType.hs
index 5ee6e1b2..55d4c4c2 100644
--- a/selda/src/Database/Selda/SqlType.hs
+++ b/selda/src/Database/Selda/SqlType.hs
@@ -49,6 +49,7 @@ data SqlTypeRep
   | TTime
   | TBlob
   | TUUID
+  | TJSON
     deriving (Show, Eq, Ord)
 
 -- | Any datatype representable in (Selda's subset of) SQL.
@@ -56,7 +57,7 @@ class Typeable a => SqlType a where
   -- | Create a literal of this type.
   mkLit :: a -> Lit a
   default mkLit :: (Typeable a, SqlEnum a) => a -> Lit a
-  mkLit = LCustom . LText . toText
+  mkLit = LCustom TText . LText . toText
 
   -- | The SQL representation for this type.
   sqlType :: Proxy a -> SqlTypeRep
@@ -70,7 +71,7 @@ class Typeable a => SqlType a where
   -- | Default value when using 'def' at this type.
   defaultValue :: Lit a
   default defaultValue :: (Typeable a, SqlEnum a) => Lit a
-  defaultValue = LCustom $ mkLit (toText (minBound :: a))
+  defaultValue = mkLit (minBound :: a)
 
 -- | Any type that's bounded, enumerable and has a text representation, and
 --   thus representable as a Selda enumerable.
@@ -101,7 +102,7 @@ data Lit a where
   LJust     :: SqlType a => !(Lit a) -> Lit (Maybe a)
   LBlob     :: !ByteString -> Lit ByteString
   LNull     :: SqlType a => Lit (Maybe a)
-  LCustom   :: Lit a       -> Lit b
+  LCustom   :: SqlTypeRep  -> Lit a -> Lit b
   LUUID     :: !UUID       -> Lit UUID
 
 -- | The SQL type representation for the given literal.
@@ -119,7 +120,7 @@ litType (x@LNull)     = sqlType (proxyFor x)
   where
     proxyFor :: Lit (Maybe a) -> Proxy a
     proxyFor _ = Proxy
-litType (LCustom x)   = litType x
+litType (LCustom t _) = t
 litType (LUUID{})     = TUUID
 
 instance Eq (Lit a) where
@@ -154,7 +155,7 @@ compLit (LDate x)     (LDate x')     = x `compare` x'
 compLit (LTime x)     (LTime x')     = x `compare` x'
 compLit (LBlob x)     (LBlob x')     = x `compare` x'
 compLit (LJust x)     (LJust x')     = x `compLit` x'
-compLit (LCustom x)   (LCustom x')   = x `compLit` x'
+compLit (LCustom _ x) (LCustom _ x') = x `compLit` x'
 compLit (LUUID x)     (LUUID x')     = x `compare` x'
 compLit a             b              = litConTag a `compare` litConTag b
 
@@ -192,7 +193,7 @@ instance Show (Lit a) where
   show (LBlob b)     = show b
   show (LJust x)     = "Just " ++ show x
   show (LNull)       = "Nothing"
-  show (LCustom l)   = show l
+  show (LCustom _ l) = show l
   show (LUUID u)     = toString u
 
 -- | A row identifier for some table.
@@ -251,14 +252,14 @@ isInvalidId :: ID a -> Bool
 isInvalidId = isInvalidRowId . untyped
 
 instance SqlType RowID where
-  mkLit (RowID n) = LCustom $ LInt n
+  mkLit (RowID n) = LCustom TRowID (LInt n)
   sqlType _ = TRowID
   fromSql (SqlInt x) = RowID x
   fromSql v          = error $ "fromSql: RowID column with non-int value: " ++ show v
   defaultValue = mkLit invalidRowId
 
 instance Typeable a => SqlType (ID a) where
-  mkLit (ID n) = LCustom $ mkLit n
+  mkLit (ID n) = LCustom TRowID (mkLit n)
   sqlType _ = TRowID
   fromSql = ID . fromSql
   defaultValue = mkLit (ID invalidRowId)
@@ -343,11 +344,11 @@ instance SqlType ByteString where
   defaultValue = LBlob empty
 
 instance SqlType BSL.ByteString where
-  mkLit = LCustom . LBlob . BSL.toStrict
+  mkLit = LCustom TBlob . LBlob . BSL.toStrict
   sqlType _ = TBlob
   fromSql (SqlBlob x) = BSL.fromStrict x
   fromSql v           = error $ "fromSql: blob column with non-blob value: " ++ show v
-  defaultValue = LCustom $ LBlob empty
+  defaultValue = LCustom TBlob (LBlob empty)
 
 -- | @defaultValue@ for UUIDs is the all-zero RFC4122 nil UUID.
 instance SqlType UUID where
diff --git a/selda/src/Database/Selda/Unsafe.hs b/selda/src/Database/Selda/Unsafe.hs
index c2c708ac..bd89fb4e 100644
--- a/selda/src/Database/Selda/Unsafe.hs
+++ b/selda/src/Database/Selda/Unsafe.hs
@@ -2,18 +2,18 @@
 -- | Unsafe operations giving the user unchecked low-level control over
 --   the generated SQL.
 module Database.Selda.Unsafe
-  ( fun, fun2, fun0
+  ( fun, fun2, fun0, operator
   , aggr
-  , cast
-  , castAggr
+  , cast, castAggr, sink, sink2
   , unsafeSelector
   ) where
 import Database.Selda.Column
-import Database.Selda.Inner (Aggr, aggr, liftAggr)
+import Database.Selda.Inner (Inner, Aggr, aggr, liftAggr)
 import Database.Selda.Selectors (unsafeSelector)
 import Database.Selda.SqlType
 import Data.Text (Text)
 import Data.Proxy
+import Unsafe.Coerce
 
 -- | Cast a column to another type, using whichever coercion semantics are used
 --   by the underlying SQL implementation.
@@ -25,16 +25,46 @@ cast = liftC $ Cast (sqlType (Proxy :: Proxy b))
 castAggr :: forall s a b. SqlType b => Aggr s a -> Aggr s b
 castAggr = liftAggr cast
 
+-- | Sink the given function into an inner scope.
+--
+--   Be careful not to use this function with functions capturing rows or columns
+--   from an outer scope. For instance, the following usage will likely
+--   lead to disaster:
+--
+-- > query $ do
+-- >   x <- #age `from` select person
+-- >   inner $ sink (\p -> x + (p ! #age)) <$> select person
+--
+--   Really, if you have to use this function, ONLY do so in the global scope.
+sink :: (f s a -> f s b) -> f (Inner s) a -> f (Inner s) b
+sink = unsafeCoerce
+
+-- | Like 'sink', but with two arguments.
+sink2 :: (f s a -> f s b -> f s c) -> f (Inner s) a -> f (Inner s) b -> f (Inner s) c
+sink2 = unsafeCoerce
+
 -- | A unary operation. Note that the provided function name is spliced
 --   directly into the resulting SQL query. Thus, this function should ONLY
 --   be used to implement well-defined functions that are missing from Selda's
 --   standard library, and NOT in an ad hoc manner during queries.
 fun :: Text -> Col s a -> Col s b
-fun f = liftC $ UnOp (Fun f)
+fun = liftC . UnOp . Fun
 
 -- | Like 'fun', but with two arguments.
 fun2 :: Text -> Col s a -> Col s b -> Col s c
-fun2 f = liftC2 (Fun2 f)
+fun2 = liftC2 . Fun2
+
+-- | A custom operator. @operator "~>" a b@ will compile down to
+--   @a ~> b@, with parentheses around @a@ and @b@ iff they are not atomic.
+--   This means that SQL operator precedence is disregarded, as all
+--   subexpressions are parenthesized. In the following example for instance,
+--   @foo a b c@ will compile down to @(a ~> b) ~> c@.
+--
+-- > (~>) = operator "~>"
+-- > infixl 5 ~>
+-- > foo a b c = a ~> b ~> c
+operator :: Text -> Col s a -> Col s b -> Col s c
+operator = liftC2 . BinOp . CustomOp
 
 -- | Like 'fun', but with zero arguments.
 fun0 :: Text -> Col s a