How to use PostgreSQL with Haskell: beam
Tags: haskell, functional, database, postgres
Published: 2023-10-03 03:28:57

*Tired of sql and Template Haskell?*

[Beam](https://haskell-beam.github.io/beam/) “*is a highly-general library for accessing any kind of database with Haskell”.* Beam makes extensive use of GHC's Generics mechanism — no Template Haskell.

First, install [`beam-core`](https://hackage.haskell.org/package/beam-core) (`0.10.1.0` released in 2023) and [`beam-postgres`](https://hackage.haskell.org/package/beam-postgres)(`0.5.3.1`). 

A few additional extensions: `GADTs` and `TypeFamilies`.

`beam-postgres` is built on top of `postgresql-simple`, which is used for connection management, transaction support, serialization, and deserialization.

> 💡 We assume that you’ve seen the part on `postgresql-simple`.
> 
### How to connect to a database

We use `postgresql-simple` straight away. Reminder:

```haskell
connectionInfo :: ConnectInfo
connectionInfo =
  defaultConnectInfo
    { connectHost = Hardcoded.host
    , connectDatabase = Hardcoded.database
    , connectUser = Hardcoded.user
    , connectPassword = Hardcoded.password
    }
```

```haskell
Simple.withConnect connectionInfo $ \connection -> do
    doFoo connection
    doBar connection
```

### How to define tables

Let’s look at the definition of the **product** table:

```haskell
data ProductT f = Product
  { id :: Columnar f Int64
  , label :: Columnar f Text
  , description :: Columnar f (Maybe Text)
  }
  deriving (Generic)
  deriving anyclass (Beamable)

type Product = ProductT Identity
deriving instance Show Product

instance Table ProductT where
  data PrimaryKey ProductT f = ProductId (Columnar f Int64)
    deriving (Generic)
    deriving anyclass (Beamable)
  primaryKey = ProductId . (.id)
```

`ProductT` is a beam table. All beam tables must implement the `Beamable` typeclass (derived via generics) and the `Table` typeclass. The `Table` instance declares the type of primary keys for the table and a function that extracts them. We can use `Product` to construct values of type `Product`.

> 💡 For details, see [beam tutorial](https://haskell-beam.github.io/beam/tutorials/tutorial1/).

All the other tables look quite similar; see the [repo](https://github.com/Zelenya/elephants) for the rest of the boilerplate. One interesting bit is foreign keys / referencing other primary keys; for example, `product_id` and `category_id` in the mapping table look like are defined as `PrimaryKey ProductT f` (not `Columnar f Int64`):

```haskell
data ProductCategoryT f = ProductCategory
  { product_id :: PrimaryKey ProductT f
  , category_id :: PrimaryKey CategoryT f
  }
  deriving (Generic)
  deriving anyclass (Beamable)
```

After declaring all the tables, we describe our database:

```haskell
data WarehouseDb f = WarehouseDb
  { product :: f (TableEntity ProductT)
  , category :: f (TableEntity CategoryT)
  , product_category :: f (TableEntity ProductCategoryT)
  , warehouse :: f (TableEntity WarehouseT)
  }
  deriving (Generic)
  deriving anyclass (Database Postgres)

warehouseDb :: DatabaseSettings Postgres WarehouseDb
warehouseDb =
  defaultDbSettings
    `withDbModification` dbModification
      { product_category =
          modifyTableFields
            tableModification
              { category_id = CategoryId (fieldNamed "category_id")
              , product_id = ProductId (fieldNamed "product_id")
              }
      , warehouse =
          modifyTableFields @WarehouseT
            tableModification
              { product_id = ProductId (fieldNamed "product_id")
              }
      }
```

`WarehouseDb` needs to define all the tables and an instance of `Database _`.

> 💡 Note that you don’t need to hardcode `Postgres` and can keep the database more generic.

If you don’t have an existing database, you might get away with only `defaultDbSettings` as `DatabaseSettings`. Beam can guess a lot about the tables if we follow their conventions. But we need to override a few generated table fields in our case.

Remember that we have a couple of foreign keys? Beam adds a suffix `__id` to these, meaning if we have a record field `product_id`, generated queries will try to use the column `product_id__id`. So, we must override these in the *product_category** mapping and **warehouse** tables.

> 💡 See [beam defaults](https://haskell-beam.github.io/beam/user-guide/models/#defaults) for more information.

### How to modify data

For raw queries, we can use `postgresql-simple`:

```haskell
cleanUp :: Connection -> IO ()
cleanUp connection =
  void $ Simple.execute_ connection "truncate warehouse, product_category, product, category"
```

Let’s insert some products:

```haskell
insert1 :: Connection -> IO ()
insert1 connection =
  runBeamPostgres connection
    $ runInsert
    $ insert (warehouseDb.product)
    $ insertValues
      [ Product 1 "Wood Screw Kit 1" (Just "245-pieces")
      , Product 2 "Wood Screw Kit 2" Nothing
      ]
```

We construct the statement using `insert`, which accepts a table and values. We use `insertValues` to supply concrete values (including ids). `runInsert` runs the statement (in [`MonadBeam`](https://hackage.haskell.org/package/beam-core-0.10.1.0/docs/Database-Beam-Backend-SQL.html#t:MonadBeam)), which `runBeamPostgres` executes using the given connection.

> 💡 Note that we can use `runBeamPostgresDebug putStrLn` instead of `runBeamPostgres` to see what sql queries get executed.

`runInsert` doesn’t return anything (no affected rows, no ids, nothing). When we want some confirmation back, we can use [`runInsertReturningList`](https://hackage.haskell.org/package/beam-core-0.10.1.0/docs/Database-Beam-Backend-SQL-BeamExtensions.html#v:runInsertReturningList):

```haskell
insert2 :: Connection -> IO ()
insert2 connection = do
  result :: [Category] <-
    runBeamPostgres connection
      $ runInsertReturningList
      $ insert (warehouseDb.category)
      $ insertExpressions
        [ Category default_ "Screws"
        , Category default_ "Wood Screws"
        , Category default_ "Concrete Screws"
        ]

  putStrLn $ "Inserted categories: " <> show result
```

We can use `insertExpressions` function to insert arbitrary sql expressions. In this case, we pass `default_` to ask the database to give us default ids.

### How to query data

Instead of talking about `Q` monads and `MonadBeam`, let’s look at the examples. First, query all the products:

```haskell
query1 :: (MonadBeam Postgres m) => m [Product]
query1 = do
  let allProducts = all_ (warehouseDb.product)
  runSelectReturningList $ select allProducts
```

```haskell
runBeamPostgres connection query
```

Important bits: 

- build a query;
- pass it into `select`;
- run it in `MonadBeam` (using `runSelectReturningList`, `runSelectReturningOne`, etc);
- execute using `runBeamPostgres connection`.

For example, to build a query, we can use `all_` to introduce all entries of a table together with `guard_` to filter the results:

```haskell
query2 label = runSelectReturningList $ select $ do
  aProduct <- all_ warehouseDb.product
  guard_ (aProduct.label ==. val_ label)
  pure (aProduct.label, aProduct.description)
```

`filter_` is built on top of `guard_` and allows us to use the `in_` clause:

```haskell
query3 labels =
  runSelectReturningList
    $ select
    $ filter_ (\p -> p.label `in_` predicate)
    $ all_ warehouseDb.product
 where
  predicate = val_ <$> labels
```

Note that we use `val_` to “lift” haskell values into “sql query land”.

### How to use transactions

We use `postgresql-simple` for transactions:

```haskell
insertWithTransaction :: Connection -> IO ()
insertWithTransaction connection = Simple.withTransaction connection $ do
  [newProduct] :: [Product] <-
    runBeamPostgres connection
      $ runInsertReturningList
      $ insert (warehouseDb.product)
      $ insertExpressions [Product default_ "Drywall Screws Set" (just_ "8000pcs")]

  [newCategory] <-
    runBeamPostgres connection
      $ runInsertReturningList
      $ insert (warehouseDb.category)
      $ insertExpressions [Category default_ "Drywall Screws"]

  runBeamPostgresDebug putStrLn connection
    $ runInsert
    $ insert (warehouseDb.product_category)
    $ insertValues [ProductCategory (pk newProduct) (pk newCategory)]

  runBeamPostgres connection
    $ runInsert
    $ insert (warehouseDb.warehouse)
    $ insertExpressions [Warehouse default_ (val_ (pk newProduct)) 10 currentTimestamp_ currentTimestamp_]

  putStrLn $ "Insert with transaction"
```

We use `currentTimestamp_` to ask the database for the current time and `pk` to get the entity's primary key. For example, we pass `pk newProduct` into the `ProductCategory` mapping. 

### How to query using joins

There are various ways to get data from multiple tables using Beam.

For example, we can use `related_` to get all entries of the given table referenced by the given primary key and `leftJoin_` to introduce a table using a left join:

```haskell
query1 quantity = runBeamPostgres connection
  $ runSelectReturningList
  $ select
  $ do
    warehouse <- all_ warehouseDb.warehouse
    aProduct <- related_ warehouseDb.product warehouse.product_id
    mapping <-
      leftJoin_
        (all_ warehouseDb.product_category)
        (\pc -> pc.product_id ==. primaryKey aProduct)
    category <-
      leftJoin_
        (all_ warehouseDb.category)
        (\c -> just_ (primaryKey c) ==. mapping.category_id)
    guard_ (warehouse.quantity >. quantity)
    pure (warehouse.quantity, aProduct.label, aProduct.description, category.label)
```

Which generates the following query:

```haskell
SELECT 
  "t0"."quantity" AS "res0", 
  "t1"."label" AS "res1", 
  "t1"."description" AS "res2", 
  "t3"."label" AS "res3" 
FROM 
  "warehouse" AS "t0" 
  INNER JOIN "product" AS "t1" ON ("t0"."product_id") = ("t1"."id") 
  LEFT JOIN "product_category" AS "t2" ON ("t2"."product_id") = ("t1"."id") 
  LEFT JOIN "category" AS "t3" ON ("t3"."id") IS NOT DISTINCT 
FROM 
  ("t2"."category_id") 
WHERE 
  ("t0"."quantity") > (3)
```

We can also use the [`manyToMany_`](https://haskell-beam.github.io/beam/user-guide/queries/relationships/#many-to-many) construct to fetch sides of a many-to-many relationship.  

```haskell
productCategoryRelationship :: ManyToMany Postgres WarehouseDb ProductT CategoryT
productCategoryRelationship =
  manyToMany_ (warehouseDb.product_category) (.product_id) (.category_id)
```

```haskell
query2 quantity = runBeamPostgres connection
  $ runSelectReturningList
  $ select
  $ do
    warehouse <- all_ warehouseDb.warehouse
    products <- related_ warehouseDb.product warehouse.product_id
    categories <- all_ warehouseDb.category
    (aProduct, category) <- productCategoryRelationship (pure products) (pure categories)
    guard_ (warehouse.quantity >. quantity)
    pure (warehouse.quantity, aProduct.label, aProduct.description, category.label)
```

Which generates the following query:

```haskell
SELECT 
  "t0"."quantity" AS "res0", 
  "t1"."label" AS "res1", 
  "t1"."description" AS "res2", 
  "t2"."label" AS "res3" 
FROM 
  "warehouse" AS "t0" 
  INNER JOIN "product" AS "t1" ON ("t0"."product_id") = ("t1"."id") 
  CROSS JOIN "category" AS "t2" 
  INNER JOIN "product_category" AS "t3" ON (
    ("t3"."product_id") = ("t1"."id")
  ) 
  AND (
    ("t3"."category_id") = ("t2"."id")
  ) 
WHERE 
  ("t0"."quantity") > (3)
```

### Errors

It’s not possible to write an invalid sql query, but this comes at a cost — compile-time errors.

For example, once we forgot to pass a parameter, and this resulted in:

```haskell
Couldn't match expected type: Q Postgres
                                    WarehouseDb
                                    QBaseScope
                                    a0
                with actual type: Q Postgres
                                    WarehouseDb
                                    s0
                                    (ProductT (QExpr Postgres s0))
                                  -> Q Postgres WarehouseDb s0 (CategoryT (QExpr Postgres s0))
                                  -> Q Postgres
                                       WarehouseDb
                                       s0
                                       (ProductT (QExpr Postgres s0),
                                       CategoryT (QExpr Postgres s0))
```

Runtime sql errors are still there, re-exported from `postgresql-simple`. Review the relevant error section if you need a reminder.

```haskell
errors :: Connection -> IO ()
errors connection = do
  insertDuplicateScrew
  insertDuplicateScrew
    `catch` (\err@SqlError{} -> putStrLn $ "Caught SQL Error: " <> displayException err)
 where
  insertDuplicateScrew =
    runBeamPostgres connection
      $ runInsert
      $ insert (warehouseDb.product)
      $ insertExpressions [Product default_ "Duplicate screw" nothing_]
```

> `Caught SQL Error: SqlError {sqlState = "23505", sqlExecStatus = FatalError, sqlErrorMsg = "duplicate key value violates unique constraint \"product_label_key\"", sqlErrorDetail = "Key (label)=(Duplicate screw) already exists.", sqlErrorHint = ""}`
> 

### Resources

Beam has you covered — it comes with an overview, quick-start guide, tutorial, user guide, and hackage docs. 

*Spoiler alert: Beam is likely the best-documented library reviewed in this tutorial.*

### Migrations

The `beam-migrate` package provides a migrations framework. 

> *“The `beam-migrate` tool can generate a beam schema from a pre-existing database, manage migrations for several production databases, automatically generate migrations between two schemas, and much more.”*
> 

### In summary

`beam` states that if the query compiles, it will generate proper code. Beam uses the GHC Haskell type system and nothing else — no Template Haskell. You don’t have to write raw sql or sql like code. After defining some boilerplate, you write and compose queries in a straightforward Haskell style and get valid SQL.

Regarding complexity, let the types do the talking:

```haskell
 manyToMany_
  :: ( Database be db, Table joinThrough
     , Table left, Table right
     , Sql92SelectSanityCheck syntax
     , IsSql92SelectSyntax syntax
     , SqlEq (QExpr (Sql92SelectExpressionSyntax syntax) s) (PrimaryKey left (QExpr (Sql92SelectExpressionSyntax syntax) s))
     , SqlEq (QExpr (Sql92SelectExpressionSyntax syntax) s) (PrimaryKey right (QExpr (Sql92SelectExpressionSyntax syntax) s)) )
  => DatabaseEntity be db (TableEntity joinThrough)
  -> (joinThrough (QExpr (Sql92SelectExpressionSyntax syntax) s) -> PrimaryKey left (QExpr (Sql92SelectExpressionSyntax syntax) s))
  -> (joinThrough (QExpr (Sql92SelectExpressionSyntax syntax) s) -> PrimaryKey right (QExpr (Sql92SelectExpressionSyntax syntax) s))
  -> Q syntax db s (left (QExpr (Sql92SelectExpressionSyntax syntax) s)) -> Q syntax db s (right (QExpr (Sql92SelectExpressionSyntax syntax) s))
  -> Q syntax db s (left (QExpr (Sql92SelectExpressionSyntax syntax) s), right (QExpr (Sql92SelectExpressionSyntax syntax) s))
```