Converting a monadic value to an IO in Polysemy - haskell

I am trying to build an automated feature testing suite using webdriver and polysemy in Haskell. I've gotten as far as defining proper effects and interpreting them into a webdriver WD monad, but now I'm stuck.
I have a value of type Member BrowserMaster r => Sem r () where BrowserMaster is my custom capability.
And this is the interpreter:
runBrowserMaster :: Members [Embed WD.WD, Embed IO] r => Sem (BrowserMaster ': r) a -> Sem r a
runBrowserMaster = interpret $ \case
ClickElement bmSelector ->
let action = (WD.findElem (bmSelectoToSelector bmSelector) >>= WD.click :: WD.WD ())
in embed action
{- ... -}
Now I'm wondering how to convert the Embed WD.WD effect into Embed IO, so that I end up with just one.
I tried to craft an interpreter:
runWebDriver :: Member (Embed IO) r => Sem (Embed WD.WD ': r) a -> Sem r a
runWebDriver = interpret $
\a -> embed $ runSession chromeConfig . finallyClose $ do
setImplicitWait 60000
setWindowSize (1024, 768)
unEmbed a
(Here runSession chromeConfig . finallyClose is a WD a -> IO a)
It does work, but it seems to fire up a new browser session for each of the commands instead of starting it just once, doing everything within and closing.
I have an intuition that it has to do something with resource acquisition and release, but I just cannot get my head around this to be able to put it all together.

Keep in mind that each interpreter will be executed each time an action of the BrowserMaster effect is executed. So every time it runs the runWebDriver interpreter, which explains why it creates, runs and close the session.
I think what you want to do is instead to create/delete the session once, and execute your whole code in this session.
Also, since WD is already a wrapper around IO, I think it's unnecessary to embed both effects.
I am not familiar with your code nor the webdriver library, but I assume this would be something along the lines of:
main :: IO ()
main = runSession chromeConfig . finallyClose $ do
setImplicitWait 60000
setWindowSize (1024, 768)
runM . runBrowserMaster $ myBusinessCode
runBrowserMaster :: Member (Embed WD.WD) r => Sem (BrowserMaster ': r) a -> Sem r a
runBrowserMaster = interpret $ \case
ClickElement bmSelector ->
let action = (WD.findElem (bmSelectoToSelector bmSelector) >>= WD.click :: WD.WD ())
in embed action
{- ... -}
Note: If you need to run some IO code in the interpreter, use liftIO to make it an WD action instead, e.g. liftIO $ putStrLn "Hello world".
PS: I recommend renaming the runBrowserMaster interpreter to something like browserMasterToWD as it better represents what it does: interpret the BrowserMaster effect in terms of an WD action.

Related

Streaming of a resource with proper acquisition and release

This is a question about the Haskell streaming library.
Stream (Of a) m r is a "stream of individual Haskell values derived from actions in some monad m and returning a value of type r". Streaming.Prelude defines many useful functions that allow nice streaming applications:
import qualified Streaming.Prelude as S
S.print $ do
S.yield "a"
S.yield "b"
S.yield "c"
The tutorial is good for getting started.
Now, the particular issue at hand is how to use this framework with a monad that requires careful instantiation and release of resources. The streaming-with package seems to be the right candidate, it has a function
bracket :: MonadMask m => m a -> (a -> m c) -> (a -> m b) -> m b
that acquires (m a), releases (a->m c) and uses (a->m b) a resource. All three actions are encapsulated in the returned m b. withFile is a good example for how to use this:
withFile :: FilePath -> IOMode -> (Handle -> m r) -> m r
withFile fp md = bracket (liftIO (openFile fp md)) (liftIO . hClose)
Acquisition and release of the handle are nicely sandwiching the usage Handle->m r.
But: I absolutely do not see how this should be used with Stream (Of a) m r. I have to provide an a->m b and I get a m b. How is this supposed to be connected so that I obtain a Stream?
To figure this out, let's play with withFile:
import System.IO
use :: Handle -> IO (S.Stream (Of String) IO ())
use = return . S.repeatM . hGetLine
main :: IO ()
main = do
str <- S.withFile "input.dat" ReadMode use
S.print str
but that results in hGetLine: illegal operation (handle is closed). That actually makes sense, by the time S.print str is called withFile has already acquired and released the handle.
So let's move the stream consumption inside the use function:
use :: Handle -> IO ()
use h = do
S.print $ S.repeatM (hGetLine h)
and that gives a hGetLine: invalid argument (invalid byte sequence). I'm not quite sure what this error means. An isEOFError would be acceptable, but 'invalid byte sequence'? In any case, this doesn't work either.
I'm running out of ideas... How is this done?
The withFile is just a toy example, the question is really about how to correctly create and consume a stream inside a bracket.
let's move the stream consumption inside the use function
This is indeed the right approach.
I'm actually getting a proper hGetLine: end of file when running the example code. The problem is that S.repeatM (hGetLine h) never bothers to check if it has reached then end of the file, and throws an exception when it bumps into it.
The following definition of use doesn't have that problem:
use :: Handle -> IO ()
use h = do
S.print $ S.untilRight $ do eof <- System.IO.hIsEOF h
if eof then Right <$> pure ()
else Left <$> hGetLine h
It uses the untilRight function.

Can I take "snapshots" for the IO Monad?

I am currently writing an FRP library built on Arrows (namely, timeless). However, I encountered a problem:
If I wrap an IO action inside the arrow, (Signal s IO a b in this case, which is a Kleisli arrow), I would like to take a "snapshot" of the final returned value, instead of running the action every time. For example, I have an action involving reading a file and parsing into some data structure, and currently this action is running every frame of update. I tried a bit to make use of Haskell's lazy evaluation to prevent it from running again and again, but it did not work.
Conceptually, Signal is basically (but not exactly)
a -> IO (b, Signal)
Each update, the signal itself is replaced by the new signal. Now, I think if I feed an IO action with type IO a in (using Kleisli arrows), I can somehow replace the Signal with something else that holds the final result of the previous action. However, I cannot find a way to do it because I can't extract anything from IO, and simply replacing the signal to a constant one doesn't seem to stop the action from being reevaluated.
This is a minimal test program:
{-# LANGUAGE Arrows #-}
module Main where
import FRP.Timeless
import Debug.Trace
s1 :: (Monad m) => Signal s m a Int
s1 = mkConst $ trace "Signal 1" $ Just 5
s2 :: (Monad m) => Signal s m Int Int
s2 = arr $ trace "Signal 2" (+1)
s3 :: (Monad m) => Signal s m a ()
s3 = arr $ \_ -> ()
sc = mkKleisli_ $ \_ -> do
putStrLn "SC"
readFile "test.txt"
sp = mkKleisli_ putStrLn
box :: Signal s IO () ()
box = proc _ -> do
file <- sc -< ()
sp -< file
returnA -< ()
box2 = proc _ -> do
box -< ()
main = do
runBox clockSession_ box2
Here, sc reads a file "Test.txt". It is evaluated every time. I would like to find a way to evaluate only once, and keep the value.
BTW, unsafePerformIO would probably work, but, as its name suggests, it is probably "unsafe", so I don't want to use it
OK, I think I get it work by adding this signal:
onceSwitch = mkPureN $ (\_ -> (Just (), mkEmpty))
I generalized the switch to the following function (and added to Prefab of timeless):
occursFor :: b -> Int -> Signal s m a b
occursFor b n
| n == 0 = mkEmpty
| n > 0 = mkPureN $ \_ -> (Just b, occursFor b $ n-1)
| otherwise = error "[ERROR] occursFor: Nothing occurs for less than zero times!"
Whose output is () for the first time it is run, then inhibits, and this signal:
onceIO = SGen $ f
where
f _ ma = return (ma, SArr $ const ma)
Which becomes a constant after first run. Chaining an IO action like this:
file <- onceIO <<< sc <<< () `occursFor` 1 -< ()
seems to work intended. (Updated: now uses occursFor)
After tweaking around, it looks like this. Notice that the API of timeless will change violently as I develop, but it is likely that the functions I use underneath will not change. Anyway, the same thing applies to netwire, which is the origin of timeless, with some minor changes. If you need to make some applications, use that for now.
{-# LANGUAGE Arrows #-}
module Main where
import FRP.Timeless
import Debug.Trace
sc = mkKleisli_ $ \_ -> do
putStrLn "SC"
return "A"
sp = mkKleisli_ putStrLn
box :: Signal s IO () ()
box = proc _ -> do
file <- snapOnce <<< sc <<< inhibitsAfter 1 -< ()
sp -< file
returnA -< ()
box2 = proc _ -> do
box -< ()
main = do
runBox clockSession_ box2

Abstraction for monadic recursion with "unless"

I'm trying to work out if it's possible to write an abstraction for the following situation. Suppose I have a type a with function a -> m Bool e.g. MVar Bool and readMVar. To abstract this concept out I create a newtype wrapper for the type and its function:
newtype MPredicate m a = MPredicate (a,a -> m Bool)
I can define a fairly simple operation like so:
doUnless :: (Monad m) => Predicate m a -> m () -> m ()
doUnless (MPredicate (a,mg)) g = mg a >>= \b -> unless b g
main = do
b <- newMVar False
let mpred = MPredicate (b,readMVar)
doUnless mpred (print "foo")
In this case doUnless would print "foo". Aside: I'm not sure whether a type class might be more appropriate to use instead of a newtype.
Now take the code below, which outputs an incrementing number then waits a second and repeats. It does this until it receives a "turn off" instruction via the MVar.
foobar :: MVar Bool -> IO ()
foobar mvb = foobar' 0
where
foobar' :: Int -> IO ()
foobar' x = readMVar mvb >>= \b -> unless b $ do
let x' = x + 1
print x'
threadDelay 1000000
foobar' x'
goTillEnter :: MVar Bool -> IO ()
goTillEnter mv = do
_ <- getLine
_ <- takeMVar mv
putMVar mv True
main = do
mvb <- newMVar False
forkIO $ foobar mvb
goTillEnter mvb
Is it possible to refactor foobar so that it uses MPredicate and doUnless?
Ignoring the actual implementation of foobar' I can think of a simplistic way of doing something similar:
cycleUnless :: x -> (x -> x) -> MPredicate m a -> m ()
cycleUnless x g mp = let g' x' = doUnless mp (g' $ g x')
in g' $ g x
Aside: I feel like fix could be used to make the above neater, though I still have trouble working out how to use it
But cycleUnless won't work on foobar because the type of foobar' is actually Int -> IO () (from the use of print x').
I'd also like to take this abstraction further, so that it can work threading around a Monad. With stateful Monads it becomes even harder. E.g.
-- EDIT: Updated the below to show an example of how the code is used
{- ^^ some parent function which has the MVar ^^ -}
cycleST :: (forall s. ST s (STArray s Int Int)) -> IO ()
cycleST sta = readMVar mvb >>= \b -> unless b $ do
n <- readMVar someMVar
i <- readMVar someOtherMVar
let sta' = do
arr <- sta
x <- readArray arr n
writeArray arr n (x + i)
return arr
y = runSTArray sta'
print y
cycleST sta'
I have something similar to the above working with RankNTypes. Now there's the additional problem of trying to thread through the existential s, which is not likely to type check if threaded around through an abstraction the likes of cycleUnless.
Additionally, this is simplified to make the question easier to answer. I also use a set of semaphores built from MVar [MVar ()] similar to the skip channel example in the MVar module. If I can solve the above problem I plan to generalize the semaphores as well.
Ultimately this isn't some blocking problem. I have 3 components of the application operating in a cycle off the same MVar Bool but doing fairly different asynchronous tasks. In each one I have written a custom function that performs the appropriate cycle.
I'm trying to learn the "don't write large programs" approach. What I'd like to do is refactor chunks of code into their own mini libraries so that I'm not building a large program but assembling lots of small ones. But so far this particular abstraction is escaping me.
Any thoughts on how I might go about this are very much appreciated!
You want to cleanly combine a stateful action having side effects, a delay, and an independent stopping condition.
The iterative monad transformer from the free package can be useful in these cases.
This monad transformer lets you describe a (possibly nonending) computation as a series of discrete steps. And what's better, it let's you interleave "stepped" computations using mplus. The combined computation stops when any of the individual computations stops.
Some preliminary imports:
import Data.Bool
import Control.Monad
import Control.Monad.Trans
import Control.Monad.Trans.Iter (delay,untilJust,IterT,retract,cutoff)
import Control.Concurrent
Your foobar function could be understood as a "sum" of three things:
A computation that does nothing but reading from the MVar at each step, and finishes when the Mvar is True.
untilTrue :: (MonadIO m) => MVar Bool -> IterT m ()
untilTrue = untilJust . liftM guard . liftIO . readMVar
An infinite computation that takes a delay at each step.
delays :: (MonadIO m) => Int -> IterT m a
delays = forever . delay . liftIO . threadDelay
An infinite computation that prints an increasing series of numbers.
foobar' :: (MonadIO m) => Int -> IterT m a
foobar' x = do
let x' = x + 1
liftIO (print x')
delay (foobar' x')
With this in place, we can write foobar as:
foobar :: (MonadIO m) => MVar Bool -> m ()
foobar v = retract (delays 1000000 `mplus` untilTrue v `mplus` foobar' 0)
The neat thing about this is that you can change or remove the "stopping condition" and the delay very easily.
Some clarifications:
The delay function is not a delay in IO, it just tells the iterative monad transformer to "put the argument in a separate step".
retract brings you back from the iterative monad transformer to the base monad. It's like saying "I don't care about the steps, just run the computation". You can combine retract with cutoff if you want to limit the maximum number of iterations.
untilJustconverts a value m (Maybe a) of the base monad into a IterT m a by retrying in each step until a Just is returned. Of course, this risks non-termination!
MPredicate is rather superfluous here; m Bool can be used instead. The monad-loops package contains plenty of control structures with m Bool conditions. whileM_ in particular is applicable here, although we need to include a State monad for the Int that we're threading around:
import Control.Monad.State
import Control.Monad.Loops
import Control.Applicative
foobar :: MVar Bool -> IO ()
foobar mvb = (`evalStateT` (0 :: Int)) $
whileM_ (not <$> lift (readMVar mvb)) $ do
modify (+1)
lift . print =<< get
lift $ threadDelay 1000000
Alternatively, we can use a monadic version of unless. For some reason monad-loops doesn't export such a function, so let's write it:
unlessM :: Monad m => m Bool -> m () -> m ()
unlessM mb action = do
b <- mb
unless b action
It's somewhat more convenient and more modular in a monadic setting, since we can always go from a pure Bool to m Bool, but not vice versa.
foobar :: MVar Bool -> IO ()
foobar mvb = go 0
where
go :: Int -> IO ()
go x = unlessM (readMVar mvb) $ do
let x' = x + 1
print x'
threadDelay 1000000
go x'
You mentioned fix; sometimes people indeed use it for ad-hoc monadic loops, for example:
printUntil0 :: IO ()
printUntil0 =
putStrLn "hello"
fix $ \loop -> do
n <- fmap read getLine :: IO Int
print n
when (n /= 0) loop
putStrLn "bye"
With some juggling it's possible to use fix with multi-argument functions. In the case of foobar:
foobar :: MVar Bool -> IO ()
foobar mvb = ($(0 :: Int)) $ fix $ \loop x -> do
unlessM (readMVar mvb) $ do
let x' = x + 1
print x'
threadDelay 1000000
loop x'
I'm not sure what's your MPredicate is doing.
First, instead of newtyping a tuple, it's probably better to use a normal algebric data type
data MPredicate a m = MPredicate a (a -> m Bool)
Second, the way you use it, MPredicate is equivalent to m Bool.
Haskell is lazzy, therefore there is no need to pass, a function and it's argument (even though
it's usefull with strict languages). Just pass the result, and the function will be called when needed.
I mean, instead of passing (x, f) around, just pass f x
Of course, if you are not trying to delay the evaluation and really need at some point, the argument or the function as well as the result, a tuple is fine.
Anyway, in the case your MPredicate is only there to delay the function evaluation, MPredicat reduces to m Bool and doUnless to unless.
Your first example is strictly equivalent :
main = do
b <- newMVar False
unless (readMVar b) (print "foo")
Now, if you want to loop a monad until a condition is reach (or equivalent) you should have a look at the monad-loop package. What you are looking it at is probably untilM_ or equivalent.

Is there a lazy Session IO Monad?

You have a sequence of actions that prefer to be executed in chunks due to some high-fixed overhead like packet headers or making connections. The limit is that sometimes the next action depends on the result of a previous one in which case, all pending actions are executed at once.
Example:
mySession :: Session IO ()
a <- readit -- nothing happens yet
b <- readit -- nothing happens yet
c <- readit -- nothing happens yet
if a -- all three readits execute because we need a
then write "a"
else write "..."
if b || c -- b and c already available
...
This reminds me of so many Haskell concepts but I can't put my finger on it.
Of course, you could do something obvious like:
[a,b,c] <- batch([readit, readit, readit])
But I'd like to hide the fact of chunking from the user for slickness purposes.
Not sure if Session is the right word. Maybe you can suggest a better one? (Packet, Batch, Chunk and Deferred come to mind.)
Update
I think there was a really good answer last night that I read on my phone but when I came back to look for it today it was gone. Was I dreaming?
I don't think you can do exactly what you want, since what you describe exploits haskell's lazy evaluation to have the evaluation of a force the actions that compute b and c, and there's no way to seq on unspecified values.
What I could do was hack together a monad transformer that delayed actions sequenced via >> so that they could be executed all together:
data Session m a = Session { pending :: [ m () ], final :: m a }
runSession :: Monad m => Session m a -> m a
runSession (Session ms ma) = foldr (flip (>>)) (return ()) ms >> ma
instance Monad m => Monad (Session m) where
return = Session [] . return
s >>= f = Session [] $ runSession s >>= (runSession . f)
(Session ms ma) >> (Session ms' ma') =
Session (ms' ++ (ma >> return ()) : ms) ma'
This violates some monad laws, but lets you do something like:
liftIO :: IO a -> Session IO a
liftIO = Session []
exampleSession :: Session IO Int
exampleSession = do
liftIO $ putStrLn "one"
liftIO $ putStrLn "two"
liftIO $ putStrLn "three"
liftIO $ putStrLn "four"
trace "five" $ return 5
and get
ghci> runSession exampleSession
five
one
two
three
four
5
ghci> length (pending exampleSession)
4
This is very similar to what Haxl does.
For more info:
Open sourcing haxl - Facebook Code Blog
ICFP 2014 talk
You could use the unsafeInterleaveIO function. It is a dangerous function that can introduce bugs to your program if not used carefully, but it does what you're asking for.
You can insert it into your example code like this:
lazyReadits :: IO [a]
lazyReadits = unsafeInterleaveIO $ do
a <- readit
r <- lazyReadits
return (a:r)
unsafeInterleaveIO makes the action as a whole lazy, but once it starts evaluating it will evaluate as if it had been strict. This means in my above example: readit will run as soon as something tests whether the returned list is empty or not. If I'd used mapM unsafeInterleaveIO (replicate 3 readit) instead, then readit would only be run when the actual elements of the list are evaluated, which would make the contents of the list depend on the order in which its elements are inspected, which is one example of how unsafeInterleaveIO can introduce bugs.

Haskell: Resume monadic computation inside IO

I'm trying to "resume" a monadic computation from within IO and fearing that I may be out of luck. The situation is the following:
ioBracketFoo :: (a - > IO b) -> IO b
withBar :: MonadIO m => (a -> m b) -> m b
withBar action = liftIO $ ioBracketFoo $ \foo -> runMagic (action f)
Basically I want to resume my (unknown) monadic computation from within ioBracketFoo. If it were not a bracketing function then I'd be able to get the resource using res <- liftIO getFoo and release it later, and I wouldn't have to resume my monadic computation from within IO.
Is there any other creative use of lift or similar to make this possible?
This problem is sloved by MonadBaseControl. MonadBaseControl provides the functions to store and restart a monadic computation. You'll require an additional dependency to MonadBaseControl, which will prevent unstorable monads from beeing used in your bracket-funciton, for example
There is a tutorial on fp-complete, that should answer all basic questions.

Resources