How To Add Orville to Your Application Monad

This guide will show you how to add Orville to your already existing application monad in the simplest way possible. It relies on the mtl package in addition to orville-postgresql, so you should make sure these packages are in your package dependencies in either your .cabal or package.yaml file.

The file listing below shows a simple, minimal application with its own Application monad. Your application is certainly more complicated than this, but you can think of the IO type below being whatever base monad or monad transformer stack you already have in place.

Main.hs (Before) : haskell
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Main
  ( main
  ) where

import qualified Control.Monad.IO.Class as MIO

newtype Application a =
  Application (IO a)
  deriving
    ( Functor
    , Applicative
    , Monad
    , MIO.MonadIO
    )

runApplication :: Application a -> IO a
runApplication (Application io) =
  io

myApplication :: Application ()
myApplication =
  MIO.liftIO . putStrLn $ "Hello Application"

main :: IO ()
main =
  runApplication myApplication

We’re going to add a new ReaderT transformer to the innards of the Application newtype to hold Orville’s OrvilleState parameter. We’ll have to import the Control.Monad.Reader module (from the mtl package) and the Orville.PostgreSQL module (from the orville-postgresql) package to reference these types.

Main.hs : diff
*** Main.hs (Old)
--- Main.hs (New)
***************
*** 5,10 ****
  
  import qualified Control.Monad.IO.Class as MIO
  
  newtype Application a =
!   Application (IO a)
    deriving
--- 5,12 ----
  
+ import qualified Control.Monad.Reader as Reader
  import qualified Control.Monad.IO.Class as MIO
+ import qualified Orville.PostgreSQL as O
  
  newtype Application a =
!   Application (Reader.ReaderT O.OrvilleState IO a)
    deriving

This new ReaderT context adds the internal state that Orville needs to do its job. In order to use functions from the Orville package directly in your monad it will need to provide instances for the three typeclasses that make up a complete Orville monad - MonadOrville, MonadOrvilleControl and HasOrvilleState. Luckily, it’s a simple matter of adding these three typeclasses the deriving list for Application. If you’re not using GHC2021 you’ll need the GeneralizedNewtypeDeriving language extension, as in the example in this guide.

Main.hs : diff
*** Main.hs (Old)
--- Main.hs (New)
***************
*** 16,17 ****
--- 16,20 ----
      , MIO.MonadIO
+     , O.MonadOrville
+     , O.MonadOrvilleControl
+     , O.HasOrvilleState
      )

Somewhere in your code you’ll have a function similar to this example’s runApplication function. It needs to be updated to expect a ConnectionPool argument. We’ll use the connection pool to build a fresh new OrvilleState for our Reader context. Then we can use runReaderT resolve the ReaderT layer we added to our stack and get back whatever monad type was there before we added Orville. In this case that’s just the IO type. This means runApplication will return the same type that it returned befored we added Orville, it just requires the ConnectionPool parameter to do its job now.

Main.hs : diff
*** Main.hs (Old)
--- Main.hs (New)
***************
*** 21,25 ****
  
! runApplication :: Application a -> IO a
! runApplication (Application io) =
!   io
  
--- 21,31 ----
  
! runApplication :: O.ConnectionPool -> Application a -> IO a
! runApplication pool (Application reader) =
!   let
!     orvilleState =
!       O.newOrvilleState
!         O.defaultErrorDetailLevel
!         pool
!   in
!     Reader.runReaderT reader orvilleState
  

Since we added a parameter to runApplication, we need to go to each place it’s called and pass a ConnectionPool parameter now. In this guide that’s just a single place in the main function. We’ll use createConnectionPool as normal to make the pool we want to use.

Main.hs : diff
*** Main.hs (Old)
--- Main.hs (New)
***************
*** 36,38 ****
  main :: IO ()
! main =
!   runApplication myApplication
--- 36,48 ----
  main :: IO ()
! main = do
!   pool <-
!     O.createConnectionPool
!         O.ConnectionOptions
!           { O.connectionString = "host=localhost user=postgres password=postgres"
!           , O.connectionNoticeReporting = O.DisableNoticeReporting
!           , O.connectionPoolStripes = O.OneStripePerCapability
!           , O.connectionPoolLingerTime = 10
!           , O.connectionPoolMaxConnections = O.MaxConnectionsPerStripe 1
!           }
! 
!   runApplication pool myApplication

Our Application monad is now fully equipped to run Orville operations! To show it works, let’s add a messages table and update the myApplication logic to insert and retrieve a simple greeting message.

Main.hs : diff
*** Main.hs (Old)
--- Main.hs (New)
***************
*** 7,8 ****
--- 7,9 ----
  import qualified Control.Monad.IO.Class as MIO
+ import qualified Data.Text as T
  import qualified Orville.PostgreSQL as O
***************
*** 31,35 ****
  
  myApplication :: Application ()
! myApplication =
!   MIO.liftIO . putStrLn $ "Hello Application"
  
--- 32,44 ----
  
+ messagesTable :: O.TableDefinition O.NoKey T.Text T.Text
+ messagesTable =
+   O.mkTableDefinitionWithoutKey
+     "messages"
+     (O.marshallField id (O.unboundedTextField "message"))
+ 
  myApplication :: Application ()
! myApplication = do
!   O.insertEntity messagesTable (T.pack "Hello Orville")
!   messages <- O.findEntitiesBy messagesTable mempty
!   MIO.liftIO . print $ messages
  

Finally, we’ll equip our application with automatic migrations using Orville’s Orville.PostgreSQL.Automigration module so that the messages table will be created before we try to access it.

Main.hs : diff
*** Main.hs (Old)
--- Main.hs (New)
***************
*** 9,10 ****
--- 9,11 ----
  import qualified Orville.PostgreSQL as O
+ import qualified Orville.PostgreSQL.AutoMigration as AutoMigration
  
***************
*** 44,45 ****
--- 45,51 ----
  
+ schema :: [AutoMigration.SchemaItem]
+ schema =
+   [ AutoMigration.SchemaTable messagesTable
+   ]
+ 
  main :: IO ()
***************
*** 56,57 ****
--- 62,64 ----
  
+   runApplication pool (AutoMigration.autoMigrateSchema AutoMigration.defaultOptions schema)
    runApplication pool myApplication

That’s it! That completes this guide about how to add Orville to your existing application monad. To wrap things up, here’s the final listing of Main.hs with all the changes we made.

Main.hs (After) : haskell
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Main
  ( main
  ) where

import qualified Control.Monad.Reader as Reader
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Text as T
import qualified Orville.PostgreSQL as O
import qualified Orville.PostgreSQL.AutoMigration as AutoMigration

newtype Application a =
  Application (Reader.ReaderT O.OrvilleState IO a)
  deriving
    ( Functor
    , Applicative
    , Monad
    , MIO.MonadIO
    , O.MonadOrville
    , O.MonadOrvilleControl
    , O.HasOrvilleState
    )

runApplication :: O.ConnectionPool -> Application a -> IO a
runApplication pool (Application reader) =
  let
    orvilleState =
      O.newOrvilleState
        O.defaultErrorDetailLevel
        pool
  in
    Reader.runReaderT reader orvilleState

messagesTable :: O.TableDefinition O.NoKey T.Text T.Text
messagesTable =
  O.mkTableDefinitionWithoutKey
    "messages"
    (O.marshallField id (O.unboundedTextField "message"))

myApplication :: Application ()
myApplication = do
  O.insertEntity messagesTable (T.pack "Hello Orville")
  messages <- O.findEntitiesBy messagesTable mempty
  MIO.liftIO . print $ messages

schema :: [AutoMigration.SchemaItem]
schema =
  [ AutoMigration.SchemaTable messagesTable
  ]

main :: IO ()
main = do
  pool <-
    O.createConnectionPool
        O.ConnectionOptions
          { O.connectionString = "host=localhost user=postgres password=postgres"
          , O.connectionNoticeReporting = O.DisableNoticeReporting
          , O.connectionPoolStripes = O.OneStripePerCapability
          , O.connectionPoolLingerTime = 10
          , O.connectionPoolMaxConnections = O.MaxConnectionsPerStripe 1
          }

  runApplication pool (AutoMigration.autoMigrateSchema AutoMigration.defaultOptions schema)
  runApplication pool myApplication