I have a function with a type Map Int String -> Proxy () a () Void IO b. Right now it awaits, does whatever with the value it got, and then re-calls itself. I'd like to change it to use State (Map Int String) instead of having that passed as an argument, so I can just use forever and don't need to have every branch remember to recurse. I get that I need to use StateT to combine State with another monad, but I don't understand where in that type signature the StateT belongs, or whether or not I need to lift functions like get. What is the correct type for a function that is both a State (Map Int String) and a Proxy () a () Void IO b?
Note: Proxy () a () Void = Consumer a, so I will refer to it as a Consumer for this answer.
The simple way is to put your StateT monad transformer layer outside of the Consumer layer and then run it immediately. Here is an example:
import Control.Monad (forever)
import Control.Monad.Trans.State.Strict
import Pipes
example :: (Show a) => Consumer a IO r
example = flip evalStateT 0 $ forever $ do
-- Inside here we are using `StateT Int (Consumer a IO) r`
a <- lift await
n <- get
lift $ lift $ putStrLn $ "Received value #" ++ show n ++ ": " ++ show a
put (n + 1)
... and this is how it behaves in action:
>>> runEffect $ each ["Test", "ABC"] >-> example
Received value #0: "Test"
Received value #1: "ABC"
Related
I'm using pipes, attoparsec, and pipes-attoparsec to write a database dump file converter. The general format of the file is to have a create table command followed by an optional insert command. In addition to transforming the statements in place, the table definitions have to be held in memory until the very end for additional processing (indexes, constraints, etc.).
This works fine, but now I need to allow some of my internal parsers to have access to my Producer's State in order to determine which parser needs to be run while processing the values from the insert command.
I tried something like this:
-- IO
import qualified Data.ByteString.Char8 as BS (putStrLn)
import System.Exit (ExitCode (..), exitSuccess, exitFailure)
import System.IO (hPutStrLn, stderr)
-- Pipes
import Pipes (runEffect, for, liftIO, Producer, Effect)
import Pipes.Attoparsec (parsed, ParsingError)
import Pipes.Lift (runStateP)
import Pipes.Safe (runSafeT)
import qualified Pipes.ByteString as PBS (stdin)
-- State
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.State.Strict
dump' :: StateT ParserState Parser Command
dump' = fmap Create createStatements' <|> fmap Insert justData'
doStuff :: MonadIO m => Effect m (Either (ParsingError, Producer ByteString (StateT ParserState m) ()) (), ParserState)
doStuff = runStateP defaultParserState theStuff
theStuff :: MonadIO m => Effect (StateT ParserState m) (Either (ParsingError, Producer ByteString (StateT ParserState m) ()) ())
theStuff = for runParser (liftIO . BS.putStrLn <=< lift . processCommand)
runParser :: MonadIO m => Producer Command (StateT ParserState m) (Either (ParsingError, Producer ByteString (StateT ParserState m) ()) ())
runParser = do
s <- lift get
liftIO $ putStrLn "runParser"
liftIO $ putStrLn $ show s
parsed (evalStateT dump' s) PBS.stdin
processCommand :: MonadIO m => Command -> StateT ParserState m ByteString
processCommand (Create xs) = do
currentState <- get
liftIO $ putStrLn "processCommand"
liftIO $ putStrLn $ show currentState
_ <- put (currentState { constructs = xs ++ (constructs currentState)})
return $ P.firstPass $ P.transformConstructs xs
processCommand (Insert x) = return x
Complete source (including parsers): https://github.com/cimmanon/mysqlnothx/blob/parser-state/src/Main.hs
When I run it, I get a result that looks something like this:
runParser
ParserState {constructs = []}
processCommand
ParserState {constructs = []}
processCommand
ParserState {constructs = [ ... ]}
processCommand
ParserState {constructs = [ ..... ]}
I was expecting runParser (which would grab the latest contents from State) to be run every time processCommand runs, but that's clearly not the case based on the output. When I check the contents of State within the parser, it's always empty no matter how many commands are parsed.
How can I extend State from my Producers to my Parser (dump') so that they share the same State? If my Producer has 4 values in State, the Parser should also see those same 4 values.
I was expecting runParser (which would grab the latest contents from State) to be run every time processCommand runs, but that's clearly not the case.
Your main effect is for runParser (liftIO . BS.putStrLn <=< lift . processCommand). To understand what this effect does you need to understand what for does:
(for p body) loops over p replacing each yield with body
"Loops over p" is accurate if a bit confusing. It doesn't run p once for each value produced by p; that would explode! Instead for replaces every yield in p with body. By replacing yield with body it runs body once for every yielded value. Running the body once for each produced value is similar to how in other languages a for-loop over a list runs the body once for each value in the list.
Your runParser is
runParser = do
s <- lift get
liftIO $ putStrLn "runParser"
liftIO $ putStrLn $ show s
parsed (evalStateT dump' s) PBS.stdin
It reads the state, outputs it, and produces the Commands parsed from stdin. Pipes-autoparsec's parsed parses the source and yields once for each completely successfully parsed value. Your for then replaces each of parsed's yields with liftIO . BS.putStrLn <=< lift . processCommand. The complete effect runs runParser once and processCommand once for each yield, which is what you're observing in the output.
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
Sorry if this is a common question. I have this simple IO() function:
greeter :: IO()
greeter = do
putStr "What's your name? "
name <- getLine
putStrLn $ "Hi, " ++ name
Now I want to call greeter and at the same time specify a parameter that will pre-fill the getLine, so that I don't actually need to interact. I imagine something like a function
IOwithinputs :: [String] -> IO() -> IO()
then I'd do
IOwithinputs ["Buddy"] greeter
which would produce an IO action requiring no user input that would look something like:
What's your name?
Hi, Buddy
I want to do this without modifying the original IO() function greeter. I also don't want to compile greeter and pipe input from the command line. I don't see anything like IOwithinputs in Hoogle. (withArgs is tantalizingly typed and named, but isn't at all what I want.) Is there an easy way to do this? Or is it impossible for some reason? Is this what Pipes is for?
As others have noted, there's no clean way to "simulate" IO if you're already using things like getLine and putStrLn. You have to modify greeter. You could use the hGetLine and hPutStr versions and mock out IO with a fake Handle, or you could use the Purify Code with Free Monads method.
It's far more complex, but also more general and usually a good fit for this kind of mocking, especially when it gets more complex.. I'll explain it briefly below, though the details are somewhat sophisticated.
The idea is that you will be creating your own "fake IO" monad which can be "interpreted" in multiple ways. The primary interpretation is just to use regular IO. The mocked interpretation replaces getLine with some fake lines and echoes everything to stdout.
We'll use the free package. The first step is to describe your interface with a Functor. The basic notion is that each command is a branch of your functor data type and that the functor's "slot" represents the "next action".
{-# LANGUAGE DeriveFunctor #-}
import Control.Monad.Trans.Free
data FakeIOF next = PutStr String next
| GetLine (String -> next)
deriving Functor
These constructors are almost like the regular IO functions from the point of view of someone building a FakeIOF if you ignore the next action. If we want to PutStr we must provide a String. If we want to GetLine we provide a function with only gives the next action when given a String.
Now we need a little confusing boilerplate. We use the liftF function to turn our functor into a FreeT monad. Notice that we provide () as the next action on PutStr and id as our String -> next function. It turns out that these give us the right "return values" if we think of how our FakeIO Monad will behave.
-- Our FakeIO monad
type FakeIO a = FreeT FakeIOF IO a
fPutStr :: String -> FakeIO ()
fPutStr s = liftF (PutStr s ())
fGetLine :: FakeIO String
fGetLine = liftF (GetLine id)
Using these we can build whatever functionality we like and rewrite greeter with very minimal changes.
fPutStrLn :: String -> FakeIO ()
fPutStrLn s = fPutStr (s ++ "\n")
greeter :: FakeIO ()
greeter = do
fPutStr "What's your name? "
name <- fGetLine
fPutStrLn $ "Hi, " ++ name
This might look a little bit magical---we're using do notation without defining a Monad instance. The trick is that FreeT f m is a Monad for any Monad m and Functorf`.
This completes our "mocked" greeter function. Now we must interpret it somehow as we've implemented almost no functionality so far. To write an interpreter we use the iterT function from Control.Monad.Trans.Free. It's fully general type is as follows
iterT
:: (Monad m, Functor f) => (f (m a) -> m a) -> FreeT f m a -> m a
But when we apply it to our FakeIO monad it looks
iterT
:: (FakeIOF (IO a) -> IO a) -> FakeIO a -> IO a
which is much nicer. We provide it a function that takes FakeIOF functors filled with IO actons in the "next action" position (which is how it gets its name) to a plain IO action and iterT will do the magic of turning FakeIO into real IO.
For our default interpreter this is really easy.
interpretNormally :: FakeIO a -> IO a
interpretNormally = iterT go where
go (PutStr s next) = putStr s >> next -- next :: IO a
go (GetLine doNext) = getLine >>= doNext -- doNext :: String -> IO a
But we can also make a mocked interpreter. We'll use the facilities of IO to store some state, in particular a cyclic queue of fake responses.
newQ :: [a] -> IO (IORef [a])
newQ = newIORef . cycle
popQ :: IORef [a] -> IO a
popQ ref = atomicModifyIORef ref (\(a:as) -> (as, a))
interpretMocked :: [String] -> FakeIO a -> IO a
interpretMocked greetings fakeIO = do
queue <- newQ greetings
iterT (go queue) fakeIO
where
go _ (PutStr s next) = putStr s >> next
go q (GetLine getNext) = do
greeting <- popQ q -- first we pop a fresh greeting
putStrLn greeting -- then we print it
getNext greeting -- finally we pass it to the next IO action
and now we can test these functions
λ> interpretNormally greeter
What's your name? Joseph
Hi, Joseph.
λ> interpretMocked ["Jabberwocky", "Frumious"] (greeter >> greeter >> greeter)
What's your name?
Jabberwocky
Hi, Jabberwocky
What's your name?
Frumious
Hi, Frumious
What's your name?
Jabberwocky
Hi, Jabberwocky
I don't think it is easy to do as you ask, but you can do next:
greeter' :: IO String -> IO()
greeter' ioS = do
putStr "What's your name? "
name <- ioS
putStrLn $ "Hi, " ++ name
greeter :: IO ()
greeter = greeter' getLine
ioWithInputs :: Monad m => [a] -> (m a -> m ()) -> m()
ioWithInputs s ioS = mapM_ (ioS.return) s
and test it:
> ioWithInputs ["Buddy","Nick"] greeter'
What's your name? Hi, Buddy
What's your name? Hi, Nick
and even more funny with emulation answer:
> ioWithInputs ["Buddy","Nick"] $ greeter' . (\s -> s >>= putStrLn >> s)
What's your name? Buddy
Hi, Buddy
What's your name? Nick
Hi, Nick
Once you are in IO you can't change the way you get input. To answer your question about pipes, yes it is possible to abstract away the input by defining a Consumer:
import Pipes
import qualified Pipes.Prelude as P
greeter :: Consumer String IO ()
greeter = do
lift $ putStr "What's your name? "
name <- await
lift $ putStrLn $ "Hi, " ++ name
Then you can either specify to use the command line as input:
main = runEffect $ P.stdinLn >-> greeter
... or to use a pure set of strings as input:
main = runEffect $ each ["Buddy"] >-> greeter
I have code in the Reader Monad, so as to pass a file handle as an invisible parameter down the Reader chain.
In writeMail, I am trying to create a Reader, which, when run using runReader, produces an IO () output which is itself the result of a chain of IO monads
writeMail :: Reader Handle (IO ())
writeMail mail = do
wmh <- writeMailHeaders mail
wmb <- writeMailBody mail
return $ wmh >>= \_ -> wmb
However I am finding that only the last in the IO chain i.e. wmb, prints at the console.
Can anyone see what I should be doing to get wmh, then wmb to print?
With simpler example:
module Read where
import Data.Functor.Identity
write :: Monad m => m (IO ())
write = do
a <- return $ putStrLn "foo"
b <- return $ putStrLn "bar"
return $ a >> b
main :: IO ()
main = runIdentity write
main prints both "foo" and "bar". So I suspect the error is in writeMailHeaders.
What you need is not just a reader, but a ReaderT monad transformer with IO as a base monad.
Since your example was incomplete, I made some changes to show your options:
import Control.Monad.Reader
writeMail :: ReaderT Handle IO ()
writeMail = do
-- Here's how you get your handle to further do something to it:
handle <- ask
-- Here's how you do the IO actions.
-- Notice the `lift` function,
-- which allows us to run actions of the base monad,
-- which in that case is `IO`.
lift $ do
print "bla bla"
print "bla"
The current version of the Pipes tutorial, uses the following two functions in one of the example:
stdout :: () -> Consumer String IO r
stdout () = forever $ do
str <- request ()
lift $ putStrLn str
stdin :: () -> Producer String IO ()
stdin () = loop
where
loop = do
eof <- lift $ IO.hIsEOF IO.stdin
unless eof $ do
str <- lift getLine
respond str
loop
As is mentinoed in the tutorial itself, P.stdin is a bit more complicated due to the need to check for the end of input.
Are there any nice ways to rewrite P.stdin to not need a manual tail recursive loop and use higher order control flow combinators like P.stdout does? In an imperative language I would use a structured while loop or a break statement to do the same thing:
while(not IO.isEOF(IO.stdin) ){
str <- getLine()
respond(str)
}
forever(){
if(IO.isEOF(IO.stdin) ){ break }
str <- getLine()
respond(str)
}
I prefer the following:
import Control.Monad
import Control.Monad.Trans.Either
loop :: (Monad m) => EitherT e m a -> m e
loop = liftM (either id id) . runEitherT . forever
-- I'd prefer 'break', but that's in the Prelude
quit :: (Monad m) => e -> EitherT e m r
quit = left
You use it like this:
import Pipes
import qualified System.IO as IO
stdin :: () -> Producer String IO ()
stdin () = loop $ do
eof <- lift $ lift $ IO.hIsEOF IO.stdin
if eof
then quit ()
else do
str <- lift $ lift getLine
lift $ respond str
See this blog post where I explain this technique.
The only reason I don't use that in the tutorial is that I consider it less beginner-friendly.
Looks like a job for whileM_:
stdin () = whileM_ (lift . fmap not $ IO.hIsEOF IO.stdin) (lift getLine >>= respond)
or, using do-notation similarly to the original example:
stdin () =
whileM_ (lift . fmap not $ IO.hIsEOF IO.stdin) $ do
str <- lift getLine
respond str
The monad-loops package offers also whileM which returns a list of intermediate results instead of ignoring the results of the repeated action, and other useful combinators.
Since there is no implicit flow there is no such thing like "break". Moreover your sample already is small block which will be used in more complicated code.
If you want to stop "producing strings" it should be supported by your abstraction. I.e. some "managment" of "pipes" using special monad in Consumer and/or other monads that related with this one.
You can simply import System.Exit, and use exitWith ExitSuccess
Eg. if (input == 'q')
then exitWith ExitSuccess
else print 5 (anything)