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.
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+module Main
+
+ ( mainwhere
+ )
+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
+Application io) =
+ runApplication greeting (let
+ =
+ context ApplicationContext
+ = greeting
+ { applicationGreeting
+ }in
+
+ Reader.runReaderT io context
+myApplication :: Application ()
+= do
+ myApplication <- getGreeting
+ greeting . putStrLn $ greeting
+ MIO.liftIO
+main :: IO ()
+=
+ main "Hello Application" myApplication runApplication
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 (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 (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 (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 (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.
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+module Main
+
+ ( mainwhere
+ )
+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)
+
+Application reader) =
+ localOrvilleState f (let
+ mkLocalContext :: ApplicationContext -> ApplicationContext
+=
+ mkLocalContext ctx
+ ctx= f (applicationOrvilleState ctx)
+ { applicationOrvilleState
+ }in
+ Application (Reader.local mkLocalContext reader)
+
+getGreeting :: Application String
+=
+ getGreeting Application (Reader.asks applicationGreeting)
+
+runApplication :: O.ConnectionPool -> String -> Application a -> IO a
+Application io) =
+ runApplication pool greeting (let
+ =
+ orvilleState
+ O.newOrvilleState
+ O.defaultErrorDetailLevel
+ pool
+=
+ context ApplicationContext
+ = greeting
+ { applicationGreeting = orvilleState
+ , applicationOrvilleState
+ }in
+
+ Reader.runReaderT io context
+myApplication :: Application ()
+= do
+ myApplication <- getGreeting
+ greeting . putStrLn $ greeting
+ MIO.liftIO
+main :: IO ()
+= do
+ main <-
+ pool
+ O.createConnectionPoolO.ConnectionOptions
+ = "host=localhost user=postgres password=postgres"
+ { O.connectionString = O.DisableNoticeReporting
+ , O.connectionNoticeReporting = O.OneStripePerCapability
+ , O.connectionPoolStripes = 10
+ , O.connectionPoolLingerTime = O.MaxConnectionsPerStripe 1
+ , O.connectionPoolMaxConnections
+ }
+"Hello Application" myApplication runApplication pool