Using Exceptions in Transformer Monad - haskell

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

Related

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

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

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

Error check within do block in Haskell

i have the following set of actions:
action1 :: IO Bool
action2 :: IO Bool
action3 :: IO Bool
some actions are just composition of another actions
complexAction = do
action1
action2
action3
What i need is the construction that checks result of each action and returns False in a case of false. I can do it manually but i know for sure that haskell does have tools to get rid of that kind of boilerplate.
The simplest way is
complexAction = fmap and (sequence [action1, action2, action3])
But you could also write your own combinator to stop after the first action:
(>>/) :: Monad m => m Bool -> m Bool -> m Bool
a >>/ b = do
yes <- a
if yes then b else return False
You'd want to declare the fixity to make it associative
infixl 1 >>/
Then you can do
complexAction = action1 >>/ action2 >>/ action3
I'd suggest you to use MaybeT monad transformer instead. Using it has many advantages over just returning IO Bool:
Your actions can have different types and return values (not just true/false). If you don't need any results, just use MaybeT IO ().
Later ones can depend on results of preceding ones.
Since MaybeT produces monads that are instances of MonadPlus, you can use all monad plus operations. Namely mzero for a failed action and x mplus y, which will run y iff x fails.
A slight disadvantage is that you have to lift all IO actions to MaybeT IO. This can be solved by writing your actions as MonadIO m => ... -> m a instead of ... -> IO a.
For example:
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans
import Control.Monad.Trans.Maybe
-- Lift print and putStrLn
print' :: (MonadIO m, Show a) => a -> m ()
print' = liftIO . print
putStrLn' :: (MonadIO m) => String -> m ()
putStrLn' = liftIO . putStrLn
-- Add something to an argument
plus1, plus3 :: Int -> MaybeT IO Int
plus1 n = print' "+1" >> return (n + 1)
plus3 n = print' "+3" >> return (n + 3)
-- Ignore an argument and fail
justFail :: Int -> MaybeT IO a
justFail _ = mzero
-- This action just succeeds with () or fails.
complexAction :: MaybeT IO ()
complexAction = do
i <- plus1 0
justFail i -- or comment this line out <----------------<
j <- plus3 i
print' j
-- You could use this to convert your actions to MaybeT IO:
boolIOToMaybeT :: IO Bool -> MaybeT IO ()
boolIOToMaybeT x = do
r <- lift x
if r then return () else mzero
-- Or you could have even more general version that works with other
-- transformers as well:
boolIOToMaybeT' :: (MonadIO m, MonadPlus m) => IO Bool -> m ()
boolIOToMaybeT' x = do
r <- liftIO x
if r then return () else mzero
main :: IO ()
main = runMaybeT complexAction >>= print'
As Petr says, for anything but a narrow and contained case, you're almost certainly better off wiring your code for proper error handling from the outset. I know I've often regretted not doing this, condemning myself to some very tedious refactoring.
If I may, I'd like to recommend Gabriel Gonzalez's errors package, which imposes a little more coherence on Haskell's various error-handling mechanisms than has been traditional. It allows you to plumb Eithers through your code, and Either is a good type for capturing errors. (By contrast, Maybe will lose information on the error side.) Once you've installed the package, you can write things like this:
module Errors where
import Control.Error
import Data.Traversable (traverse)
data OK = OK Int deriving (Show)
action1, action2, action3 :: IO (Either String OK)
action1 = putStrLn "Running action 1" >> return (Right $ OK 1)
action2 = putStrLn "Running action 2" >> return (Right $ OK 2)
action3 = putStrLn "Running action 3" >> return (Left "Oops on 3")
runStoppingAtFirstError :: [IO (Either String OK)] -> IO (Either String [OK])
runStoppingAtFirstError = runEitherT . traverse EitherT
...with output like
*Errors> runStoppingAtFirstError [action1, action2]
Running action 1
Running action 2
Right [OK 1,OK 2]
*Errors> runStoppingAtFirstError [action1, action3, action2]
Running action 1
Running action 3
Left "Oops on 3"
(But note that the computation here stops at the first error and doesn't soldier on until the bitter end -- which might not be what you had wanted. The errors package is certainly wide-ranging enough that many other variations are possible.)

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 -> …)

Is there a better way to implement a multi-channel Writer monad in Haskell?

Problem:
I need to compose writer monads of different types in the same Haskell monad transformer stack. Besides using tell to write debug messages I'd also like to use it to write some other data type, e.g. data packets to be transmitted in some other context.
I've checked Hackage for a channelized writer monad. What I was hoping to find was a writer-like monad that supports multiple data types, each representing a distinct "logical" channel in the runWriter result. My searches didn't turn up anything.
Solution Attempt 1:
My first approach at solving the problem was to stack WriterT twice along these lines:
type Packet = B.ByteString
newtype MStack a = MStack { unMStack :: WriterT [Packet] (WriterT [String] Identity) a }
deriving (Monad)
However, I ran into problems when declaring MStack as an instance of both MonadWriter [Packet] and MonadWriter [String]:
instance MonadWriter [String] MStack where
tell = Control.Monad.Writer.tell
listen = Control.Monad.Writer.listen
pass = Control.Monad.Writer.pass
instance MonadWriter [Packet] MStack where
tell = lift . Control.Monad.Writer.tell
listen = lift . Control.Monad.Writer.listen
pass = lift . Control.Monad.Writer.pass
Subsequent complaints from ghci:
/Users/djoyner/working/channelized-writer/Try1.hs:12:10:
Functional dependencies conflict between instance declarations:
instance MonadWriter [String] MStack
-- Defined at /Users/djoyner/working/channelized-writer/Try1.hs:12:10-36
instance MonadWriter [Packet] MStack
-- Defined at /Users/djoyner/working/channelized-writer/Try1.hs:17:10-36
Failed, modules loaded: none.
I understand why this approach is not valid as shown here but I couldn't figure out a way around the fundamental issues so I abandoned it altogether.
Solution Attempt 2:
Since it appears there can only be a single WriterT in the stack, I'm using a wrapper type over Packet and String and hiding the fact in the utility functions (runMStack, tellPacket, and tellDebug below). Here's the complete solution that does work:
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
import Control.Monad.Identity
import Control.Monad.Writer
import qualified Data.ByteString as B
type Packet = B.ByteString
data MStackWriterWrapper = MSWPacket Packet
| MSWDebug String
newtype MStack a = MStack { unMStack :: WriterT [MStackWriterWrapper] Identity a }
deriving (Monad, MonadWriter [MStackWriterWrapper])
runMStack :: MStack a -> (a, [Packet], [String])
runMStack act = (a, concatMap unwrapPacket ws, concatMap unwrapDebug ws)
where (a, ws) = runIdentity $ runWriterT $ unMStack act
unwrapPacket w = case w of
MSWPacket p -> [p]
_ -> []
unwrapDebug w = case w of
MSWDebug d -> [d]
_ -> []
tellPacket = tell . map MSWPacket
tellDebug = tell . map MSWDebug
myFunc = do
tellDebug ["Entered myFunc"]
tellPacket [B.pack [0..255]]
tellDebug ["Exited myFunc"]
main = do
let (_, ps, ds) = runMStack myFunc
putStrLn $ "Will be sending " ++ (show $ length ps) ++ " packets."
putStrLn "Debug log:"
mapM_ putStrLn ds
Yay, compiles and works!
Solution Non-Attempt 3:
It also occurred to me that this might be a time when I'd roll my own, also including error, reader, and state monad functionality that needs be present in my actual application's transformer stack type. I didn't attempt this.
Question:
Although solution 2 works, is there a better way?
Also, could a channelized writer monad with a variable number of channels be generically implemented as a package? It would seem like that would be a useful thing and I'm wondering why it doesn't already exist.
The output of the Writer monad needs to be a Monoid, but luckily tuples of monoids are monoids too! So this works:
import Control.Monad.Writer
import qualified Data.ByteString as B
import Data.Monoid
type Packet = B.ByteString
tellPacket xs = tell (xs, mempty)
tellDebug xs = tell (mempty, xs)
myFunc :: Writer ([Packet], [String]) ()
myFunc = do
tellDebug ["Entered myFunc"]
tellPacket [B.pack [0..255]]
tellDebug ["Exited myFunc"]
main = do
let (_, (ps, ds)) = runWriter myFunc
putStrLn $ "Will be sending " ++ (show $ length ps) ++ " packets."
putStrLn "Debug log:"
mapM_ putStrLn ds
For the record, it is possible to stack two WriterT's on top of each other:
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
import Control.Monad.Writer
import Control.Monad.Identity
import qualified Data.ByteString as B
type Packet = B.ByteString
newtype MStack a = MStack { unMStack :: WriterT [Packet] (WriterT [String] Identity) a }
deriving (Functor, Applicative, Monad)
tellDebug = MStack . lift . Control.Monad.Writer.tell
tellPacket = MStack . Control.Monad.Writer.tell
runMStack m =
let ((a, ps), ds) = (runIdentity . runWriterT . runWriterT . unMStack) m
in (a, ps, ds)
myFunc = do
tellDebug ["Entered myFunc"]
tellPacket [B.pack [0..255]]
tellDebug ["Exited myFunc"]
main = do
let (_, ps, ds) = runMStack myFunc
putStrLn $ "Will be sending " ++ (show $ length ps) ++ " packets."
putStrLn "Debug log:"
mapM_ putStrLn ds

Resources