I'm playing around with the leveldb bindings.
I'm wondering if it's possible to take a function like
MonadResource m => a -> m b
And convert it to
MonadResource m => m (a -> IO b))
It can definitely be done, but it's dangerous. Let's demonstrate first the how, by extracting the internal state of the ResourceT:
import Control.Monad.IO.Class
import Control.Monad.Trans.Resource
import Control.Monad.Trans.Resource.Internal
data Foo = Foo Int
deriving Show
getFoo :: MonadResource m => Int -> m Foo
getFoo i = fmap snd $ allocate
(do
putStrLn $ "allocating Foo with " ++ show i
return $ Foo i)
(\(Foo x) -> putStrLn $ "Freeing Foo " ++ show x)
stripLayer :: MonadResource m => (a -> ResourceT IO b) -> m (a -> IO b)
stripLayer f = do
is <- liftResourceT getInternalState
return $ \a -> runInternalState (f a) is
main :: IO ()
main = do
getFoo' <- runResourceT $ stripLayer $ getFoo
getFoo' 42 >>= print
Unfortunately the output from this isn't what we'd hope for:
allocating Foo with 42
Foo 42
Notice how the "Freeing" line is never called. This is because, by the time we use getFoo', the runResourceT call has already exited, which is how we guarantee that all resources are freed. You can safely get away with this trick if you're disciplined and make sure everything lives inside the runResourceT call, but the type system won't help you. To see what this will look like:
main :: IO ()
main = runResourceT $ do
getFoo' <- stripLayer $ getFoo
liftIO $ getFoo' 42 >>= print
Related
Consider the following program.
import Control.Monad.State
import Control.Monad.Catch
ex1 :: StateT Int IO ()
ex1 = do
modify (+10)
liftIO . ioError $ userError "something went wrong"
ex2 :: StateT Int IO ()
ex2 = do
x <- get
liftIO $ print x
ex3 :: StateT Int IO ()
ex3 = ex1 `onException` ex2
main :: IO ()
main = evalStateT ex3 0
When we run the program we get the following output.
$ runhaskell Test.hs
0
Test.hs: user error (something went wrong)
However, I expected the output to be as follows.
$ runhaskell Test.hs
10
Test.hs: user error (something went wrong)
How do I preserve the intermediate state in ex1 in the exception handler ex2?
Use an IORef (or MVar or TVar or whatever) instead.
newtype IOStateT s m a = IOStateT { unIOStateT :: ReaderT (IORef s) m a }
deriving (Functor, Applicative, Monad, MonadTrans, MonadIO)
-- N.B. not MonadReader! you want that instance to pass through,
-- unlike ReaderT's instance, so you have to write the instance
-- by hand
runIOStateT :: IOStateT s m a -> IORef s -> m a
runIOStateT = runReaderT . unIOStateT -- or runIOStateT = coerce if you're feeling cheeky
instance MonadIO m => MonadState s (IOStateT s m) where
state f = IOStateT $ do
ref <- ask
liftIO $ do
s <- readIORef ref
let (a, s') = f s
writeIORef ref s'
pure a
This feels like a pattern I've seen enough times that there ought to be a Hackage package for it, but I don't know of one.
I am attempting to build a slackbot using this library: https://hackage.haskell.org/package/slack-api, just to learn a little bit more haskell, and hopefully, finally understand monads -_-.
I then have the following types:
data BotState = BotState
{
_appState :: AppState
}
makeLenses ''BotState
type AppState = HM.Map String ChannelState
emptyState :: AppState
emptyState = HM.empty
data ChannelState = ChannelState
{ _counter :: Int}
type Bot = Slack.Slack BotState
and I run my bot with:
initApp = lookupEnv "SLACK_API_TOKEN" >>=
\apiToken -> case apiToken of
Nothing -> throwM ApiTokenMissingException
Just t -> void $ Slack.runBot (Slack.SlackConfig t) runApp $ BotState emptyState
where:
runApp :: Slack.Event -> Bot ()
runApp m#(Slack.Message cid uid body _ _ _) = sendMessage cid "GAH I CAN HAZ CHZBURGHER!"
This runs fine, now I wish to add the ability to update the system state (by incrementing the counter, or in other ways).
so I add a modifyState function to my Bot:
modifyState :: (AppState -> AppState) -> Bot ()
modifyState f = uses Slack.userState $ view appState >>=
\state -> modifying Slack.userState $ set appState $ f state
This breaks with:
No instance for (Control.Monad.State.Class.MonadState
(Slack.SlackState BotState) ((->) BotState))
arising from a use of ‘modifying’
In the expression: modifying Slack.userState
In the expression:
modifying Slack.userState $ set appState $ f state
In the second argument of ‘(>>=)’, namely
‘\ state -> modifying Slack.userState $ set appState $ f state’
Which makes sense given the signature for modifying:
modifying :: MonadState s m => ASetter s s a b -> (a -> b) -> m ()
However, upon looking at the documentation for Slack.userState:
userState :: forall s s. Lens (SlackState s) (SlackState s) s s Source
And then:
data SlackState s
... Constructor ...
Instances
Show s => Show (SlackState s)Source
MonadState (SlackState s) (Slack s)Source
So then why isn't the BotState already an instance of MonadState? How could I fix this?
$ operator has fixity 0, while >>= has fixity 1, so code like this would work:
main :: IO ()
main = do
putStrLn "hello world" >>= \_ -> putStrLn "hi"
But not this one:
main :: IO ()
main = do
putStrLn $ "hello world" >>= \_ -> putStrLn "hi"
It's being interpreted as:
main :: IO ()
main = do
putStrLn ("hello world" >>= \_ -> putStrLn "hi")
To see fixity info, use ghci's :info command:
:info $
($) ::
forall (r :: ghc-prim-0.5.0.0:GHC.Types.RuntimeRep) a (b :: TYPE
r).
(a -> b) -> a -> b
-- Defined in ‘GHC.Base’
infixr 0 $
:info >>=
class Applicative m => Monad (m :: * -> *) where
(>>=) :: m a -> (a -> m b) -> m b
...
-- Defined in ‘GHC.Base’
infixl 1 >>=
Also, if you're not sure, good old parentheses are always here for the rescue :)
I am currently playing with the Bryan O'Sullivan's resource-pool library and have a question regarding extending the withResource function.
I want to change the signature of the withResource function from (MonadBaseControl IO m) => Pool a -> (a -> m b) -> m b to (MonadBaseControl IO m) => Pool a -> (a -> m (Bool, b)) -> m b.
What I want to achieve is, that the action should return (Bool, b) tuple, where the boolean value indicates if the borrowed resource should
be put back into the pool or destroyed.
Now my current implementation looks like this:
withResource :: forall m a b. (MonadBaseControl IO m) => Pool a -> (a -> m (Bool, b)) -> m b
{-# SPECIALIZE withResource :: Pool a -> (a -> IO (Bool,b)) -> IO b #-}
withResource pool act = fmap snd result
where
result :: m (Bool, b)
result = control $ \runInIO -> mask $ \restore -> do
resource <- takeResource pool
ret <- restore (runInIO (act resource)) `onException`
destroyResource pool resource
void . runInIO $ do
(keep, _) <- restoreM ret :: m (Bool, b)
if keep
then liftBaseWith . const $ putResource pool resource
else liftBaseWith . const $ destroyResource pool resource
return ret
And I have a feeling, that this is not how it is supposed to look like...
Maybe I am not using the MonadBaseControl API right.
What do you guys think of this and how can I improve it to be more idiomatic?
I have a feeling that there is a fundamental problem with this approach. For monads for which StM M a is equal/isomorphic to a it will work. But for other monads there will be a problem. Let's consider MaybeT IO. An action of type a -> MaybeT IO (Bool, b) can fail, so there will be no Bool value produced. And the code in
void . runInIO $ do
(keep, _) <- restoreM ret :: m (Bool, b)
...
won't be executed, the control flow will stop at restoreM. And for ListT IO it'll be even worse, as putResource and destroyResource will be executed multiple times. Consider this sample program, which is a simplified version of your function:
{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, RankNTypes, TupleSections #-}
import Control.Monad
import Control.Monad.Trans.Control
import Control.Monad.Trans.List
foo :: forall m b . (MonadBaseControl IO m) => m (Bool, b) -> m b
foo act = fmap snd result
where
result :: m (Bool, b)
result = control $ \runInIO -> do
ret <- runInIO act
void . runInIO $ do
(keep, _) <- restoreM ret :: m (Bool, b)
if keep
then liftBaseWith . const $ putStrLn "return"
else liftBaseWith . const $ putStrLn "destroy"
return ret
main :: IO ()
main = void . runListT $ foo f
where
f = msum $ map (return . (, ())) [ False, True, False, True ]
It'll print
destroy
return
destroy
return
And for an empty list, nothing gets printed, which means no cleanup would be called in your function.
I have to say I'm not sure how to achieve your goal in a better way. I'd try to explore in the direction of signature
withResource :: forall m a b. (MonadBaseControl IO m)
=> Pool a -> (a -> IO () -> m b) -> m b
where the IO () argument would be a function, that when executed, invalidates the current resource and marks it to be destroyed. (Or, for better convenience, replace IO () with lifted m ()). Then internally, as it's IO-based, I'd just create a helper MVar that'd be reset by calling
the function, and at the end, based on the value, either return or destroy the resource.
I am trying to follow the advice given in Combine state with IO actions for building up an AppState along with an IO monad. What I've gotten is this:
module Main where
import Control.Monad.State
import Control.Monad.Trans
data ST = ST [Integer] deriving (Show)
type AppState = StateT ST IO
new = ST []
append :: Integer -> State ST ()
append v = state $ \(ST lst) -> ((), ST (lst ++ [v]))
sumST :: State ST Integer
sumST = state $ \(ST lst) -> (sum lst, ST lst)
script = do
append 5
append 10
append 15
sumST
myMain :: AppState ()
myMain = do
liftIO $ putStrLn "myMain start"
let (res, st) = runState script new
liftIO $ putStrLn $ show res
liftIO $ putStrLn "myMain stop"
main = runStateT myMain (ST [15])
There's some part of this I'm not getting. It bothers me greatly that I have script and myMain and main. It also bothers me that I have to execute runState within myMain and that I have to feed an initial state into runStateT in my main function. I'm wanting to have my "script", so to speak, directly in the myMain function because the entire point of myMain is to be able to run the append and sum directly in myMain and right next to the print operations. I think I should be able to do this, instead:
myMain :: AppState ()
myMain = do
liftIO $ putStrLn "myMain start"
append 5
append 10
append 15
r <- sumST
liftIO $ putStrLn $ show res
liftIO $ putStrLn "myMain stop"
main = runState myMain
I had thought that the point of the monad transformer was so I can execute my State monad operations in a function (like above) and lift IO operations into that function. What is the right way to set all of this up so that I can remove one of the layers of indirection?
In addition to Daniel's solution (which I have flagged the solution), I have also found a few variations that might also shed some light on the situation. First, the final implementation of myMain and main:
myMain :: AppState ()
myMain = do
liftIO $ putStrLn "myMain start"
append 5
append 10
append 15
res <- sumST
liftIO $ putStrLn $ show res
liftIO $ putStrLn "myMain stop"
main = runStateT myMain new
Now, various implementations of append and sumST, in addition to Daniel's:
append :: Integer -> AppState ()
append v = state $ \(ST lst) -> ((), ST (lst ++ [v]))
sumST :: AppState Integer
sumST = state $ \(ST lst) -> (sum lst, ST lst)
and (note that only the type declaration changes; in fact you can omit the type declaration completely!)
append :: MonadState ST m => Integer -> m ()
append v = state $ \(ST lst) -> ((), ST (lst ++ [v]))
sumST :: MonadState ST m => m Integer
sumST = state $ \(ST lst) -> (sum lst, ST lst)
It occurred to me that the AppState/StateT monad is not the same as the basic State monad, and I was coding both sumST and append for the State monad. In a sense, they also had to be lifted into the StateT monad, though the correct way of thinking of in is that they had to be run in the monad (hence, runState script new).
I'm not sure I completely get it, but I will work with it for a while, read the MonadState code, and write something about this when it finally works in my head.
The problem is that you made your append and sumST functions too monomorphic! Instead of directly using the state function, you should use the more polymorphic get and put functions, so that you can give them the more exciting types
append :: MonadState ST m => Integer -> m ()
append v = do
ST lst <- get
put (ST (lst ++ [v]))
sumST :: MonadState ST m => m Integer
sumST = do
ST lst <- get
return (sum lst)
Then you can write exactly the myMain you proposed (though you'll still have to give an initial state in main).
As a stylistic thing, I would propose not defining a new ST type: there are lots of functions that do handy things with lists, and making them impossible to use by imposing a ST constructor in between you and the lists can be annoying! If you use [Integer] as your state type instead, you can make definitions like this:
prepend :: MonadState [Integer] m => Integer -> m ()
prepend = modify . (:)
sumST :: MonadState [Integer] m => m Integer
sumST = gets sum
Looks pretty nice, no? =)
I have trouble gripping to monads and monad transformers. I have the
following contrived example (not compilable):
import Control.Monad
import Control.Monad.Error
import Control.Monad.Reader
data State = State Int Int Int
type Foo = ReaderT State IO
readEither :: String -> Either String Int
readEither s = let p = reads s
in case p of
[] -> throwError "Could not parse"
[(a, _)] -> return a
readEitherT :: IO (Either String Int)
readEitherT = let p s = reads s
in runErrorT $ do
l <- liftIO (getLine)
readEither l
foo :: Foo Int
foo = do
d <- liftIO $ readEitherT
case d of
Right dd -> return dd
Left em -> do
liftIO $ putStrLn em
return (-1)
bar :: Foo String
bar = do
liftIO $ getLine
defaultS = State 0 0 0
If I copy the functionality of readEither to readEitherT, it works, but I
have a nagging feeling that I can leverage the power of the existing
readEither function, but I can't figure out how. If I try to lift the
readEither in the readEitherT function, it lifts it to ErrorT String IO
(Either String Int) as it should. But I should somehow get it to ErrorT
String IO Int.
If I'm going to the wrong direction with this, what is the correct way to
handle errors which require IO (or other monads) and are to be called from
monadic context (see the foo function in the example)
Edit:
Apparently it was not clear what I was trying to do. Maybe the following function describes what and why I was wondering
maybePulseQuit :: Handle -> IO (Either String ())
maybePulseQuit h = runErrorT $ do
f <- liftIO $ (communicate h "finished" :: IO (Either String Bool))
(ErrorT . pure) f >>= \b → liftIO $ when b $ liftIO pulseQuit
This works, but is still ugly because of the binds. This is a lot clearer than the previous version which had case checking. Is this the recommended way to do this?
It is not clear why you need ErrorT. You can implement readEitherT like
readEitherT :: IO (Either String Int)
readEitherT = fmap readEither getLine
If you really need ErrorT for some reason, then you can create utility function eitherToErrorT:
eitherToErrorT = ErrorT . pure
readEitherT = runErrorT $ do
l <- liftIO $ getLine
eitherToErrorT $ readEither l
[ADD]
Maybe you just want to add ErrorT into your monad stack...
data State = State Int Int Int
type Foo = ErrorT String (ReaderT State IO)
runFoo :: Foo a -> State -> IO (Either String a)
runFoo foo s = runReaderT (runErrorT foo) s
doIt :: Int -> Foo Int
doIt i = if i < 0
then throwError "i < 0"
else return (i * 2)
Example:
*Main> runFoo (doIt 1 >>= doIt) (State 0 0 0)
Right 4
*Main> runFoo (doIt (-1) >>= doIt) (State 0 0 0)
Left "i < 0"