No instance for Show arising from a use in "main" level - haskell

I have a code that reads files and parses using UU.Parsing lib that returns an abstract sintax tree and shows on the screen.
I received the error message "No instance for Show" in my functions originated in tokensParserToByteString and applyParser using parseIO (of UU.Parsing lib) and inherited signatures until main. I fixed the signatures but my problem is in the main function. I added the instance Show in the signature but I have the next compilation error:
No instance for (Show (IO J2s)) arising from a use of ‘main’
In the expression: main
When checking the type of the IO action ‘main’
The complete error message is:
$ cabal build
Building java2scala-1.0...
Preprocessing library java2scala-1.0...
In-place registering java2scala-1.0...
Preprocessing executable 'java2scala' for java2scala-1.0...
Preprocessing executable 'test' for java2scala-1.0...
[5 of 5] Compiling Main ( test/Main.hs, dist/build/test/test-tmp/Main.o )
test/Main.hs:27:1:
No instance for (Show (IO J2s)) arising from a use of ‘main’
In the expression: main
When checking the type of the IO action ‘main’
Some idea, about the problem?
Main module
{-# LANGUAGE FlexibleContexts #-}
module Main where
import UU.Parsing
...
import Content
main :: (Show (IO J2s)) => IO()
main = do f <- getLine
let command = test f
command
test :: (Show (IO J2s)) => String -> IO()
test "testparser" = testParser
Test module
{-# LANGUAGE FlexibleContexts #-}
module J2s.Parser.Test where
import Content
import J2s.Ast.Sintax
import J2s.Parser
import UU.Parsing
...
testParser :: (Show (IO J2s)) => IO()
testParser = (runSafeIO $ runProxy $ runEitherK $
contentsRecursive "path/of/my/tests" />/ handlerParser) :: (Show (IO J2s)) => IO()
Content module
{-# LANGUAGE FlexibleContexts #-}
module Content where
import Control.Monad(forM, liftM)
import System.Directory (doesDirectoryExist, getDirectoryContents)
import System.FilePath ((</>), splitExtension, splitFileName)
import J2s.Parser
import J2s.Ast.Sintax
import UU.Parsing
import Control.Monad (when, unless)
import Control.Proxy
import Control.Proxy.Safe hiding (readFileS)
import J2s.Scanner.Token
import Text.Show
import UU.Parsing
contentsRecursive
:: (CheckP p)
=> FilePath -> () -> Producer (ExceptionP p) FilePath SafeIO ()
contentsRecursive path () = loop path
where
loop path = do
contents path () //> \newPath -> do
respond newPath
isDir <- tryIO $ doesDirectoryExist newPath
let isChild = not $ takeFileName newPath `elem` [".", ".."]
when (isDir && isChild) $ loop newPath
applyParser :: (Proxy p, Show (IO J2s)) => String -> Consumer p B.ByteString IO ()
applyParser path = runIdentityP loop
where
loop = do
bs <- request ()
let sc = classify (initPos path) (B8.unpack bs)
lift $ B8.putStrLn (tokensParserToByteString sc)
tokensParserToByteString :: (Show (IO J2s)) => [Token] -> B.ByteString
tokensParserToByteString tokens = B8.pack(show (parseIO pJ2s tokens))
handlerParser :: (CheckP p, Show (IO J2s)) => FilePath -> Session (ExceptionP p) SafeIO ()
handlerParser path = do
canRead <- tryIO $ fmap readable $ getPermissions path
isDir <- tryIO $ doesDirectoryExist path
isValidExtension <- tryIO $ evaluate ((snd (splitExtension path) == ".java" || snd (splitExtension path) == ".mora") && (snd (splitFileName path) /= "EncodeTest.java") && (snd (splitFileName path) /= "T6302184.java") && (snd (splitFileName path) /= "Unmappable.java"))
when (not isDir && canRead && isValidExtension) $
(readFileSP 10240 path >-> try . applyParser) path
readFileSP
:: (CheckP p)
=> Int -> FilePath -> () -> Producer (ExceptionP p) B.ByteString SafeIO ()
readFileSP chunkSize path () =
bracket id (openFile path ReadMode) hClose $ \handle -> do
let loop = do
eof <- tryIO $ hIsEOF handle
unless eof $ do
bs <- tryIO $ B.hGetSome handle chunkSize
respond bs
loop
loop

A signature like Show (IO J2s) => IO () almost never makes sense. What this expresses is basically “provided the universe is crafted such that IO J2s has a Show instance, I give you an IO () action”. Well, if the universe has that property, then give us IO () action right now. Keep nasty chipsconstraints!
Constraints only really make sense if you apply them to type variables, i.e. if you're writing code that's polymorphic over several different, but not all types. (Like with CheckP p). But a constraint applied to concrete types does little more than defer type errors.
IO J2s has no Show instance. And it can't have such an instance: this is an IO action. It could be a complete subprogram that might execute costly computations, call commercial third-party library code, launch some missiles... and only in the very end return a J2s value. How do you expect to pack all the information of something so possibly complex into a simple string?
What possibly does have a Show instance is J2s. If you're in the IO monad anyway and have an IO J2s action, you can at any point fetch the J2s value from it by monad-binding that action (i.e. executing the subprogram) and just showing the J2s value. In your case:
tokensParserToByteString :: [Token] -> IO B.ByteString
tokensParserToByteString tokens = fmap (B8.pack . show) $ parseIO pJ2s tokens
I case you're confused about fmapping in the IO functor, this is equivalent to
tokensParserToByteString :: [Token] -> IO B.ByteString
tokensParserToByteString tokens = do
j2sValue <- parseIO pJ2s tokens
return . B8.pack $ show j2sValue
Of course you then need to adapt applyParser because tokensParserToByteString is now an IO action. Easy enough with the =<< operator:
applyParser :: Proxy p => String -> Consumer p B.ByteString IO ()
applyParser path = runIdentityP loop
where
loop = do
bs <- request ()
let sc = classify (initPos path) (B8.unpack bs)
lift $ B8.putStrLn =<< tokensParserToByteString sc

Related

Why does this TCP server immediately exit?

This is an extraction I did from a larger project, which didn't seem to have the issue of the server immediately returning (I'll admit the reason I did the extraction in the first place was in the hope of asking a different question regarding failure of accept, so there may be other issues with the code).
I wouldn't think running with fewer threads (well, one thread) would be an issue, but TCP.serve seems to silently return:
starting tcp server
exgetting protobuf port
iting serveTBQ
tcp server exited
The expected behavior is that this would continue running, listening on the specified port (getPort).
Here is the self-contained example code:
#!/usr/bin/env stack
{- stack script --nix --resolver lts-14.27
--nix-packages zlib
--no-nix-pure
--package bytestring
--package classy-prelude
--package conduit
--package exceptions
--package mtl
--package network
--package network-simple
--package stm
--package stm-conduit
--package text
--package unliftio
--ghc-options -Wall
-}
-- Use --verbose above for better error messages for library build failures
-- --package refined
-- --extra-dep unexceptionalio-0.5.1
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Main where
import ClassyPrelude hiding (hClose)
import Conduit
import Control.Concurrent.STM.TBQueue (TBQueue, writeTBQueue)
import Control.Monad.Catch (MonadMask)
import Control.Monad.Writer
import Data.Bits (shiftR, (.&.))
import qualified Data.ByteString.Char8 as B
import Data.Conduit.Async (gatherFrom)
import qualified Data.Conduit.List as CL
import Data.Function ((&))
import qualified Data.Text as T
import GHC.IO.Handle (Handle, hClose)
import qualified Network.Simple.TCP as TCP
import qualified Network.Socket as NS
import UnliftIO.Concurrent (ThreadId, forkIO, threadDelay)
type Error = [String]
type Result r = Writer Error r
runResult :: Result r -> (r, Error)
runResult = runWriter
getPort :: NS.ServiceName
getPort = "29876"
-- | This signature is meant to simulate the same function from the proto-lens library,
-- | but without dealing with protobus for binary data.
decodeMessageDelimitedH :: Handle -> IO (Either String String)
decodeMessageDelimitedH h = do
sOut <- B.hGetLine h
pure $ Right $ B.unpack sOut
protoServe :: forall m. (MonadMask m, MonadResource m, MonadUnliftIO m) =>
(String -> Result [String])
-> ConduitT () [String] m ()
protoServe fromProto = start .| mapMC logFilterRead
.| CL.catMaybes .| mapMC msgToRecs
where
port = trace "getting protobuf port" getPort
start = do
let enQserver = serveTBQ (TCP.HostIPv4) port (decodeProto . fst)
gatherFrom 10000 enQserver
decodeProto :: NS.Socket -> m (Either String String)
decodeProto sock = bracket
connHandleIO
(liftIO . hClose)
(liftIO . decodeMessageDelimitedH)
where
connHandleIO :: m Handle
connHandleIO = liftIO $ sockToHandle sock
logFilterRead :: Either String String -> m (Maybe String)
logFilterRead pEi = case pEi of
Right p -> pure $ Just p
Left err -> trace err $ pure Nothing
msgToRecs :: String -> m [String]
msgToRecs p = case runResult $ fromProto p of
(rs, rErr) -> do
when (not $ null rErr) $ pure $ trace (intercalate "\n" rErr) ()
pure $ trace "completed msgToRecs" rs
-- | The handle only needs a read-view of the socket. Note that a TBQeueue is
-- | mutable but has STM's runtime safety checks in place.
sockToHandle :: NS.Socket -> IO Handle
sockToHandle sock = NS.socketToHandle sock ReadMode
-- | Based on serve and listen from Network.Simple.TCP
-- | Unlike `serve`, which never returns, `serveTBQ` immediately returns
-- | a `TBQueue` of results.
serveTBQ :: forall a m. (MonadMask m, MonadUnliftIO m)
=> TCP.HostPreference -- ^ Host to bind.
-> NS.ServiceName -- ^ Server service port name or number to bind.
-> ((NS.Socket, NS.SockAddr) -> m a)
-- ^ Computation to run in a different thread once an incoming connection is
-- accepted. Takes the connection socket and remote end address.
-> TBQueue a -- ^ enqueue computation results to this queue
-> m ()
-- ^ Returns a FIFO (queue) of results from concurrent requests
serveTBQ hp port rFun tbq = do
_ <- async $ withRunInIO $ \run -> TCP.serve hp port $ \(lsock, _) -> do
run $ void $ acceptTBQ lsock rFun tbq
putStrLn $ T.pack "exiting serveTBQ"
-- | Based on acceptFork from Network.Simple.TCP.
acceptTBQ :: forall a m.
MonadUnliftIO m
=> NS.Socket -- ^ Listening and bound socket.
-> ((NS.Socket, NS.SockAddr) -> m a)
-- ^ Computation to run in a different thread once an incoming connection is
-- accepted. Takes the connection socket and remote end address.
-> TBQueue a
-> m ThreadId
acceptTBQ lsock rFun tbq = mask $ \restore -> do
(csock, addr) <- trace ("running restore-accept on lsock: " <> (show lsock)) $ restore (liftIO $ NS.accept lsock)
onException (forkIO $ finally
(restore $ do
rVal <- trace "retrieved rVal in finally-restore" rFun (csock, addr)
atomically $ writeTBQueue tbq rVal)
(TCP.closeSock csock))
(TCP.closeSock csock)
retryForever :: forall m a. MonadUnliftIO m => m a -> m a
retryForever prog = catchAny prog progRetry
where
progRetry :: SomeException -> m a
progRetry ex = do
putStrLn $ pack $ show ex
threadDelay 4000000
retryForever prog
-- | Safer interface to sinkNull
sinkUnits :: MonadResource m => ConduitT () Void m ()
sinkUnits = sinkNull
main :: IO ()
main = retryForever $ do
putStrLn $ T.pack "starting tcp server"
let myProtoServe = protoServe (pure . words)
myProtoServe .| mapMC (putStrLn . T.pack . intercalate "_") .| sinkUnits & runConduitRes
putStrLn $ T.pack "tcp server exited"
Maybe there is a way to get this working with multiple threads while still remaining a stack script? see multicore parallelism with stack runghc
In this case, the reason the extracted server example terminates is because the program itself eventually exits, which terminates all other threads (including the one the server is running in), whereas in my actual application, the main thread already had loops in place to prevent this.
So just adding something like this to the end of the main IO action worked:
waitForever :: IO ()
waitForever = do
threadDelay 10000
waitForever
Thanks to #ProofOfKeags on slack for the hint.

Using Exceptions in Transformer Monad

I have a question regarding use of Exceptions with a transformer stack.
I am a trying to develop some networking software, specifically implement
the GTP control protocol on S5 interface.
I am finding it difficult to get Exceptions work the transformer stack.
import Control.Monad (unless)
import Control.Exception
....
import Control.Monad.Trans.State.Strict
import Control.Monad.Trans.Except
...
data GtpcModSt = GtpcModSt { sock :: Socket
, rcvdBytes :: BS.ByteString
, s5cTeidKey :: Word32
---- ....
} --deriving (Show)
type EvalGtpC a = (StateT GtpcModSt (ExceptT GtpcExceptions IO )) a
-- deriving (Functor, Applicative, Monad)
gtpcProcess = loop
where loop = do
rcvAndProcessGtpc `catch` (\e -> do
print "Exception handler"
print (e :: SomeException))
loop
rcvAndProcessGtpc :: EvalGtpC ()
rcvAndProcessGtpc = do
sock <- gets sock
(msg, addr) <- liftIO $ recvFrom sock 1000
modify (\x -> x {rcvdBytes = msg, sndrAddr = addr})
processMsg
processMsg :: EvalGtpC ()
processMsg = do
-- validateSrc
-----
--....
msg <- gets gtpMsg
processGtpc $ msgType msg
-- createSessionRequest
processGtpc :: Word8 -> EvalGtpC ()
processGtpc 32 = do
myState#GtpcModSt {..} <- get
.....
sessParams <- return $ foldl ieInfo (SessionParams { imsi = Nothing
, mei = Nothing
, msisdn = Nothing
, senderFteidKey = Nothing
, senderIpV4Addr = Nothing
, senderIpV6Addr = Nothing
, pgwFteidKey = Nothing
, pgwIpV4Addr = Nothing
, pgwIpV6Addr = Nothing
, apn = Nothing
, paaPdnType = Nothing
, pco = Nothing
, bearerContext = []
, unDecodedIe = []
, unSupportedIe = []
}) $ msgIeList gtpMsg
ueApn <-return $ fromMaybe (throwE BadIe) (apn sessParams)
apnCfg <- return $ fromMaybe (throw BadIe) $ Map.lookup ueApn apnProfile
thisSndrFteidKey <-return $ fromMaybe (throw BadIe) (senderFteidKey sessParams)
I think that I should use throwE/catchE from Control.Monad.Trans.Except. However, throwE does not even compile when used with my transformer monad, as shown here:
apnCfg <- return $ fromMaybe (throw UnknownApn) $ Map.lookup ueApn apnProfile
Using throw from Control.Exception gets past the compilation stage but I am not sure it will work.
Should I not be using Exception in a transformer monad that has IO as its base?
I think that I should use throwE/catchE from Control.Monad.Trans.Except. However, throwE does not even compile when used with my transformer monad, as shown here:
apnCfg <- return $ fromMaybe (throw UnknownApn) $ Map.lookup ueApn apnProfile
Using throw from Control.Exception gets past the compilation stage but I am not sure it will work.
This can be solved by following the types. In your do-block, we have:
-- I won't use the synonym here, for the sake of explicitness:
return :: a -> StateT GtpcModSt (ExceptT GtpcExceptions IO) a
The type of throwE is:
throwE :: Monad m => e -> ExceptT e m a
That being so, what you want is:
apnCfg <- maybe (lift $ throwE UnknownApn) return $ Map.lookup ueApn apnProfile
Firstly, you only need return if you aren't throwing (maybe is more convenient than fromMaybe for expressing that). Secondly, throwE produces an ExceptT computation that you need to lift to the outer, StateT layer. You can make the lift implicit by using mtl instead of transformers directly. To do that, change your imports from...
import Control.Monad.Trans.State.Strict
import Control.Monad.Trans.Except
... to:
import Control.Monad.State.Strict
import Control.Monad.Except
Then you can simply write (using the throwError method from MonadError):
apnCfg <- maybe (throwError UnknownApn) return $ Map.lookup ueApn apnProfile

Memoizing and repeating IO monads

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

Nested ResourceT scopes within a conduit Sink

Is there a way to scope runResourceT to the lifetime of a single Sink?
I'm trying to build a Sink that wraps a potentially infinite number of Sinks. This works fine with threads but I'm trying to do it without threads. It seems like it should be possible. I've hit a road block due to the scoping of runResourceT: I get either too coarsely grained (but functional) or much too finely grained (totally broken) resource management.
{-# LANGUAGE FlexibleContexts #-}
import Control.Monad.Trans (lift)
import Control.Monad.Trans.Resource
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BC8 (pack)
import Data.Conduit
import qualified Data.Conduit.Binary as Cb
import qualified Data.Conduit.List as Cl
import System.FilePath ((<.>))
test :: IO ()
test =
runResourceT
$ Cl.sourceList (fmap (BC8.pack . show) [(1 :: Int)..1000])
$$ rotateResourceHog "/tmp/foo"
-- |
-- files are allocated on demand but handles are released at the same time
rotateResourceHog
:: MonadResource m
=> FilePath -> Sink ByteString m ()
rotateResourceHog filePath = step 0 where
step i = do
x <- Cl.peek
case x of
Just _ -> do
chunkWriter $ filePath <.> show (i :: Integer)
-- loop
step $ i+1
Nothing -> return ()
-- |
-- files are allocated on demand but handles are released immediately
rotateUsingClosedHandles
:: (MonadBaseControl IO m, MonadResource m)
=> FilePath -> Sink ByteString m ()
rotateUsingClosedHandles filePath = step 0 where
step i = do
x <- Cl.peek
case x of
Just _ -> do
transPipe runResourceT . chunkWriter $ filePath <.> show (i :: Integer)
-- loop
step $ i+1
Nothing -> return ()
chunkWriter
:: MonadResource m
=> FilePath -> Sink ByteString m ()
chunkWriter filePath = do
_ <- lift $ allocate (putStrLn "alloc") (\ _ -> putStrLn "free")
-- the actual conduit chain is more complicated
Cl.isolate 100 =$= Cb.sinkFile filePath
ResourceT is only intended to clean up resources in exceptional cases. It is not intended to provide prompt finalization, only guaranteed finalization. For promptness, conduit provides its own facilities for handling cleanup. In your case, you're looking for both: you want cleanup to happen as early as possible, and to occur even in the case of an exception being thrown. For this, you should use bracketP. For example:
chunkWriter
:: MonadResource m
=> FilePath -> Sink ByteString m ()
chunkWriter filePath = bracketP
(putStrLn "alloc")
(\() -> putStrLn "free")
(\() -> Cl.isolate 100 =$= Cb.sinkFile filePath)
This results in the desired interleaving of alloc and free outputs.

How to catch an exception inside runResourceT

I would like to catch an exception inside runResourceT without releasing the resource, but the function catch runs the computation inside IO. Is there a way to catch an exception inside runResourceT, or what is the recommended way to refactor the code ?
Thank you for your help.
{-# LANGUAGE FlexibleContexts #-}
module Main where
import Control.Exception as EX
import Control.Monad.IO.Class
import Control.Monad.Trans.Resource
type Resource = String
allocResource :: IO Resource
allocResource = let r = "Resource"
in putStrLn (r ++ " opened.") >> return r
closeResource :: Resource -> IO ()
closeResource r = putStrLn $ r ++ " closed."
withResource :: ( MonadIO m
, MonadBaseControl IO m
, MonadThrow m
, MonadUnsafeIO m
) => (Resource -> ResourceT m a) -> m a
withResource f = runResourceT $ do
(_, r) <- allocate allocResource closeResource
f r
useResource :: ( MonadIO m
, MonadBaseControl IO m
, MonadThrow m
, MonadUnsafeIO m
) => Resource -> ResourceT m Int
useResource r = liftIO $ putStrLn ("Using " ++ r) >> return 1
main :: IO ()
main = do
putStrLn "Start..."
withResource $ \r -> do
x <- useResource r
{-- This does not compile as the catch computation runs inside IO
y <- liftIO $ EX.catch (useResource r)
(\e -> do putStrLn $ show (e::SomeException)
return 0)
--}
return ()
putStrLn "Done."
ResourceT is an instance of MonadBaseControl from the monad-control package, which is designed for lifting control structures like forkIO and catch into transformed monads.
The lifted-base package, which is built on top of monad-control, contains modules with versions of standard control structures that work in any MonadBaseControl. For exception handling, you can use the functions in the Control.Exception.Lifted module. So, just import qualified Control.Exception.Lifted as EX1 instead, and your code should work fine.
1 Note the qualified here; quite confusingly, import A as B actually imports all of the definitions in A into scope, and simply defines B as an alias for the module! You need to use qualified to ensure that the definitions are not brought into scope, and are instead accessed exclusively through the B alias.
As an alternative approach, you can use the MonadCatch instance of ResourceT, found in the exceptions package. You simply need to substitute the generalized version of catch from Control.Monad.Catch:
import Control.Monad.Catch
…
main = do
…
withResource $ \r -> do
…
y <- Control.Monad.Catch.catch (useResource r) (\e -> …)

Resources