How to use PostgreSQL with Haskell: hasql
Tags: haskell, functional, database, postgres
Published: 2023-10-03 03:26:26

The next “obvious” step is to add more type-safety.

According to the readme, *[Hasql](https://github.com/nikita-volkov/hasql) “is a highly efficient PostgreSQL driver for Haskell with a typesafe yet flexible mapping API; it is production-ready, actively maintained, and the API is pretty stable. It's used by many companies and most notably by the [Postgrest](https://postgrest.org/) project.“*

Hasql is an [ecosystem](https://github.com/nikita-volkov/hasql#ecosystem) of libraries. To keep it simple, let’s limit ourselves to core `hasql`, [`hasql-transaction`](https://github.com/nikita-volkov/hasql-transaction), and [`hasql-th`](https://github.com/nikita-volkov/hasql-th). We’re using `hasql` `1.6.3.2` published in 2023.

We’ll also use [contravariant-extras](https://hackage.haskell.org/package/contravariant-extras), [vector](https://hackage.haskell.org/package/vector), [profunctors](https://hackage.haskell.org/package/profunctors), and [tuple](https://hackage.haskell.org/package/tuple) packages to make a few things tidier (this isn’t required; it’s all copy-paste anyway).

> 💡 (It’s not very important, but) We assume you’ve seen the part on `postgresql-simple`, which covers the same topics but at a slower pace. 
### How to connect to a database

First, we get a connection:

```haskell
Right connection <- getConnection
```

```haskell
getConnection :: IO (Either ConnectionError Connection)
getConnection =
  acquire $ settings Hardcoded.host Hardcoded.portNumber Hardcoded.user Hardcoded.password Hardcoded.database
```

Note the `Either`. But for now, let’s just pattern-match and not worry about possible errors…

In reality/production, we should probably use [`hasql-pool`](https://hackage.haskell.org/package/hasql-pool) to work with a pool of connections.

### How to modify data

Let’s see the leading players through the clean-up query:

```haskell
cleanUp :: Connection -> IO (Either QueryError ())
cleanUp connection = run cleanUpSession connection
 where
  cleanUpSession :: Session ()
  cleanUpSession = statement () cleanUpStatement

  cleanUpStatement :: Statement () ()
  cleanUpStatement = Statement rawSql E.noParams D.noResult True

  rawSql = "truncate warehouse, product_category, product, category"
```

- `Session` is a batch of actions to be executed in the context of a connection (a query).
- `Statement` is a specification of a strictly single-statement query, which can be parameterized and prepared (how to make a query).
- `Statement` consists of SQL template, params encoder, result decoder, and a flag that determines whether it’s prepared.
- `statement` creates a `Session` from a `Statement` and input parameters.
- `run` executes a bunch of commands (statements) on the provided connection.

> 💡 Remember that you can see the complete code in the [repo](https://github.com/Zelenya/elephants).

We have a simple query with no parameters and no result — we don’t need to encode or decode anything. That’s what `E.noParams D.noResult` for. If we want to pass parameters, we need to supply a decoder.

The first option, is tuples of primitive types and manually written decoders:

```haskell
insertProductSql = "insert into product (label, description) values ($1, $2)"
```

```haskell
insertProduct1 :: Statement (Text, Maybe Text) Int64
insertProduct1 = Statement insertProductSql rawParams D.rowsAffected True

rawParams =
  (fst >$< E.param (E.nonNullable E.text))
    <> (snd >$< E.param (E.nullable E.text))
```

```haskell
statement ("Wood Screw Kit 1", Just "245-pieces") insertProduct1
```

`rawParams` is the encoder for our parameters. We use [`contramap`](https://hackage.haskell.org/package/base-4.18.0.0/docs/Data-Functor-Contravariant.html#v:contramap) operator (`>$<`) and append (`<>`) to compose multiple parameters. `D.rowsAffected` is the decoder for the result when we want to return the number of affected rows.

> 💡 Instead of [`fst`](https://hackage.haskell.org/package/base-4.16.3.0/docs/Data-Tuple.html#v:fst) and [`snd`](https://hackage.haskell.org/package/base-4.16.3.0/docs/Data-Tuple.html#v:snd), you can use the `contrazip` family of functions from the `contravariant-extras` package to reduce boilerplate.

Another option, is using records:

```haskell
insertProduct2 :: Statement BasicProduct Int64
insertProduct2 = Statement insertProductSql basicProductParams D.rowsAffected True

basicProductParams :: E.Params BasicProduct
basicProductParams =
  ((.label) >$< E.param (E.nonNullable E.text))
    <> ((.description) >$< E.param (E.nullable E.text))
```

```haskell
statement (BasicProduct "Wood Screw Kit 2" Nothing) insertProduct2
```

If we want to modify multiple rows, we have to use the postgres `unnest` function:

```haskell
insertManyCategories :: Statement (Vector Category) Int64
insertManyCategories = Statement insertManyCategoriesSql categoryParams D.rowsAffected True

insertManyCategoriesSql = "insert into category (label) select * from unnest ($1)"

categoryParams :: E.Params (Vector Category)
categoryParams =
  E.param
    $ E.nonNullable
    $ E.array
    $ E.dimension List.foldl'
    $ categoryArray

categoryArray :: E.Array Category
categoryArray = (.label) >$< (E.element $ E.nonNullable E.text)
```

`categoryParams` is an encoder that allows us to pass a vector of categories to insert. 

```haskell
let categories = [Category "Screws", Category "Wood Screws", Category "Concrete Screws"]
statement (fromList categories) insertManyCategories
```

> Note that `unnest` is more efficient than executing a single-row insert statement multiple times.

### How to query data

Querying data is similar:

```haskell
session1 :: Session [(Int64, Text, Maybe Text)]
session1 =
  statement ()
    $ Statement
      "select id, label, description from product"
      E.noParams
      decoder1
      True

decoder1 =
  D.rowList
    $ (,,)
    <$> D.column (D.nonNullable D.int8)
    <*> D.column (D.nonNullable D.text)
    <*> D.column (D.nullable D.text)
```

We need to provide a decoder for the result (to specify how each row results maps into the expected type). If this sounds tedious, we can ask Template Haskell to do the work for us:

In this case, we use `singletonStatement` that expects one result. There are other variants that we’ll see later.

```haskell
session2 :: Session (Text, Maybe Text)
session2 = statement () statement2

statement2 :: Statement () (Text, Maybe Text)
statement2 =
  [singletonStatement|
    select label :: text, description :: text? from product limit 1
  |]
```

We write the query and specify the types, `hasql-th` handles the codecs for us.

But we still need to handle the conversions if we use custom types instead of tuples. The result of the statement has a `Profunctor` instance, which allows us to modify (input) parameters and (output) results. In other words, we use `lmap` to map parameters, `rmap` — result, and `dimap` — both. For example, let’s return `BasicProduct`:

```haskell
session3 :: Session (Maybe BasicProduct)
session3 = statement "Wood Screw Kit 2" statement3

statement3 :: Statement Text (Maybe BasicProduct)
statement3 =
  rmap
    (fmap (uncurryN BasicProduct))
    [maybeStatement|
      select label :: text, description :: text?
      from product
      where label = $1 :: text
    |]
```

---

💡 `(fmap (uncurryN BasicProduct))` is a concise way to write the following (using `tuples` package):

```haskell
(\result -> fmap (\(a, b) -> (BasicProduct a b)) result)
```

---

`hasql` doesn’t have "special support" for an array as a parameter for the `IN` operator, we should use [Any](https://hackage.haskell.org/package/hasql-1.6.3.2/docs/Hasql-Statement.html#g:3):

```haskell
session4 :: Session (Vector BasicProduct)
session4 = statement (fromList ["Wood Screw Kit 1", "Wood Screw Kit 2"]) statement4

statement4 :: Statement (Vector Text) (Vector BasicProduct)
statement4 =
  rmap
    (fmap (uncurryN BasicProduct))
    [vectorStatement|
      select label :: text, description :: text?
      from product
      where label = ANY($1 :: text[])
    |]
```

### How to use transactions

We can use `returning` to get `id`s of created rows:

```haskell
insertProduct :: Statement (Text, Maybe Text) Int64
insertProduct =
  [singletonStatement|
    insert into product (label, description) values ($1 :: text, $2 :: text?) returning id :: int8
  |]
```

To wrap multiple queries in a transaction, we can use `hasql-transaction`. First, we compose the statements:

```haskell
insertAll :: FullProduct -> Transaction Int64
insertAll listing = do
  productId <- Transaction.statement (listing.label, listing.description) insertProduct
  categoryId <- Transaction.statement listing.category insertCategory
  _ <- Transaction.statement (productId) insertListing
  ids <- Transaction.statement (productId, categoryId) insertMapping
  pure ids

insertProduct :: Statement (Text, Maybe Text) Int64

insertCategory :: Statement Text Int64

insertListing :: Statement Int64 ()

insertMapping :: Statement (Int64, Int64) Int64
```

Then we run the transaction using the relevant isolation level and mode:

```haskell
insertWithTransaction :: Connection -> IO ()
insertWithTransaction connection = do
  let listing = FullProduct "Drywall Screws Set" (Just "8000pcs") "Drywall Screws"
  mapping <- run (transaction Serializable Write $ insertAll listing) connection
  putStrLn $ "Insert with transaction: " <> show mapping
```

### How to query using joins

We can query these tables using a few joins. There should be nothing unexpected here:

```haskell
listings :: Statement Int32 (Vector Listing)
listings =
  rmap
    (fmap (uncurryN Listing))
    [vectorStatement|
    select
        w.quantity :: int,
        p.label :: text,
        p.description :: text?,
        c.label :: text?
      from warehouse as w
      inner join product as p on w.product_id = p.id
      left outer join product_category as pc on p.id = pc.product_id
      left outer join category as c on c.id = pc.category_id
      where w.quantity > $1 :: int4
  |]
```

### Errors

We’ve been neglecting this until now, but all error reporting is explicit and is presented using `Either`.

---

💡 Just a reminder, **don’t ignore errors**. And don’t pattern match only on `Right`, or you will end up with this:

```haskell
user error (Pattern match failure in 'do' block at ...)
```

---

The other good thing is that the `hasql-th` parser is pretty good at error reporting and catching typos at compile time (and most of the time, it’s more explicit than postgres’ `syntax error at or near`). This won’t compile:

```haskell
[singletonStatement|
    select I have no idea what I'm doing
|]
```

The library doesn’t accept (doesn’t compile) if you forget to specify one of the types. For instance, if we omit type of `label`, we get a somewhat generic error:

```haskell
[singletonStatement|
    select label, description :: text? from product
|]
```

> `Result expression is missing a typecast`
> 

This ensures that most input and result type (including nullability) mismatches are caught in the compile time. For example, if we forget an input type and return a wrong result type:

```haskell
statement :: Statement () (Text, Int32)
statement =
  [singletonStatement|
    select label :: text, description :: text?
--                                       ^^^^^ 
--  Couldn't match type ‘Int32’ with ‘Maybe Text’
    from product where label = $1 :: text
--                                   ^^^^
--  Couldn't match type ‘Text’ with ‘()’
  |]
```

However, we’re not safe from programming errors. We should use correct statement functions not to get a runtime error. For example, if we use `singletonStatement` for statements that might not return a result (instead of `maybeStatement`):

```haskell
do
  failure <- run (statement () failsBecauseNoResults) connection
  putStrLn $ "Wrong statement function: " <> show failure
 where
  failsBecauseNoResults :: Statement () (Text)
  failsBecauseNoResults =
    [singletonStatement|
        select label :: text from product where 1 = 0
    |]
```

> `Wrong statement function: Left (QueryError "SELECT label :: text FROM product WHERE 1 = 0" [] (ResultError (UnexpectedAmountOfRows 0)))`
> 

Or if we use `singletonStatement` with `()` result (instead of `resultlessStatement`):

```haskell
do
  failure <- run (statement () failsBecauseResultless) connection
  putStrLn $ "Wrong statement function: " <> show failure
 where
  failsBecauseResultless :: Statement () ()
  failsBecauseResultless =
    [singletonStatement|
      insert into product (label) values ('this insert fails')
    |]
```

> `Wrong statement function: Left (QueryError "INSERT INTO product (label) VALUES ('this insert fails')" [] (ResultError (UnexpectedResult "Unexpected result status: CommandOk")))`
> 

In case of runtime sql error, for instance, if we violate a constraint, we get a similar error:

```haskell
inserProduct :: Statement Text ()
inserProduct =
  [singletonStatement|
    insert into product (label) values ($1 :: text)
  |]
```

```haskell
run (statement "Duplicate screw" inserProduct) connection
  >> run (statement "Duplicate screw" inserProduct) connection
```

> `Wrong statement function (Left): QueryError "INSERT INTO product (label) VALUES ('Duplicate')" [] (ResultError (ServerError "23505" "duplicate key value violates unique constraint \"product_label_key\"" (Just "Key (label)=(Duplicate screw) already exists.") Nothing Nothing))`
> 

### Resources

Core readme has a good overview and example. The library has simple docs, a couple of tutorials, and talks from the author.

### Migrations

[hasql-migrations](https://github.com/tvh/hasql-migration) tool is a port of `postgresql-simple-migration` for use with `hasql`.

### In summary

Overall, `hasql` is a great choice for writing raw sql queries with more type safety and compile-time syntax checks. The ecosystem comes with other whistles like connection pools and transactions. 

The TemplateHaskell module and compile-time checks are optional — if you want, you can deal with the encoders and decoders yourself.

The library requires basic/intermediate knowledge of Haskell and ecosystems. To be comfortable and productive, you must be familiar with vectors, contravariant functors, etc. Other than that, the library is relatively straightforward.