Catch IO exceptions within an instance of MonadResource - exception

Short version
Same question as in here, but within a generic MonadResource instance rather than an explicit ResourceT m.
Long version
How would you define a catch function such that:
import Control.Exception (Exception, IOException)
import Control.Monad.Trans.Resource (MonadResource, runResourceT)
catch :: (MonadResource m, Exception e) -> m () -> (e -> m ()) -> m ()
catch = undefined
-- 'a' and 'b' are functions from an external library,
-- so I can't actually change their implementation
a, b :: MonadResource m => m ()
a = -- Something that might throw IO exceptions
b = -- Something that might throw IO exceptions
main :: IO ()
main = runResourceT $ do
a `catch` \(e :: IOException) -> -- Exception handling
b `catch` \(e :: IOException) -> -- Exception handling
The problems I run into are:
In Control.Exception, catch only works on bare IOs ;
In Control.Exception.Lifted, catch requires an instance of MonadBaseControl, which MonadResource is unfortunately not (and I wonder why) ;
MonadResource implies MonadThrow which defines a monadThrow function without its 'catch' equivalent (and I wonder why) ;
It looks like the only way to handle IO exceptions is to exit the ResourceT layer, and this bothers me: I'd like to be able to handle exceptions locally without travelling through the monad transformers stack.
For information, in my real code, a and b are actually the http function from Network.HTTP.Conduit.
Thank you for your insights.
Minimal code with the problem
Compilable with ghc --make example.hs with http-conduit library installed:
{-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-}
import Control.Exception.Lifted (IOException, catch)
import Control.Monad.Base (liftBase)
import Control.Monad.Error (MonadError(..), runErrorT)
import Control.Monad.Trans.Control (MonadBaseControl)
import Control.Monad.Trans.Resource (MonadResource, runResourceT)
import Data.Conduit
import Data.Conduit.List (consume)
import Data.Conduit.Text (decode, utf8)
import Data.Text (Text)
import Network.HTTP.Client
import Network.HTTP.Conduit (http)
main :: IO ()
main = do
result <- runErrorT $ runResourceT f
putStrLn $ "OK: " ++ show result
f :: (MonadBaseControl IO m, MonadResource m, MonadError String m) => m [Text]
f = do
req <- liftBase $ parseUrl "http://uri-that-does-not-exist.abc"
manager <- liftBase $ newManager defaultManagerSettings
response <- (http req manager `catch` \(e :: IOException) -> throwError $ show e)
response $$+- decode utf8 =$ consume
When executed, this program ends in error with the following output:
InternalIOException getAddrInfo: does not exist (Name or service not known)

http does not throw IOException, it throws HttpException and InternalIOException is one of the latter's constructors.
You should either catch HttpException or SomeException in case you want to catch all exceptions.

The type you need,
a, b :: MonadResource m, MonadBaseControl IO m => m ()
Is a special case of the type you currently have
a, b :: MonadResource m => m ()
as the only difference is the extra class constraint. You are free to make the type signatures in your code less general than they would be by default; therefore, changing the signatures of a and b should be enough.

If I understand your problem correctly, there is no problem with using lifted-base. Although the type of a and b only use the constraint MonadResource m, it doesn't mean you can't use them on a monad that has other additional properties. For example, if you perform your computation inside ResourceT, it satisfies the constraint for a and b, and you can also use anything from Control.Exception.Lifted:
-- ...
import Control.Exception.Lifted
-- 'a' and 'b' are functions from an external library,
-- so I can't actually change their implementation
a, b :: MonadResource m => m ()
a = undefined -- Something that might throw IO exceptions
b = undefined -- Something that might throw IO exceptions
main :: IO ()
main = runResourceT $ do
a `catch` \(e :: IOException) -> undefined -- Exception handling
b `catch` \(e :: IOException) -> undefined -- Exception handling

If you alter the type signature of catch to include MonadCatch from the exceptions package, then it would be trivial:
import Control.Monad.Trans.Resource (MonadResource, runResourceT)
import Control.Monad.Catch (catch)
a, b :: MonadResource m => m ()
a = …
b = …
main :: IO ()
main = runResourceT $ do
a `catch` \e -> …
b `catch` \e -> …
Note that this does not require any changes for a nor b.
Also, both duplode and Petr Pudlák have pointed out that you are free to make the monad for catch to be as specific as you like, because doing so does not require any cooperation from a or b. So any of these solutions will work.

Related

Streaming parsing of JSON in Haskell with Pipes.Aeson

The Pipes.Aeson library exposes the following function:
decode :: (Monad m, ToJSON a) => Parser ByteString m (Either DecodingError a)
If I use evalStateT with this parser and a file handle as an argument, a single JSON object is read from the file and parsed.
The problem is that the file contains several objects (all of the same type) and I'd like to fold or reduce them as they are read.
Pipes.Parse provides:
foldAll :: Monad m => (x -> a -> x) -> x -> (x -> b) -> Parser a m b
but as you can see this returns a new parser - I can't think of a way of supplying the first parser as an argument.
It looks like a Parser is actually a Producer in a StateT monad transformer. I wondered whether there's a way of extracting the Producer from the StateT so that evalStateT can be applied to the foldAll Parser, and the Producer from the decode Parser.
This is probably completely the wrong approach though.
My question, in short:
When parsing a file using Pipes.Aeson, what's the best way to fold all the objects in the file?
Instead of using decode, you can use the decoded parsing lens from Pipes.Aeson.Unchecked. It turns a producer of ByteString into a producer of parsed JSON values.
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Pipes
import qualified Pipes.Prelude as P
import qualified Pipes.Aeson as A
import qualified Pipes.Aeson.Unchecked as AU
import qualified Data.ByteString as B
import Control.Lens (view)
byteProducer :: Monad m => Producer B.ByteString m ()
byteProducer = yield "1 2 3 4"
intProducer :: Monad m => Producer Int m (Either (A.DecodingError, Producer B.ByteString m ()) ())
intProducer = view AU.decoded byteProducer
The return value of intProducer is a bit scary, but it only means that intProducer finishes either with a parsing error and the unparsed bytes after the error, or with the return value of the original producer (which is () in our case).
We can ignore the return value:
intProducer' :: Monad m => Producer Int m ()
intProducer' = intProducer >> return ()
And plug the producer into a fold from Pipes.Prelude, like sum:
main :: IO ()
main = do
total <- P.sum intProducer'
putStrLn $ show total
In ghci:
λ :main
10
Note also that the functions purely and impurely let you apply to producers folds defined in the foldl package.

Catching exceptions in a pipe without terminating it

This feels like kind of a long shot, but I wrote a pipe to connect to a database, get a list of databases on the server, connect to each one, then perform a query on each one (a user count), then print those counts. Unfortunately this is about as much as I can simplify it from my real example. I'm using pipes-4.1.0, pipes-safe-2.0.2, and mysql-simple-0.2.2.4. Here is the code:
{-# LANGUAGE RankNTypes, OverloadedStrings #-}
import Pipes
import qualified Pipes.Safe as PS
import qualified Pipes.Prelude as P
import Database.MySQL.Simple
import qualified Data.Text as T
import Control.Monad.Catch as MC
import Control.Monad (forever)
import Database.MySQL.Simple.QueryParams
import Database.MySQL.Simple.QueryResults
data DBName = DBName T.Text deriving Show
-- connect to a database and use a table.
mydb :: T.Text -> ConnectInfo
mydb = undefined
-- Quirk of (mysql|postgresql)-simple libraries
unOnly (Only a) = a
queryProducer :: (MonadIO m, QueryParams params, QueryResults r) => Connection -> Query -> params -> Pipes.Producer' r m ()
queryProducer = undefined
myDBNames :: (PS.MonadSafe m, MonadIO m) => Producer DBName m ()
myDBNames = PS.bracket (liftIO $ connect $ mydb "sometable") (liftIO . close) $ \db ->
queryProducer db "show databases" () >-> P.map (DBName . unOnly)
-- I realize this is inefficient, one step at a time.
connectToDB :: (PS.MonadSafe m, MonadIO m) => Pipe DBName Connection m ()
connectToDB = forever $ do
(DBName dbname) <- await
PS.bracket
(liftIO . connect . mydb $ dbname)
(liftIO . close)
yield
userCount :: (PS.MonadCatch m, MonadIO m) => Pipe Connection Int m ()
userCount = forever $ do
db <- await
queryProducer db "select count(*) from user" () >-> P.map unOnly
main :: IO ()
main = PS.runSafeT $ runEffect $ myDBNames >-> P.tee P.print >-> connectToDB >-> userCount >-> P.print
This works fine. However, let's say in one of those databases, the user table is named users instead of user, therefore mysql-simple will throw an exception when that query is run. I want to catch that error inline, and just return 0 users for those queries, but keep going. Things I've tried:
(queryProducer db "select count(*) from user" () `PS.catchAll` (\e -> (liftIO $ putStrLn "failure") >> yield (Only 0))) >-> P.map unOnly
This doesn't work. Sometimes it will print failure and yield a 0, only to immediately terminate on exception. I thought maybe it is because I broke out of queryProducer with the exception, and I should call it again so I tried this recursive version:
thequery db >-> P.map unOnly
where
thequery db = queryProducer db "select count(*) from user" () `PS.catchAll` (\e -> (liftIO $ putStrLn "failure") >> yield (Only 0) >> thequery db)
But this also fails. However sometimes it will actually perform a several queries, printing out failure a few times and yielding a few 0's before terminating with an exception again. I'm really confused about why this is happening.
According to the async library, exceptions should be send up into the thread that the pipe is running in, so it doesn't seem like it could be a threading problem.
In case the implementation of my queryProducer matters, it is modeled after the pipes-postgresql query function, generalized to Producer' so I can embed it in other combinators. Below mysql-simple, in the mysql library there is a throw which throws a ConnectionError if your sql doesn't make sense, that percolates all the way up through this function.
{-# LANGUAGE RankNTypes #-}
import qualified Control.Concurrent.Async as Async
import qualified Control.Concurrent.STM as STM
import qualified Database.MySQL.Simple as My
import Database.MySQL.Simple.QueryParams
import Database.MySQL.Simple.QueryResults
import qualified Pipes
import qualified Pipes.Concurrent as Pipes
--------------------------------------------------------------------------------
-- | Convert a query to a 'Producer' of rows.
--
-- For example,
--
-- > pg <- connectToMysql
-- > query pg "SELECT * FROM widgets WHERE ID = ?" (Only widgetId) >-> print
--
-- Will select all widgets for a given #widgetId#, and then print each row to
-- standard output.
queryProducer
:: (MonadIO m, QueryResults r, QueryParams params)
=> My.Connection -> My.Query -> params -> Pipes.Producer' r m ()
queryProducer c q p = do
(o, i, seal) <- liftIO (Pipes.spawn' Pipes.Single)
worker <- liftIO $ Async.async $ do
My.fold c q p () (const $ void . STM.atomically . Pipes.send o)
STM.atomically seal
liftIO $ Async.link worker
Pipes.fromInput i
I also attempted to use EitherT to try and catch exceptions since that seems to be the way it was done in the past in pipes. But the documentation for that in pipes' tutorial disappeared between 3 and 4 making me wonder if that technique is still recommended or not. Unfortunately I could not get it to work because the way I am using queryProducer instead of singular await/yields, I'm not sure how to structure it.
Based on Gabe's comment, I fixed my queryProducer function by making sure the query cannot happen until the link function has fired.
query :: (MonadIO m, QueryResults r, QueryParams params) => My.Connection -> My.Query -> params -> Pipes.Producer' r m ()
query c q p = do
(o, i, seal) <- liftIO (Pipes.spawn' Pipes.Single)
mvar <- liftIO $ newEmptyMVar
worker <- liftIO $ Async.async $ do
takeMVar mvar
My.fold c q p () (const $ void . STM.atomically . Pipes.send o)
STM.atomically seal
liftIO $ Async.link worker
liftIO $ putMVar mvar ()
Pipes.fromInput i
I've tested this and it seems to work.

How to make a IO (a->b) function from a -> IO b in Haskell

I want to write a function that can list a directory recursively in breadth-first in Haskell.
As you can see I need a function that can convert a (a -> IO b) to a IO (a->b). Simple as it seems, I can't make it. And I want to know how to do or whether it is possible.
dirElem :: FilePath -> IO [FilePath]
dirElem dirPath = do
getDirectoryContents'' <- theConvert getDirectoryContents'
return $ takeWhile (not.null) $ iterate (concatMap getDirectoryContents'') [dirPath] where
getDirectoryContents' dirPath = do
isDir <- do doesDirectoryExist dirPath
if isDir then dirContent else return [] where
dirContent = do
contents <- getDirectoryContents dirPath
return.(map (dirElem</>)).tail.tail contents
theConvert :: (a -> IO b) -> IO (a -> b)
theConvert = ??????????
This cannot be done. The reason is that the function can use its argument of type a to determine what IO action is executed. Consider
action :: Bool -> IO String
action True = putStrLn "Enter something:" >> getLine
action False = exitFailure
Now if you'd convert it somehow to IO (Bool -> String) and evaluate this action, what should happen? There is no solution. We cannot decide if we should read a string or exit, because we don't know the Bool argument yet (and we may never know it, if the resulting function isn't called on an argument).
John's answer is a bad idea. It simply lets the IO action escape into pure computations, which will make your life miserable and you'll lose Haskell's referential transparency! For example running:
main = unsafe action >> return ()
will do nothing even though the IO action was called. Moreover, if we modify it a bit:
main = do
f <- unsafe action
putStrLn "The action has been called, calling its pure output function."
putStrLn $ "The result is: " ++ f True
you'll see that the action that asks for an input is executed in a pure computation, inside calling f. You'll have no guarantee when (if at all) the action is executed!
Edit: As others pointed out, it isn't specific just to IO. For example, if the monad were Maybe, you couldn't implement (a -> Maybe b) -> Maybe (a -> b). Or for Either, you couldn't implement (a -> Either c b) -> Either c (a -> b). The key is always that for a -> m b we can choose different effects depending on a, while in m (a -> b) the effect must be fixed.
You cannot do it in a pure way in general, but if you can enumerate all the argument values you can perform all the IO upfront and return a pure function. Something like
cacheForArgs :: [a] -> (a -> IO b) -> IO (a -> b)
cacheForArgs as f = do
bs <- mapM f as
let abs = zip as bs
return $ \ a -> fromMaybe (error "argument not cached") $ lookup a abs
cacheBounded :: (Enum a, Bounded a) => (a -> IO b) -> IO (a -> b)
cacheBounded = cacheForArgs [minBound .. maxBound]
But this function doesn't really help you much in your use case.
You cannot create such function in a safe manner. Say we have f :: a -> IO b and g = theConvert f :: IO (a -> b). They are two very different functions f is an function that takes an argument of type a and returns an IO action with result b, where the io-action may depend on the argument given. g on the other hand is an IO action with as result a function a->b, the io-action cannot depend on any argument.
Now to illustrate this problem lets lookat
theConvert putStr :: IO (String -> ())
Now what should it do when its run, it can certainly not print a given argument as it has no argument. Thus unlike putStr it can only do one action and then return some function of type String -> (), which has only one option const () (assuming no use of error or undefined).
Just as a side not, the other way around can be done, it adds the notion that the resulting action depends on the argument, while it actually does not. It can be written as
theOtherConvert :: IO (a -> b) -> (a -> IO b)
theOtherConvert m x = m >>= \f -> return $ f x
Though it works on any monad, or in applicative form theOtherConvert m x = m <*> pure x.
Petr Pudlák's answer is excellent, but I feel it can be generalized by abstracting away from IO, and looking at it from the point of view of the Applicative and Monad type classes.
Consider the types of the "combining" operations from Applicative and Monad:
(<*>) :: Applicative m => m (a -> b) -> m a -> m b
(>>=) :: Monad m => m a -> (a -> m b) -> m b
So you could say that your type a -> IO b is "monadic" while IO (a -> b) is "applicative"—meaning that you need monadic operations to compose types that look like a -> IO b, but only applicative operations for IO (a -> b)
There's a well-known intuitive statement of the "power" difference between Monad and Applicative:
Applicative computations have a fixed static structure; what actions will be executed, what order they will be executed in, and the manner in which the results will be combined is known ahead of time.
Monadic computations don't have such a fixed static structure; a monadic computation can examine the result value from one of its subactions and then choose between different structures at execution time.
Petr's answer is a concrete illustration of this point. I'll repeat his definition of action:
action :: Bool -> IO String
action True = putStrLn "Enter something:" >> getLine
action False = exitFailure
Suppose we have foo :: IO Bool. Then when we write foo >>= action to bind action's parameter to foo's result, the resulting computation does nothing less than what my second bullet point describes; it examines the result of executing foo and chooses between alternative actions based on its value. This is precisely one of the things that Monad allows you to do that Applicative doesn't. You can't Petr's action into IO (Bool -> String) unless at the same time you predetermine which branch would be taken.
Similar remarks apply to augustss's response. By requiring that a list of values be specified ahead of time, what it's doing is making you choose which branches to take ahead of time, taking them all, and then allowing you to pick between their results.

How print functions in Haskell like a python or scala?

I try to print functions in Haskell only for fun, like this example:
{-# LANGUAGE FlexibleInstances #-}
instance Show (Int -> Bool) where
show _ = "function: Int -> Bool"
loading in GHCi and run and example:
λ> :l foo
[1 of 1] Compiling Main ( foo.hs, interpreted )
foo.hs:2:1: Warning: Unrecognised pragma
Ok, modules loaded: Main.
λ> (==2) :: Int -> Bool
function: Int -> Bool
But, I wish to see that every function print yourself at invocation.
You can not have this for a general function as type information is present only at compile time, but you use Typeable class for writing something close enough if the type is an instance for Typeable class.
import Data.Typeable
instance (Typeable a, Typeable b) => Show (a -> b) where
show f = "Function: " ++ (show $ typeOf f)
Testing this in ghci
*Main> (+)
Function: Integer -> Integer -> Integer
*Main> (+10)
Function: Integer -> Integer
But this will not work for general functions until the type is restricted to a type that has Typeable instance.
*Main> zip
<interactive>:3:1:
Ambiguous type variable `a0' in the constraint:
(Typeable a0) arising from a use of `print'
Probable fix: add a type signature that fixes these type variable(s)
In a stmt of an interactive GHCi command: print it
<interactive>:3:1:
Ambiguous type variable `b0' in the constraint:
(Typeable b0) arising from a use of `print'
Probable fix: add a type signature that fixes these type variable(s)
In a stmt of an interactive GHCi command: print it
*Main> zip :: [Int] -> [Bool] -> [(Int,Bool)]
Function: [Int] -> [Bool] -> [(Int,Bool)]
I'm assuming that you want the show method to print the function's address, which is what Python does:
>>> def foo(a):
... return a
...
>>> print foo
<function foo at 0xb76f679c>
There is really no supported way to do it (Haskell is a safe, high-level language that abstracts from such low-level details as function pointers), unless you're willing to use the internal GHC function unpackClosure#:
{-# LANGUAGE MagicHash,UnboxedTuples,FlexibleInstances #-}
module Main
where
import GHC.Base
import Text.Printf
instance Show (a -> a) where
show f = case unpackClosure# f of
(# a, _, _ #) -> let addr = (I# (addr2Int# a))
in printf "<function ??? at %x>" addr
main :: IO ()
main = print (\a -> a)
Testing:
$ ./Main
<function ??? at 804cf90>
Unfortunately, there is no way to get the function's name, since it is simply not present in the compiled executable (there may be debug information, but you can't count on its presence). If your function is callable from C, you can also get its address by using a C helper.

How to throw an exception and exit the program in Haskell?

I have a question: how do I throw an exception and exit the program? I have writen down a simple example:
-- main.hs
import Test
main = do
Test.foo ""
putStrLn "make some other things"
Here is the module:
moldule Test where
foo :: String -> IO ()
foo x = do
if null x
then THROW EXCEPTION AND EXIT MAIN else putStrLn "okay"
I want to start this and throw a exception and exit the program, but how?
Well, you could try
foo :: String -> IO ()
foo x = do
if null x
then error "Oops!" else putStrLn "okay"
Or, if you intend to catch the error eventually, then
import Control.Exception
data MyException = ThisException | ThatException
deriving (Show, Typeable)
instance Exception MyException
...
foo :: String -> IO ()
foo x = do
if null x
then throw ThisException else putStrLn "okay"
There are often more haskelly mechanisms that you could use, such as returning values packed in Maybe type or some other structure that describes the failure. Exceptions seem to fit better in cases where returning complicated types would complicate otherwise re-usable interfaces too much.