+

How To Add Orville to an Existing Reader Context

+
+
+

This guide will show you how to add Orville to a monad that is already using +ReaderT in its monad stack. It builds conceptually on top of the previous +guide, which assumed there +was not already a ReaderT in the application monad stack. It’s recommended +that you read that guide before this one.

+

The file listing below shows a simple application with its own Application +monad that already has a reader context. When there is already a reader context +in the application stack it’s generally perferrable to incorporate Orville into +the existing reader context rather than adding a new ReaderT layer atop the +one that’s already there.

+
+Main.hs (Before) : haskell +
+
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+module Main
+  ( main
+  ) where
+
+import qualified Control.Monad.IO.Class as MIO
+import qualified Control.Monad.Reader as Reader
+
+data ApplicationContext =
+  ApplicationContext
+    { applicationGreeting :: String
+    }
+
+newtype Application a =
+  Application (Reader.ReaderT ApplicationContext IO a)
+  deriving
+    ( Functor
+    , Applicative
+    , Monad
+    , MIO.MonadIO
+    )
+
+getGreeting :: Application String
+getGreeting =
+  Application (Reader.asks applicationGreeting)
+
+runApplication :: String -> Application a -> IO a
+runApplication greeting (Application io) =
+  let
+    context =
+      ApplicationContext
+        { applicationGreeting = greeting
+        }
+  in
+    Reader.runReaderT io context
+
+myApplication :: Application ()
+myApplication = do
+  greeting <- getGreeting
+  MIO.liftIO . putStrLn $ greeting
+
+main :: IO ()
+main =
+  runApplication "Hello Application" myApplication
+

As in the last guide, we +will first add an OrvilleState to our application monad. In this case we’ll +add it as a new field to the existing ApplicationContext.

+
+Main.hs : diff +
+
*** Main.hs (Old)
+--- Main.hs (New)
+***************
+*** 7,8 ****
+--- 7,9 ----
+  import qualified Control.Monad.Reader as Reader
++ import qualified Orville.PostgreSQL as O
+  
+***************
+*** 11,12 ****
+--- 12,14 ----
+      { applicationGreeting :: String
++     , applicationOrvilleState :: O.OrvilleState
+      }
+

This requires that the new applicationOrvilleState field be populated in the +runApplication function using a ConnectionPool. The ConnectionPool is +created in the main function and passed in where runApplication is called.

+
+Main.hs : diff +
+
*** Main.hs (Old)
+--- Main.hs (New)
+***************
+*** 28,32 ****
+  
+! runApplication :: String -> Application a -> IO a
+! runApplication greeting (Application io) =
+    let
+      context =
+--- 28,37 ----
+  
+! runApplication :: O.ConnectionPool -> String -> Application a -> IO a
+! runApplication pool greeting (Application io) =
+    let
++     orvilleState =
++       O.newOrvilleState
++         O.defaultErrorDetailLevel
++         pool
++ 
+      context =
+***************
+*** 34,35 ****
+--- 39,41 ----
+          { applicationGreeting = greeting
++         , applicationOrvilleState = orvilleState
+          }
+***************
+*** 44,46 ****
+  main :: IO ()
+! main =
+!   runApplication "Hello Application" myApplication
+--- 50,62 ----
+  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 "Hello Application" myApplication
+

Now we must declare an instance of HasOrvilleState to allow Orville access to +the OrvilleState state that is stored in our custom ApplicationContext +field. The askOrvilleState function is generally quite easy to implement. +It’s the equivalent of the ask function from the Reader module. In this +example we use the asks function from the Reader module to access the +applicationOrvilleState field in the reader context.

+

The localOrvilleState function is the equivalent of the local function from +the Reader module. It’s slightly more complicated to implemented because we +have adapt the function that Orville passes to localOrvilleState (which has type +OrvilleState -> OrvilleState) so that the function is applied within the +ApplicationContext. The adapted function is then passed Reader.local to +complete our implementation of localOrvilleState. We’ve included a type +signature for mkLocalContext in the example so you can clearly see the type +of function being passed to Reader.local, but this is not necessary for the +code to compile.

+
+Main.hs : diff +
+
*** Main.hs (Old)
+--- Main.hs (New)
+***************
+*** 24,25 ****
+--- 24,39 ----
+  
++ instance O.HasOrvilleState Application where
++   askOrvilleState =
++     Application (Reader.asks applicationOrvilleState)
++ 
++   localOrvilleState f (Application reader) =
++     let
++       mkLocalContext :: ApplicationContext -> ApplicationContext
++       mkLocalContext ctx =
++         ctx
++           { applicationOrvilleState = f (applicationOrvilleState ctx)
++           }
++     in
++       Application (Reader.local mkLocalContext reader)
++ 
+  getGreeting :: Application String
+

Once we have defined our instance of HasOrvilleState we can add +MonadOrville and MonadOrvilleControl to the list of derived instances for +Application.

+
+Main.hs : diff +
+
*** Main.hs (Old)
+--- Main.hs (New)
+***************
+*** 22,23 ****
+--- 22,25 ----
+      , MIO.MonadIO
++     , O.MonadOrville
++     , O.MonadOrvilleControl
+      )
+

Now our Application monad is fully equipped with Orville capabilities! The +previous guide showed how +to add a first table and Orville operation as well. That part is exactly the +same from this point, so we won’t include it again here. We’ll conclude this +guide with the final listing of Main.hs with all our changes applied.

+
+Main.hs (After) : haskell +
+
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+module Main
+  ( main
+  ) where
+
+import qualified Control.Monad.IO.Class as MIO
+import qualified Control.Monad.Reader as Reader
+import qualified Orville.PostgreSQL as O
+
+data ApplicationContext =
+  ApplicationContext
+    { applicationGreeting :: String
+    , applicationOrvilleState :: O.OrvilleState
+    }
+
+newtype Application a =
+  Application (Reader.ReaderT ApplicationContext IO a)
+  deriving
+    ( Functor
+    , Applicative
+    , Monad
+    , MIO.MonadIO
+    , O.MonadOrville
+    , O.MonadOrvilleControl
+    )
+
+instance O.HasOrvilleState Application where
+  askOrvilleState =
+    Application (Reader.asks applicationOrvilleState)
+
+  localOrvilleState f (Application reader) =
+    let
+      mkLocalContext :: ApplicationContext -> ApplicationContext
+      mkLocalContext ctx =
+        ctx
+          { applicationOrvilleState = f (applicationOrvilleState ctx)
+          }
+    in
+      Application (Reader.local mkLocalContext reader)
+
+getGreeting :: Application String
+getGreeting =
+  Application (Reader.asks applicationGreeting)
+
+runApplication :: O.ConnectionPool -> String -> Application a -> IO a
+runApplication pool greeting (Application io) =
+  let
+    orvilleState =
+      O.newOrvilleState
+        O.defaultErrorDetailLevel
+        pool
+
+    context =
+      ApplicationContext
+        { applicationGreeting = greeting
+        , applicationOrvilleState = orvilleState
+        }
+  in
+    Reader.runReaderT io context
+
+myApplication :: Application ()
+myApplication = do
+  greeting <- getGreeting
+  MIO.liftIO . putStrLn $ greeting
+
+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 "Hello Application" myApplication
+
+
+ +