DEV Community

Zelenya
Zelenya

Posted on

How to use PostgreSQL with Haskell: beam

#haskell #functional #database #postgres

Tired of sql and Template Haskell?

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 (0.10.1.0 released in 2023) and 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:

connectionInfo :: ConnectInfo
connectionInfo =
  defaultConnectInfo
    { connectHost = Hardcoded.host
    , connectDatabase = Hardcoded.database
    , connectUser = Hardcoded.user
    , connectPassword = Hardcoded.password
    }
Enter fullscreen mode Exit fullscreen mode 
Simple.withConnect connectionInfo $ \connection -> do
    doFoo connection
    doBar connection
Enter fullscreen mode Exit fullscreen mode

How to define tables

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

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)
Enter fullscreen mode Exit fullscreen mode

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.

All the other tables look quite similar; see the repo 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):

data ProductCategoryT f = ProductCategory
  { product_id :: PrimaryKey ProductT f
  , category_id :: PrimaryKey CategoryT f
  }
  deriving (Generic)
  deriving anyclass (Beamable)
Enter fullscreen mode Exit fullscreen mode

After declaring all the tables, we describe our database:

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")
              }
      }
Enter fullscreen mode Exit fullscreen mode

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 for more information.

How to modify data

For raw queries, we can use postgresql-simple:

cleanUp :: Connection -> IO ()
cleanUp connection =
  void $ Simple.execute_ connection "truncate warehouse, product_category, product, category"
Enter fullscreen mode Exit fullscreen mode

Let’s insert some products:

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
      ]
Enter fullscreen mode Exit fullscreen mode

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), 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:

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
Enter fullscreen mode Exit fullscreen mode

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:

query1 :: (MonadBeam Postgres m) => m [Product]
query1 = do
  let allProducts = all_ (warehouseDb.product)
  runSelectReturningList $ select allProducts
Enter fullscreen mode Exit fullscreen mode 
runBeamPostgres connection query
Enter fullscreen mode Exit fullscreen mode

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:

query2 label = runSelectReturningList $ select $ do
  aProduct <- all_ warehouseDb.product
  guard_ (aProduct.label ==. val_ label)
  pure (aProduct.label, aProduct.description)
Enter fullscreen mode Exit fullscreen mode

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

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

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

How to use transactions

We use postgresql-simple for transactions:

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"
Enter fullscreen mode Exit fullscreen mode

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:

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)
Enter fullscreen mode Exit fullscreen mode

Which generates the following query:

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)
Enter fullscreen mode Exit fullscreen mode

We can also use the manyToMany_ construct to fetch sides of a many-to-many relationship.

productCategoryRelationship :: ManyToMany Postgres WarehouseDb ProductT CategoryT
productCategoryRelationship =
  manyToMany_ (warehouseDb.product_category) (.product_id) (.category_id)
Enter fullscreen mode Exit fullscreen mode 
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)
Enter fullscreen mode Exit fullscreen mode

Which generates the following query:

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)
Enter fullscreen mode Exit fullscreen mode

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:

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))
Enter fullscreen mode Exit fullscreen mode

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

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_]
Enter fullscreen mode Exit fullscreen mode

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:

 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))
Enter fullscreen mode Exit fullscreen mode

Top comments (0)

Read next

spronin profile image

Running Gitea with PostgreSQL on Kubernetes

Sergey Pronin -

franckpachot profile image

Write Buffering to Reduce Raft Consensus Latency in YugabyteDB

Franck Pachot -

ajadi473 profile image

Understanding Database Normalization: A Practical Guide with E-Commerce Examples

Paul AJadi -

iamadhee profile image

🗃️ Lessons Learned from Migrating Huge BigQuery Datasets Across Regions

Adheeban Manoharan -