Hi Kim-Ee,
Sorry for not making the problem clear enough! Here's an example. It
is somewhat contrived, but I think it captures the essence of the
problem.
Imagine I need to read a .CSV file which may or may not contain
column titles on its first line. I'm not interested in the column
titles, I just want the rest of the file. I am provided a library
function to read the contents of the file (using a "callback"). The
library author provided this function in the IO monad.
withCSV :: FilePath -> (Handle -> IO r) -> IO r
withCSV path action = do
putStrLn "opening file"
h <- openFile path ReadWriteMode
r <- action h
hClose h
putStrLn "file closed"
return r
The problem arises because I also want to use the ReaderT monad
transformer. My environment information will tell me
whether or not to disregard the first (i.e. column title) line.
Here's a *failed* attempt at writing this next step:
data ColumnHeaders = FirstLine | None
getFileContents :: ReaderT ColumnHeaders IO String
getFileContents = liftIO $ withCSV "data.csv" myReadFile
where
myReadFile :: Handle -> IO String
myReadFile handle = do
header <- ask --- OOOPPSss!!! FAIL! Can't ask.
case header of
None -> return ""
FirstLine -> hGetLine handle -- skip first line
text <- hGetContents handle
evaluate (length text) -- force lazy IO
return text
main = do
cs <- runReaderT getFileContents
FirstLine
print cs
Unfortunately, I can't write getFileContents as
described above because myReadFile is an IO action and
cannot access the configuration information available through the
Reader. If I could rewrite withCSV I could fix this issue:
withCSVLifted :: MonadIO mIO => FilePath -> (Handle ->
mIO r) -> mIO r
withCSVLifted path action = do
liftIO $putStrLn "opening file"
h <- liftIO $ openFile path ReadMode
r <- action h
liftIO $ hClose h
liftIO $ putStrLn "file closed"
return r
The difference between withCSV and withCSVLifted
is just a bunch of liftIO operations and a more flexible
type signature. The crucial change is that the lifted version allows
any function of type (MonadIO mIO => Handle -> mIO r)
rather than just (Handle -> IO r). This is general
enough to allow me to re-write my configuration step and call ask
(from within the callback).
getFileContentsLifted :: ReaderT ColumnHeaders IO String
getFileContentsLifted = withCSVLifted "data.csv" myReadFile
where
myReadFile :: Handle -> ReaderT ColumnHeaders IO String
myReadFile handle = do
header <- ask
case header of
None -> return ""
FirstLine -> liftIO $ hGetLine handle -- skip
first line then
text <- liftIO $ hGetContents handle
liftIO $ evaluate (length text) -- force lazy IO
return text
Other than calling the respective lifted version of withCSV
the only difference between getFileContentsLifted and getFileContents
are the extra liftIO calls.
It can be very cumbersome to write a working version of getFileContents
in the IO monad without easy access to ReaderT's ask. So,
my questions were:
1. Should library authors always provide lifted versions of
functions that take callbacks? In other words, is
withCSVLifted :: MonadIO mIO => FilePath -> (Handle ->
mIO r) -> mIO r
always better than
withCSV :: FilePath -> (Handle -> IO r) -> IO r
? If not, what's the best practice?
2. Once we define the MonadIO class, shouldn't the compiler be able
to transform
withCSV :: FilePath -> (Handle -> IO r) -> IO r
into
withCSVLifted :: MonadIO mIO => FilePath -> (Handle ->
mIO r) -> mIO r
by adding a number of liftIO calls to that class upon
request? It seems like the kind of change we would like to automate.
This email turned out to be longer than I expected. I hope it is
clearer.
You can find all the code here:
https://gist.github.com/dimitri-xyz/3f9d1f6632479ef59304
Thanks!
Dimitri
On 10/23/15 7:48 PM, Kim-Ee Yeoh wrote: