I want to create a Happstack application with lots of access to a database. I think that a Monad Stack with IO at the bottom and a Database Write-like monad on top (with log writer in the middle) will work to have a clear functions in each access, example:
itemsRequest :: ServerConfig -> ServerPart Response
itemsRequest cf = dir "items" $ do
methodM [GET,HEAD]
liftIO $ noticeM (scLogger cf) "sended job list"
items <- runDBMonad (scDBConnString cf) $ getItemLists
case items of
(Right xs) -> ok $ toResponse $ show xs
(Left err) -> internalServerError $ toResponse $ show err
With:
getItemList :: MyDBMonad (Error [Item])
getItemList = do
-- etc...
But I have little knowledge of Monad and Monad Transformers (I see this question as an exercise to learn about it), and I have no idea how to begin the creation of Database Monad, how to lift the IO from happstack to the Database Stack,...etc.
Here is some minimal working code compiled from snippets above for confused newbies like me.
You put stuff into AppConfig type and grab it with ask inside your response makers.
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Happstack.Server
import Control.Monad.Reader
import qualified Data.ByteString.Char8 as C
myApp :: AppMonad Response
myApp = do
-- access app config. look mom, no lift!
test <- ask
-- try some happstack funs. no lift either.
rq <- askRq
bs <- lookBS "lol"
-- test IO please ignore
liftIO . print $ test
liftIO . print $ rq
liftIO . print $ bs
-- bye
ok $ toResponse ("Oh, hi!" :: C.ByteString)
-- Put your stuff here.
data AppConfig = AppConfig { appSpam :: C.ByteString
, appEggs :: [C.ByteString] } deriving (Eq, Show)
config = AppConfig "THIS. IS. SPAAAAAM!!1" []
type AppMonad = ReaderT AppConfig (ServerPartT IO)
main = simpleHTTP (nullConf {port=8001}) $ runReaderT myApp config {appEggs=["red", "gold", "green"]}
You likely want to use 'ReaderT':
type MyMonad a = ReaderT DbHandle ServerPart a
The Reader monad transformer makes a single value accessible using the ask function - in this case, the value we want everyone to get at is the database connection.
Here, DbHandle is some connection to your database.
Because 'ReaderT' is already an instance of all of the happstack-server type-classes all normal happstack-server functions will work in this monad.
You probably also want some sort of helper to open and close the database connection:
runMyMonad :: String -> MyMonad a -> ServerPart a
runMyMonad connectionString m = do
db <- liftIO $ connect_to_your_db connectionString
result <- runReaderT m db
liftIO $ close_your_db_connection db
(It might be better to use a function like 'bracket' here, but I don't know that there is such an operation for the ServerPart monad)
I don't know how you want to do logging - how do you plan to interact with your log-file? Something like:
type MyMonad a = ReaderT (DbHandle, LogHandle) ServerPart a
and then:
askDb :: MyMonad DbHandle
askDb = fst <$> ask
askLogger :: MyMonad LogHandle
askLogger = snd <$> ask
might be enough. You could then build on those primitives to make higher-level functions. You would also need to change runMyMonad to be passed in a LogHandle, whatever that is.
Once you get more than two things you want access to it pays to have a proper record type instead of a tuple.
Related
The following code tries to combine two examples that work separately:
day 19 of 24 (2012) and e.g. ws example but I took almost everything websocket related away to get a small example.
Please, find the code below. The msgHandler is called by helloDb, which will get the the snaplet containing the db-connection and pass it to the msgHandler. The snaplet-posgresql-simple docs (at the end) give convenience instances and an example how to use one of them in the Initializer monad.
When I take the two commented lines away, ghc say that there are two instances involving out-of-scope types and that instances do overlapp: HasPostgres (ReaderT r m) and HasPostgres (ReaderT (Snaplet Postgres) m).
So the question is, how to get the program to compile so that I could pass db-connection from the snaplet to the websocket-part.
My goal is to make the websocket listen for messages, query db, and send messages pack. Other things that I already tried:
aFun :: (MonadIO m, HasPostgres m) => ... m (..) having both db-queries and websocket-things (both liftIO'd) compiles until WS.runWebSocketsSnap calls directly or indirectly aFun.
Tried to tell msgHandler :: (MonadIO m, HasPostgres m) but then ghc says that there is no instance for HasPosgres IO. My feeling is that this should be doable without IO-instance. Or is it?
The code below is trying to use snaplet in non-snaplet context but I'm not sure if this is the correct way.
Is there a better approach to combining websockets and (db-) snaplets in snapframework? After trying several approaches I'm in serious mental lock state obviously needing help. Any help (even small hints about what kind of things I should start learning/refreshing), will be highly appreciated!
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Data.Maybe
import Data.Monoid ((<>))
import Control.Lens
import Control.Monad.Trans
import Control.Monad.Reader
import Snap.Snaplet
import Snap.Snaplet.PostgresqlSimple
import Snap.Http.Server
import Snap.Core as SC
import Data.ByteString as BS
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Network.WebSockets as WS
import qualified Network.WebSockets.Snap as WS
newtype App = App { _db :: Snaplet Postgres }
makeLenses ''App
msgHandler :: (MonadIO m) => App -> BS.ByteString -> WS.PendingConnection -> m ()
msgHandler appSt mUId pending = do
conn <- liftIO $ WS.acceptRequest pending
-- res <- liftIO $ runReaderT (query "SELECT name FROM users WHERE id = ?" (Only mUId)) dbSnaplet
-- liftIO $ print (res :: [Name])
liftIO $ T.putStrLn "msgHandler ended"
where dbSnaplet = view db appSt
initApp :: SnapletInit App App
initApp = makeSnaplet "myapp" "My application" Nothing $
App <$> nestSnaplet "db" db pgsInit
<* addRoutes [("/hello/:id", helloDb)]
newtype Name = Name { _nm :: Text } deriving (Show, Eq)
instance FromRow Name where fromRow = Name <$> field
helloDb :: Handler App App ()
helloDb = do
Just mUId <- getParam "id"
userName <- with db $ listToMaybe <$> query "SELECT name FROM users WHERE id = ?" (Only mUId)
writeText $ maybe "User not found" (\h -> "Hello, " <> (T.pack . show) h) (userName :: Maybe Name)
sStApp <- getSnapletState
WS.runWebSocketsSnap $ msgHandler (view snapletValue sStApp) mUId
main :: IO ()
main = serveSnaplet defaultConfig initApp
The overlapping instance issue you ran into is a bug in the snaplet-postgresql-simple library that has been fixed but the fix has not yet been released. You might want to ask the maintainer about this.
In the meantime you can either pull the latest version of the library from Github, or redefine a type different but isomorphic to ReaderT (Snaplet Postgres), copying the HasPostgres instance.
I'm learning Servant and write a simple service. Here's source code:
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE RankNTypes #-}
module BigMama where
import Control.Concurrent
import Control.Concurrent.STM
import Control.Monad
import Control.Monad.Reader
import Data.Aeson
import Data.Aeson.Types
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Char
import qualified Data.Map as M
import Debug.Trace
import GHC.Generics
import Prelude hiding (id)
import Servant
data MicroService = MicroService
{ name :: String
, port :: Int
, id :: Maybe String
} deriving (Generic)
instance ToJSON MicroService
instance FromJSON MicroService
instance Show MicroService where
show = C.unpack . encode
type ServiceSet = STM (TVar (M.Map String MicroService))
type LocalHandler = ReaderT ServiceSet IO
defaultServices :: ServiceSet
defaultServices = newTVar $ M.fromList []
type Api =
"bigmama" :> Get '[JSON] (Maybe MicroService)
:<|> "bigmama" :> ReqBody '[JSON] MicroService :> Post '[JSON] MicroService
api :: Proxy Api
api = Proxy
serverT :: ServerT Api LocalHandler
serverT = getService
:<|> registerService
getService :: LocalHandler (Maybe MicroService)
getService = do
stm <- ask
liftIO . atomically $ do
tvar <- stm
mss <- readTVar tvar
return $ M.lookup "file" mss
registerService :: MicroService -> LocalHandler MicroService
registerService ms = do
stm <- ask
liftIO . atomically $ do
tvar <- stm
mss <- readTVar tvar
let mss' = M.insert (name ms) ms mss
writeTVar tvar mss'
return ms
readerToHandler' :: forall a. ServiceSet -> LocalHandler a -> Handler a
readerToHandler' ss r = liftIO $ runReaderT r ss
readerToHandler :: ServiceSet -> (:~>) LocalHandler Handler
readerToHandler ss = Nat (readerToHandler' ss)
server :: Server Api
server = enter (readerToHandler defaultServices) serverT
It seems like servant providing a new defaultServices for every request. I send POST to create service (name = "file") and can't get the service back on GET request. How to share data among requests on servant?
It seems like servant providing a new defaultServices for every request.
It is, because your code as written is an STM action to do so. Following the logic—
defaultServices :: ServiceSet
defaultServices = newTVar ...
This (fragmentary) definition crucially does not run the STM action to produce a new TVar. Instead it defines a value (defaultServices) which is an STM action which can produce TVars. Following where defaultServices gets passed to, you use it in your handlers like—
getService = do
stm <- ask
liftIO . atomically $ do
tvar <- stm
...
The action stored in your Reader is unchanged from the defaultServices value itself, so this code is equivalent to—
getService = do
liftIO . atomically $ do
tvar <- defaultServices
...
And by substituting in the definition of defaultServices—
getService = do
liftIO . atomically $ do
tvar <- newTVar ...
...
This now looks obviously wrong. Instead of defaultServices being an action to produce a new TVar, it should be that TVar itself, right? So on the type level without aliases—
type ServiceSet = STM (TVar (M.Map String MicroService)) -- From this
type Services = TVar (M.Map String MicroService) -- To this
defaultServices :: Services
Now defaultServices represents an actual TVar, instead of a method of creating TVars. Writing this may seem tricky if it's your first time because you somehow have to run an STM action, but atomically just turns that into an IO action, and you probably “know” that there is no way to escape IO. This actually is incredibly common though, and a quick look at the actual stm documentation for the functions in play will point you right to the answer.
It turns out that this is one of those exciting times in your life as a Haskell developer that you get to use unsafePerformIO. The definition of atomically spells out pretty much exactly what you have to do.
Perform a series of STM actions atomically.
You cannot use atomically inside an unsafePerformIO or
unsafeInterleaveIO. Any attempt to do so will result in a runtime
error. (Reason: allowing this would effectively allow a transaction
inside a transaction, depending on exactly when the thunk is
evaluated.)
However, see newTVarIO, which can be called inside unsafePerformIO,
and which allows top-level TVars to be allocated.
Now there's one final piece of this puzzle that isn't in the documentation, which is that unless you tell GHC not to inline your top-level value produced using unsafePerformIO, you might still end up with sites where you use defaultServices having their own unique set of services. E.g., without forbidding inlining this would happen—
getService = do
liftIO . atomically $ do
mss <- readTVar defaultServices
getService = do
liftIO . atomically $ do
mss <- readTVar (unsafePerformIO $ newTVarIO ...)
...
This is a simple fix though, just add a NOINLINE pragma to your definition of defaultServices.
defaultServices :: Services
defaultServices = unsafePerformIO $ newTVar M.empty
{-# NOINLINE defaultServices #-}
Now this is a fine solution, and I've happily used it in production code, but there are some objections to it. Since you're already fine with using a ReaderT in your handler monad stack (and the above solution is mostly for people who for some reason are avoiding threading a reference around), you could just create a new TVar at program initialization and then pass that in. The briefest sketch of how that would work is below.
main :: IO ()
main = do
services <- atomically (newTVar M.empty)
run 8080 $ serve Proxy (server services)
server :: TVar Services -> Server Api
server services = enter (readerToHandler services) serverT
getService :: LocalHandler (Maybe MicroService)
getService = do
services <- ask
liftIO . atomically $ do
mss <- readTVar services
...
EDITED 2015-11-29: see bottom
I'm trying to write an application that has a do-last-action-again button. The command in question can ask for input, and my thought for how to accomplish this was to just rerun the resulting monad with memoized IO.
There are lots of posts on SO with similar questions, but none of the solutions seem to work here.
I lifted the memoIO code from this SO answer, and changed the implementation to run over MonadIO.
-- Memoize an IO function
memoIO :: MonadIO m => m a -> m (m a)
memoIO action = do
ref <- liftIO $ newMVar Nothing
return $ do
x <- maybe action return =<< liftIO (takeMVar ref)
liftIO . putMVar ref $ Just x
return x
I've got a small repro of my app's approach, the only real difference being my app has a big transformer stack instead of just running in IO:
-- Global variable to contain the action we want to repeat
actionToRepeat :: IORef (IO String)
actionToRepeat = unsafePerformIO . newIORef $ return ""
-- Run an action and store it as the action to repeat
repeatable :: IO String -> IO String
repeatable action = do
writeIORef actionToRepeat action
action
-- Run the last action stored by repeatable
doRepeat :: IO String
doRepeat = do
x <- readIORef actionToRepeat
x
The idea being I can store an action with memoized IO in an IORef (via repeatable) when I record what was last done, and then do it again it out with doRepeat.
I test this via:
-- IO function to memoize
getName :: IO String
getName = do
putStr "name> "
getLine
main :: IO ()
main = do
repeatable $ do
memoized <- memoIO getName
name <- memoized
putStr "hello "
putStrLn name
return name
doRepeat
return ()
with expected output:
name> isovector
hello isovector
hello isovector
but actual output:
name> isovector
hello isovector
name> wasnt memoized
hello wasnt memoized
I'm not entirely sure what the issue is, or even how to go about debugging this. Gun to my head, I'd assume lazy evaluation is biting me somewhere, but I can't figure out where.
Thanks in advance!
EDIT 2015-11-29: My intended use case for this is to implement the repeat last change operator in a vim-clone. Each action can perform an arbitrary number of arbitrary IO calls, and I would like it to be able to specify which ones should be memoized (reading a file, probably not. asking the user for input, yes).
the problem is in main you are creating a new memo each time you call the action
you need to move memoized <- memoIO getName up above the action
main :: IO ()
main = do
memoized <- memoIO getName --moved above repeatable $ do
repeatable $ do
--it was here
name <- memoized
putStr "hello "
putStrLn name
return name
doRepeat
return ()
edit: is this acceptable
import Data.IORef
import System.IO.Unsafe
{-# NOINLINE actionToRepeat #-}
actionToRepeat :: IORef (IO String)
actionToRepeat = unsafePerformIO . newIORef $ return ""
type Repeatable a = IO (IO a)
-- Run an action and store the Repeatable part of the action
repeatable :: Repeatable String -> IO String
repeatable action = do
repeatAction <- action
writeIORef actionToRepeat repeatAction
repeatAction
-- Run the last action stored by repeatable
doRepeat :: IO String
doRepeat = do
x <- readIORef actionToRepeat
x
-- everything before (return $ do) is run just once
hello :: Repeatable String
hello = do
putStr "name> "
name <- getLine
return $ do
putStr "hello "
putStrLn name
return name
main :: IO ()
main = do
repeatable hello
doRepeat
return ()
I came up with a solution. It requires wrapping the original monad in a new transformer which records the results of IO and injects them the next time the underlying monad is run.
Posting it here so my answer is complete.
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
import Control.Applicative (Applicative(..))
import Data.Dynamic
import Data.Maybe (fromJust)
import Control.Monad.RWS
-- | A monad transformer adding the ability to record the results
-- of IO actions and later replay them.
newtype ReplayT m a =
ReplayT { runReplayT :: RWST () [Dynamic] [Dynamic] m a }
deriving ( Functor
, Applicative
, Monad
, MonadIO
, MonadState [Dynamic]
, MonadWriter [Dynamic]
, MonadTrans
)
-- | Removes the first element from a list State and returns it.
dequeue :: MonadState [r] m
=> m (Maybe r)
dequeue = do
get >>= \case
[] -> return Nothing
(x:xs) -> do
put xs
return $ Just x
-- | Marks an IO action to be memoized after its first invocation.
sample :: ( MonadIO m
, Typeable r)
=> IO r
-> ReplayT m r
sample action = do
a <- dequeue >>= \case
Just x -> return . fromJust $ fromDynamic x
Nothing -> liftIO action
tell [toDyn a]
return a
-- | Runs an action and records all of its sampled IO. Returns a
-- action which when invoked will use the recorded IO.
record :: Monad m
=> ReplayT m a
-> m (m a)
record action = do
(a, w) <- evalRWST (runReplayT action) () []
return $ do
evalRWST (runReplayT action) () w
return a
There are trillions of monad tutorial including the reader and it seems all clear when you read about it. But when you actually need to write, it becomes a different matter.
I'v never used the Reader, just never got to it in practice. So I don't know how to go about it although I read about it.
I need to implement a simple database connection pool in Scotty so every action can use the pool. The pool must be "global" and accessible by all action functions. I read that the way to do it is the Reader monad. If there are any other ways please let me know.
Can you please help me and show how to do this with the Reader correctly?
I'll probably learn faster if I see how it is done with my own examples.
{-# LANGUAGE OverloadedStrings #-}
module DB where
import Data.Pool
import Database.MongoDB
-- Get data from config
ip = "127.0.0.1"
db = "index"
--Create the connection pool
pool :: IO (Pool Pipe)
pool = createPool (runIOE $ connect $ host ip) close 1 300 5
-- Run a database action with connection pool
run :: Action IO a -> IO (Either Failure a)
run act = flip withResource (\x -> access x master db act) =<< pool
So the above is simple. and I want to use the 'run' function in every Scotty action to access the database connection pool. Now, the question is how to wrap it in the Reader monad to make it accessible by all functions? I understand that the 'pool' variable must be 'like global' to all the Scotty action functions.
Thank you.
UPDATE
I am updating the question with the full code snippet. Where I pass the 'pool' variable down the function chain. If someone can show how to change it to utilize the monad Reader please.
I don't understand how to do it.
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Network.HTTP.Types
import Web.Scotty
import qualified Data.Text as T
import qualified Data.Text.Lazy as LT
import Data.Text.Lazy.Internal
import Data.Monoid (mconcat)
import Data.Aeson (object, (.=), encode)
import Network.Wai.Middleware.Static
import Data.Pool
import Database.MongoDB
import Control.Monad.Trans (liftIO,lift)
main = do
-- Create connection pool to be accessible by all action functions
pool <- createPool (runIOE $ connect $ host "127.0.0.1") close 1 300 5
scotty 3000 (basal pool)
basal :: Pool Pipe -> ScottyM ()
basal pool = do
middleware $ staticPolicy (noDots >-> addBase "static")
get "/json" (showJson pool)
showJson :: Pool Pipe -> ActionM ()
showJson pool = do
let run act = withResource pool (\pipe -> access pipe master "index" act)
d <- lift $ run $ fetch (select [] "tables")
let r = either (const []) id d
text $ LT.pack $ show r
Thanks.
UPDATE 2
I tried to do it the way it was suggested below but it does not work.
If anyone has any ideas, please. The list of compile errors is so long that I don't even know where to begin ....
main = do
pool <- createPool (runIOE $ connect $ host "127.0.0.1") close 1 300 5
scotty 3000 $ runReaderT basal pool
basal :: ScottyT LT.Text (ReaderT (Pool Pipe) IO) ()
basal = do
middleware $ staticPolicy (noDots >-> addBase "static")
get "/json" $ showJson
showJson :: ActionT LT.Text (ReaderT (Pool Pipe) IO) ()
showJson = do
p <- lift ask
let rdb a = withResource p (\pipe -> access pipe master "index" a)
j <- liftIO $ rdb $ fetch (select [] "tables")
text $ LT.pack $ show j
UPDATE 3
Thanks to cdk for giving the idea and thanks to Ivan Meredith for giving the scottyT suggestion. This question also helped: How do I add the Reader monad to Scotty's monad
This is the version that compiles. I hope it helps someone and saves some time.
import qualified Data.Text.Lazy as T
import qualified Data.Text.Lazy.Encoding as T
import Data.Text.Lazy (Text)
import Control.Monad.Reader
import Web.Scotty.Trans
import Data.Pool
import Database.MongoDB
type ScottyD = ScottyT Text (ReaderT (Pool Pipe) IO)
type ActionD = ActionT Text (ReaderT (Pool Pipe) IO)
-- Get data from config
ip = "127.0.0.1"
db = "basal"
main = do
pool <- createPool (runIOE $ connect $ host ip) close 1 300 5
let read = \r -> runReaderT r pool
scottyT 3000 read read basal
-- Application, meaddleware and routes
basal :: ScottyD ()
basal = do
get "/" shoot
-- Route action handlers
shoot :: ActionD ()
shoot = do
r <- rundb $ fetch $ select [] "computers"
html $ T.pack $ show r
-- Database access shortcut
rundb :: Action IO a -> ActionD (Either Failure a)
rundb a = do
pool <- lift ask
liftIO $ withResource pool (\pipe -> access pipe master db a)
I've been trying to figure out this exact problem myself. Thanks to hints on this SO question, and other research I've come up with the following which works for me. The key bit you were missing was to use scottyT
No doubt there is a prettier way to write runDB but I don't have much experience in Haskell, so please post it if you can do better.
type MCScottyM = ScottyT TL.Text (ReaderT (Pool Pipe) IO)
type MCActionM = ActionT TL.Text (ReaderT (Pool Pipe) IO)
main :: IO ()
main = do
pool <- createPool (runIOE $ connect $ host "127.0.0.1") close 1 300 5
scottyT 3000 (f pool) (f pool) $ app
where
f = \p -> \r -> runReaderT r p
app :: MCScottyM ()
app = do
middleware $ staticPolicy (noDots >-> addBase "public")
get "/" $ do
p <- runDB dataSources
html $ TL.pack $ show p
runDB :: Action IO a -> MCActionM (Either Failure a)
runDB a = (lift ask) >>= (\p -> liftIO $ withResource p (\pipe -> access pipe master "botland" a))
dataSources :: Action IO [Document]
dataSources = rest =<< find (select [] "datasources")
Update
I guess this a bit more pretty.
runDB :: Action IO a -> MCActionM (Either Failure a)
runDB a = do
p <- lift ask
liftIO $ withResource p db
where
db pipe = access pipe master "botland" a
As you've alluded, the way to make it accessable is to wrap your computations in the Reader monad or more likely the ReaderT transformer. So your run function (changed slightly)
run :: Pool Pipe -> Action IO a -> IO (Either Failure a)
run pool act =
flip withResource (\x -> access x master db act) =<< pool
becomes
run :: Action IO a -> ReaderT (Pool Pipe) IO (Either Failure a)
run act = do
pool <- ask
withResource pool (\x -> access x master db act)
Computations inside a ReaderT r m a environment can access the r using ask and ReaderT seemingly conjures it out of thin air! In reality, the ReaderT monad is just plumbing the Env throughout the computation without you having to worry about it.
To run a ReaderT action, you use runReaderT :: ReaderT r m a -> r -> m a. So you call runReaderT on your top level scotty function to provide the Pool and runReaderT will unwrap the ReaderT environment and return you a value in the base monad.
For example, to evaluate your run function
-- remember: run act :: ReaderT (Pool Pipe) IO (Either Failure a)
runReaderT (run act) pool
but you wouldn't want to use runReaderT on run, as it is probably part of a larger computation that should also share the ReaderT environment. Try to avoid using runReaderT on "leaf" computations, you should generally call it as high up in the program logic as possible.
EDIT: The difference between Reader and ReaderT is that Reader is a monad while ReaderT is a monad transformer. That is, ReaderT adds the Reader behaviour to another monad (or monad transformer stack). If you're not familiar with monad transformers I'd recommend real world haskell - transformers.
You have showJson pool ~ ActionM () and you want to add a Reader environment with access to a Pool Pipe. In this case, you actually need ActionT and ScottyT transformers rather than ReaderT in order to work with functions from the scotty package.
Note that ActionM is defined type ActionM = ActionT Text IO, similarly for ScottyM.
I don't have all the necessary libraries installed, so this might not typecheck, but it should give you the right idea.
basal :: ScottyT Text (ReaderT (Pool Pipe) IO) ()
basal = do
middleware $ staticPolicy (...)
get "/json" showJson
showJson :: ActionT Text (ReaderT (Pool Pipe) IO) ()
showJson = do
pool <- lift ask
let run act = withResource pool (\p -> access p master "index act)
d <- liftIO $ run $ fetch $ select [] "tables"
text . TL.pack $ either (const "") show d
I have code in the Reader Monad, so as to pass a file handle as an invisible parameter down the Reader chain.
In writeMail, I am trying to create a Reader, which, when run using runReader, produces an IO () output which is itself the result of a chain of IO monads
writeMail :: Reader Handle (IO ())
writeMail mail = do
wmh <- writeMailHeaders mail
wmb <- writeMailBody mail
return $ wmh >>= \_ -> wmb
However I am finding that only the last in the IO chain i.e. wmb, prints at the console.
Can anyone see what I should be doing to get wmh, then wmb to print?
With simpler example:
module Read where
import Data.Functor.Identity
write :: Monad m => m (IO ())
write = do
a <- return $ putStrLn "foo"
b <- return $ putStrLn "bar"
return $ a >> b
main :: IO ()
main = runIdentity write
main prints both "foo" and "bar". So I suspect the error is in writeMailHeaders.
What you need is not just a reader, but a ReaderT monad transformer with IO as a base monad.
Since your example was incomplete, I made some changes to show your options:
import Control.Monad.Reader
writeMail :: ReaderT Handle IO ()
writeMail = do
-- Here's how you get your handle to further do something to it:
handle <- ask
-- Here's how you do the IO actions.
-- Notice the `lift` function,
-- which allows us to run actions of the base monad,
-- which in that case is `IO`.
lift $ do
print "bla bla"
print "bla"