Following the lead of the excellent answer in this post, I'm trying to get a working example of ArrowLoop that doesn't use arrow notation. I'm uncomfortable using arrow notation until I fully understand how arrows work under the hood. That being said, I've constructed a small program that based on my (limited) understanding of Arrows should work. However, it ends up terminating with the dreaded <<loop>> exception:
module Main where
import Control.Wire
import FRP.Netwire
farr :: SimpleWire (Int, Float) (String, Float)
farr = let
fn :: Int -> Float -> ((String, Float), SimpleWire (Int, Float) (String, Float))
fn i f = (("f+i: " ++ (show (fromIntegral i + f)), f + 0.1), loopFn)
loopFn :: SimpleWire (Int, Float) (String, Float)
loopFn = mkSFN $ \(i, f) -> fn i f
in
mkSFN $ \(i, _) -> fn i 0.0
main :: IO ()
main = do
let sess = clockSession_ :: Session IO (Timed NominalDiffTime ())
(ts, sess2) <- stepSession sess
let wire = loop farr
(Right s, wire2) = runIdentity $ stepWire wire ts (Right 0)
putStrLn ("s: " ++ s)
(ts2, _) <- stepSession sess2
let (Right s2, _) = runIdentity $ stepWire wire2 ts (Right 1)
putStrLn ("s2: " ++ s2)
My intuition tells me that the <<loop>> exception usually comes when you don't supply the initial value to the loop. Haven't I done that with the line containing fn i 0.0? The output disagrees:
$ ./test
s: f+i: 0.0
test.exe: <<loop>>
Does anyone know what I'm doing wrong?
The main point of confusion seemed to be the integral relationship between ArrowLoop and mfix. For the uninitiated, fix is a function that finds the fixed point of a given function:
fix :: (a -> a) -> a
fix f = let x = f x in x
mfix is the monadic extension of this function, whose type signature is, unsurprisingly:
mfix :: (a -> m a) -> m a
So what does this have to do with ArrowLoop? Well, the ArrowLoop instance for Netwire runs mfix on the second argument of the passed wire. To put it another way, consider the type signature for loop:
loop :: a (b, d) (c, d) -> a b c
In Netwire, the instance of ArrowLoop is:
instance MonadFix m => ArrowLoop (Wire s e m)
This means that the loop function's type when used with wires is:
loop :: MonadFix m => Wire s e m (b, d) (c, d) -> Wire s e m b c
Since loop does not take an initial argument of type d, this means that there is no way to initialize any sort of conventional "looping" over the wire. The only way to get a value out of it is to keep applying the output as the input until it finds a termination condition, which is analogous to the way fix works. The wire that gets passed as an argument to loop never actually steps more than once, since stepWire is applied to the same wire over and over with different inputs. Only when the wire actually produces a fixed value, does the function step and produce another wire (which behaves the same way as the first).
For completeness, here is code for my original intuition for how loop was supposed to work, which I have named semiLoop:
semiLoop :: (Monad m, Monoid s, Monoid e) => c -> Wire s e m (a, c) (b, c) -> Wire s e m a b
semiLoop initialValue loopWire = let
runLoop :: (Monad m, Monoid s, Monoid e) =>
Wire s e m (a, c) (b, c) -> s -> a -> c -> m (Either e b, Wire s e m a b)
runLoop wire ts ipt x = do
(result, nextWire) <- stepWire wire ts (Right (ipt, x))
case result of
Left i -> return (Left i, mkEmpty)
Right (value, nextX) ->
return (Right value, mkGen $ \ts' ipt' -> runLoop nextWire ts' ipt' nextX)
in
mkGen $ \ts input -> runLoop loopWire ts input initialValue
Edit
After the wonderful answer provided by Petr, the delay combinator is essential to preventing the loop combinator from diverging. delay simply creates a single-value buffer between the laziness of using the next value in the mfix portion of the loop described above. An identical definition of semiLoop above is therefore:
semiLoop :: (MonadFix m, Monoid s, Monoid e) =>
c -> Wire s e m (a, c) (b, c) -> Wire s e m a b
semiLoop initialValue loopWire = loop $ second (delay initialValue) >>> loopWire
Related
I am trying to create a game using Haskell + Netwire 5 (+ SDL). Now I am working on the output part, where I would like to create wires that read in some game state and output the SDL surfaces to be blitted on screen.
However, the problem is that SDL surfaces are contained in IO monad, so any function that creates such surfaces must have type a -> IO b. Of course, arr does not construct a Wire from a -> m b. However, since the type signature of a wire is (Monad m, Monoid e) => Wire s e m a b, it looks quite like a Kleisi Arrow, but I cannot find a suitable constructor for making such a wire.
I am new to FRP and Arrows, and have not programmed a lot in Haskell, so this may not be the best way to implement the graphics output. If I am wrong from the beginning, please let me know.
Some SDL functions related:
createRGBSurfaceEndian :: [SurfaceFlag] -> Int -> Int -> Int -> IO Surface
fillRect :: Surface -> Maybe Rect -> Pixel -> IO Bool
blitSurface :: Surface -> Maybe Rect -> Surface -> Maybe Rect -> IO Bool
flip :: Surface -> IO ()
Update 1
This code type checks, but now I am trying to interface it with SDL for testing
wTestOutput :: (Monoid e) => Wire s e IO () SDL.Surface
wTestOutput = mkGen_ $ \a -> (makeSurf a >>= return . Right)
where
makeSurf :: a -> IO SDL.Surface
makeSurf _ = do
s <- SDL.createRGBSurfaceEndian [SDL.SWSurface] 800 600 32
SDL.fillRect s (Just testRect) (SDL.Pixel 0xFF000000)
return s
testRect = SDL.Rect 100 100 0 0
Now, after playing around with Arrows, I will answer my own question
using the function putStrLn. It has type String -> IO (), which is
a -> m b, so the method should generalize to all Kleisli wires. I also illustrate how to drive the wire, and the result is amazingly simple.
The entire code is written in Literate Haskell, so just copy it and run.
First, there are some imports for the Netwire 5 library
import Control.Wire
import Control.Arrow
import Prelude hiding ((.), id)
Now, this is the core of making a Kleisli Wire. Assume you have a
function with type a -> m b that needs to be lifted into a wire. Now,
notice that mkGen_ has type
mkGen_ :: Monad m => (a -> m (Either e b)) -> Wire s e m a b
So, to make a wire out of a -> m b, we first need to get a function
with type a -> m (Either () b). Notice that Left inhibits the wire,
while Right activates it, so the inner part is Either () b instead of
Either b (). Actually, if you try the latter, an obscure compile error
will tell you get this in the wrong way.
To get a -> m (Either () b), first consider how to get
m (Either () b) from m b, we extract the value from the monad (m
b), lift it to Right, then return to the monad m. In short:
mB >>= return . Right. Since we don't have the value "mB" here, we
make a lambda expression to get a -> m (Either () b):
liftToEither :: (Monad m) => (a -> m b) -> (a -> m (Either () b))
liftToEither f = \a -> (f a >>= return . Right)
Now, we can make a Kleisli wire:
mkKleisli :: (Monad m, Monoid e) => (a -> m b) -> Wire s e m a b
mkKleisli f = mkGen_ $ \a -> (f a >>= return . Right)
So, let's try the canonical "hello, world" wire!
helloWire :: Wire s () IO () ()
helloWire = pure "hello, world" >>> mkKleisli putStrLn
Now comes the main function to illustrate how to drive the wire. Note
that comparing to the source of testWire in the Control.Wire.Run
from the Netwire library, there is no use of liftIO: the outer program
knows nothing about how the wires work internally. It merely steps the
wires ignoring what is in it. Maybe this Just means better
composition than using Nothing about Kleisli Wires? (No pun intended!)
main = go clockSession_ helloWire
where
go s w = do
(ds, s') <- stepSession s
(mx, w') <- stepWire w ds (Right ())
go s' w'
Now here comes the code. Unfortunately StackOverflow does not work quite well with Literate Haskell...
{-# LANGUAGE Arrows #-}
module Main where
import Control.Wire
import Control.Monad
import Control.Arrow
import Prelude hiding ((.), id)
mkKleisli :: (Monad m, Monoid e) => (a -> m b) -> Wire s e m a b
mkKleisli f = mkGen_ $ \a -> liftM Right $ f a
helloWire :: Wire s () IO () ()
helloWire = pure "hello, world" >>> mkKleisli putStrLn
main = go clockSession_ helloWire
where
go s w = do
(ds, s') <- stepSession s
(mx, w') <- stepWire w ds (Right ())
go s' w'
Update
Thanks to Cubic's inspiration. liftToEither can actually be written in, you guess it, liftM:
liftToEither f = \a -> liftM Right $ f a
mkKleisli f = mkGen_ $ \a -> liftM Right $ f a
The code below probably isn't a good way to do this, but it's what I've managed to cobble together. Basically, I run a series of complex tasks, during which several things get logged. At the end of each one I dump the log into a .txt file and move on to the next batch in a loop.
To achieve this I make use of listen and pass in WriterT (as part of RWST). The code is below:
-- Miscelaneous stuff
newtype Log = Log [String]
type ConnectT a = EitherT String (RWST ConnectReader Log ConnectState IO) a
timeStampLog :: String -> Log
timeStampLog msg = do
theTime <- liftIO $ fmap zonedTimeToLocalTime getZonedTime
let msgStart = show theTime ++ ": "
tell $ Log [msgStart ++ msg]
logToFileIO :: Log -> IO ()
logToFileIO (Log xs) = appendFile "Log.txt" $ "\r\n" ++ intercalate "\r\n" (reverse xs)
---------------------
logToFile :: ConnectT a -> ConnectT ()
logToFile cta = let ctaw = listen cta
in pass $ do
(_,w) <- ctaw
liftIO $ logToFileIO w
return ((),const mempty)
mapFunction :: (Show a) => a -> ConnectT ()
mapFunction a = logToFile $ do
timeStampLog $ "Starting sequence for " ++ show a
lotsOfLogging a
timeStampLog $ "Finishing sequence for " ++ show a
loopFunction :: ConnectT ()
loopFunction = logToFile $ do
timeStampLog "Starting Loop"
mapM_ mapFunction someList
timeStampLog "Finishing Loop"
What I end up with is something like this:
2015-03-17 20:21:40.8198823: Starting sequence for a
2015-03-17 20:21:41.8198823: (logs for a)
2015-03-17 20:21:41.8198823: Finishing sequence for a
2015-03-17 20:21:41.8198823: Starting sequence for b
2015-03-17 20:21:42.8198823: (logs for b)
2015-03-17 20:21:42.8198823: Finishing sequence for b
2015-03-17 20:21:39.8198823: Starting Loop
2015-03-17 20:21:42.8198823: Finishing Loop
Where the log entry for starting/finishing the loop end up together at the end.
I'm not entirely surprised that the call to logToFile in mapFunction doesn't include the log information from the loopFunction as the information hasn't passed to it via a bind.
But I'm still having trouble understanding how pass and listen work. And also how I would go about fixing this (admittedly minor) issue.
We can determine how listen and pass work almost entirely from their types. We'll start with listen.
listen
listen :: (Monoid w, Monad m) => RWST r w s m a -> RWST r w s m (a, w)
Unwrapping the RWST we have
listen :: (Monoid w, Monad m) => (r -> s -> m (a, s, w)) -> r -> s -> m ((a, w), s, w)
It needs to return an m .... The only way we have to make ms is to return something or apply the input function to an rand an s (we can't use >>= since it requires we already have an m). We don't have an a to return so we have to apply the function to an r and s. There's only one r and s we can use, those passed into the result.
listen k r s = ... (k r s)
Now we have an m (a, s, w) but need an m ((a, w), s, w). We can run the action again to get another m (nonsense for "listening") or do something with the (a, s, w) inside the m with >>=.
listen k r s = k r s >>= \(a, s' w) -> ...
To use bind we need an m. We can either return something or apply the input function to an r and s and repeat the action again, which is nonsense for "listening". We return something.
listen k r s = k r s >>= \(a, s', w) -> return ...
We need an a, a w, an s, and another w. We only have one a and no way to get any others.
listen k r s = k r s >>= \(a, s', w) -> return ((a,...),...,...)
There are 3 ways we can get a w: mempty, the w from the result of the action, or combining two ws together with <>. Returning mempty is pointless; the user could have just used mempty themselves. Duplicating what was logged with <> is as much nonsense as running an action twice, so we return what was logged by the first action.
listen k r s = k r s >>= \(a, s', w) -> return ((a,w),...,...)
We have two s es: s and s'. Reverting the state changes of the action is nonsense for "listening", so we return the changed state s'.
listen k r s = k r s >>= \(a, s', w) -> return ((a,w),s',...)
Now we are faced with the only interesting choice: what w should we keep for what was logged? The user has "listened" for what was logged; we could say that it's their problem now and reset the log to mempty. But "listening" doesn't suggest that it should change what something does, it should only observe it. Therefore, we keep the resulting log w intact.
listen k r s = k r s >>= \(a, s', w) -> return ((a,w),s',w)
If we wrap this in its RWSTs again we have
listen m = RWST \r s -> (runRWST m) r s >>= \(a, s', w) -> return ((a,w),s',w)
All we did was run the input action and include what it logged along with its resulting a in the result as a tuple. This matches the documentation for listen:
listen m is an action that executes the action m and adds its output to the value of the computation.
runRWST (listen m) r s = liftM (\ (a, w) -> ((a, w), w)) (runRWST m r s)
tell
pass :: (Monoid w, Monad m) => RWST r w s m (a, w -> w) -> RWST r w s m a
We begin as before, unwrapping the RWST
pass :: (Monoid w, Monad m) => (r -> s -> m ((a, w->w), s, w)) -> r -> s -> m (a, s, w)
We follow the same argument for how to get a resulting m as we used for listen
pass k r s = ... (k r s)
Now we have an m ((a, w->w), s, w)) but need an m (a, s, w). We can run the action again to get another m (nonsense for "passing") or do something with the ((a, w->w), s, w) inside the m with >>=.
pass k r s = k r s >>= \((a, f), s', w) -> ...
To use bind we need an m. We can either return something or apply the input function to an r and s and repeat the action again, which is nonsense for "passing". We return something.
pass k r s = k r s >>= \((a, f), s', w) -> return ...
We need an a, an s, and a w. We only have one a and no way to get any others.
pass k r s = k r s >>= \((a, f), s', w) -> return (a,...,...)
We have two s es: s and s'. Reverting the state changes of the action is nonsense for "passing", so we return the changed state s'.
pass k r s = k r s >>= \((a, f), s', w) -> return (a,s',...)
There are 4 ways we can get a w: mempty, the w from the result of the action, combining two ws together with <>, or applying the function f to another w. Setting the result to mempty leaves us wondering why the user provided a function f :: w -> w. themselves. Duplicating what was logged with <> is as much nonsense as running an action twice. We should be applying the function f to something.
pass k r s = k r s >>= \((a, f), s', w) -> return (a,s',f ...)
We could apply f to something built from memptys and <>, but if that were the case all of the fs would be equivalent to const ...; the type for it might as well have been a w. We could apply f to some elaborate structure built from w, mempty, <>, and f, but all of those structures could have been defined in f itself if we simply pass it w.
pass k r s = k r s >>= \((a, f), s', w) -> return (a,s',f w)
If we wrap this in its RWSTs again we have
pass m = RWST \r s -> (runRWST k) r s >>= \((a, f), s', w) -> return (a,s',f w)
We ran the input action and changed what was logged by the function that was a result of the action. This matches the documentation for pass:
pass m is an action that executes the action m, which returns a value and a function, and returns the value, applying the function to the output.
runRWST (pass m) r s = liftM (\ ((a, f), w) -> (a, f w)) (runRWST m r s)
The existing WriterT w m can't perform any action in the underlying m to perform logging until after the action has been run and the w has been assembled. As your question illustrates, this is confusing. The log for the do block loopFunction isn't written by logToFile until after the do block itself finishes running.
LoggerT
Let's invent a new WriterT called LoggerT. Our new LoggerT is going to provide a new function
logTells :: (Monoid w, Monoid w', Monad m) =>
(w -> LoggerT w' m ()) -> LoggerT w m a -> LoggerT w' m a
The intuition behind this is: we'll be able to provide an action (with type w -> LoggerT w' m ()) to log every tell, replacing the logged result with the result of the action. If we smash two things the user tells us together with <> we'll no longer be able to log both of them; we'll only ever be able to log the result of <>. Since our LoggerT will never be able to use <> it will never need the Monoid instances. We must drop the Monoid constraint from everything in LoggerT.
logTells :: (Monad m) =>
(w -> LoggerT w' m ()) -> LoggerT w m a -> LoggerT w' m a
We need to remember every tell so that we can replace it later. But when we replace it "later", the logging should happen at the point the tell appeared in the code. For example, if we make
processX :: LoggerT String m ()
processX = do
tell "Starting process X"
lotsOfProcessing
tell "Finishing process X"
And then "later" write logTells logToFile processX we want the resulting computation to look like the following.
logTells logToFile processX = do
logToFile "Starting process X"
lotsOfProcessing
logToFile "Finishing process X"
None of lotsOfProcessing should happen until the logToFile for tell "Starting process X" has already happened. This means that when the user tells us something we need to remember not only what we were told, but everything that happens after that. We "remember" things in the constructor for a data.
data LoggerT w m a
= Tell w (LoggerT w m a)
| ...
tell :: w -> LoggerT w m ()
tell w = Tell w (return ())
We also need to be able to perform actions in the underlying Monad. It would be tempting to add another constructor Lift (m a), but then we couldn't decide what to log as a result of the underlying computation. Instead, we'll let it decide the entire future LoggerT w m a to run.
data LoggerT w m a
= Tell w (LoggerT w m a)
| M (m (LoggerT w m a))
...
If we try to lift an underlying computation m a into LoggerT we now have a problem; we don't have a way to turn the a into a LoggerT w m a to put it in the M constructor.
instance MonadTrans (LoggerT w m) where
lift ma = M (??? ma)
We could try lifting return from the underlying Monad, but that's just a circular definition. We'll add another constructor for Returning.
data LoggerT w m a
= Tell w (LoggerT w m a)
| M (m (LoggerT w m a))
| Return a
instance MonadTrans (LoggerT w m) where
lift = M . liftM Return
To finish our monad transformer, we'll write a Monad instance.
instance Monad m => Monad (LoggerT w m) where
return = Return
la0 >>= k = go la0
where
go (Tell w la ) = Tell w (go la)
go (M mla) = M (liftM go mla)
go (Return a ) = Return a
We can now define logTells. It replaces every Tell with the action to perform to log it.
logTells :: (w -> LoggerT w' m ()) -> LoggerT w m a -> LoggerT w' m a
logTells k = go
where
go (Tell w la ) = k w >> go la
go (M mla) = M (liftM go mla)
go (Return a) = return a
Finally, we'll provide a way to get out of LoggerT by replacing all of the Tells with an action, very similar to logTells but dropping the LoggerT from the result.
Since it will get rid of the LoggerT we'll call it runLoggerT and swap the arguments to match the convention of other transformers.
runLoggerT :: LoggerT w m a -> (w -> m ()) -> m a
runLoggerT la0 k = go la0
where
go (Tell w la ) = k w >> go la
go (M mla) = liftM go mla
go (Return a) = return a
LoggerT already exists, we don't need to write it ourself. It's the Producer from the very mature pipes library.
pipes
The Producer from the pipes library is the correct logging transformer.
type Producer b = Proxy X () () b
Every Proxy has a MonadTrans (Proxy a' a b' b) instance and a Monad m => Monad (Proxy a' a b' b m) instance.
We tell it what to log with yield.
yield :: Monad m => a -> Producer' a m ()
tell = yield
When we know what we want to do with the yields, we replace them with what we want to do using for.
for :: Monad m =>
Proxy x' x b' b m a' ->
(b -> Proxy x' x c' c m b')
-> Proxy x' x c' c m a'
Specialized for Producer and (), for has the type
for :: Monad m =>
Producer b m a ->
(b -> Producer c m ()) ->
Producer c m a
logTells = flip for
If we replace each of the yields with an action in the underlying monad, we won't have anything produced anymore and can run the Proxy with runEffect.
runEffect :: Monad m => Effect m r -> m r
runEffect :: Monad m => Proxy X () () X m r -> m r
runEffect :: Monad m => Producer X m r -> m r
runLoggerT la0 k = runEffect $ for la0 (lift . k)
We can even recover the WriterT with hoist which replaces the underlying monad (every Proxy a' a b' b has an MFunctor instance).
hoist :: (Monad m, MFunctor t) => (forall a. m a -> n a) -> t m b -> t n b
We use hoist to replace the underlying monad with WriterT w m by lifting each m a into WriterT w m a. Then we replace each yield with lift . tell, and run the result.
toWriterT :: (Monad m, Monoid w) => Producer w m r -> WriterT w m r
toWriterT p0 = runEffect $ for (hoist lift p0) (lift . tell)
toWriterT p0 = runLoggerT (hoist lift p0) tell
Producer is essentially the free WriterT that doesn't require a Monoid for the items being written.
Here's a simplified, but definitely real-life example that uses censor (which is defined in terms of pass as
censor :: (MonadWriter w m) => (w -> w) -> m a -> m a
censor f m = pass $ (,f) <$> m
) to collect free variables of a lambda term:
import Control.Monad.Writer
import Data.Set (Set)
import qualified Data.Set as Set
type VarId = String
data Term = Var VarId
| Lam VarId Term
| App Term Term
freeVars :: Term -> Set VarId
freeVars = execWriter . go
where
go :: Term -> Writer (Set VarId) ()
go (Var x) = tell $ Set.singleton x
go (App f e) = go f >> go e
go (Lam x e) = censor (Set.delete x) $ go e
Now, of course you can implement this without all the Writer machinery, but remember this is just a simplified example standing in for some more involved compilation/analysis function, where tracking free variables is just one of the things going on.
The documentation is clear enough? http://hackage.haskell.org/package/mtl-2.2.1/docs/Control-Monad-Writer-Lazy.html#g:1
Examples (run the following in ghci)
import Control.Monad.Writer
runWriterT ( do (a,w) <- listen $ do { tell "foo" ; return 42 } ; tell $ reverse w ; return a )
==> (42,"foooof")
runWriterT ( pass $ do { tell "foo" ; return (42,reverse) } )
==> (42,"oof")
Looking at Learn You a Haskell's definition of the State Monad:
instance Monad (State s) where
return x = State $ \s -> (x,s)
(State h) >>= f = State $ \s -> let (a, newState) = h s
(State g) = f a
in g newState
I don't understand the types of h s and g newState in the lower right-hand side.
Can you please explain their types and what's going on?
State s a is a naming of a function---the "state transformer function"
s -> (a, s)
In other words, it takes an input state s and modifies that state while also returning a result, a. This forms a really general framework of "pure state". If our state is an integer, we can write a function which updates that integer and returns the new value---this is like a unique number source.
upd :: Int -> (Int, Int)
upd s = let s' = s + 1 in (s', s')
Here, a and s end up being the same type.
Now this is all fine and good, except that we're in trouble if we'd like to get two fresh numbers. For that we must somehow run upd twice.
The final result is going to be another state transformer function, so we're looking for a "state transformer transformer". I'll call it compose:
compose :: (s -> (a, s)) -- the initial state transformer
-> (a -> (s -> (b, s))) -- a new state transformer, built using the "result"
-- of the previous one
-> (s -> (b, s)) -- the result state transformer
This is a little hairy looking, but honestly it's fairly easy to write this function. The types guide you to the answer:
compose f f' = \s -> let (a, s') = f s
(b, s'') = f' a s'
in (b, s'')
You'll notice that the s-typed variables, [s, s', s''] "flow downward" indicating that state moves from the first computation through the second leading to the result.
We can use compose to build a function which gets two unique numbers using upd
twoUnique :: Int -> ((Int, Int), Int)
twoUnique = compose upd (\a s -> let (a', s') = upd s in ((a, a'), s'))
These are the basics of State. The only difference is that we recognize there's a common pattern going on inside of the compose function and we extract it. That pattern looks like
(>>=) :: State s a -> (a -> State s b ) -> State s b
(>>=) :: (s -> (a, s)) -> (a -> (s -> (b, s)) -> (s -> (b, s))
It's implemented the same way, too. We just need to "wrap" and "unwrap" the State bit---that's the purpose of State and runState
State :: (s -> (a, s)) -> State s a
runState :: State s a -> (s -> (a, s))
Now we can take compose and compare it to (>>=)
compose f f' = \s -> let (a, s') = f s
(b, s'') = f' a s'
in (b, s'')
(>>=) (State f) f' = State $ \s -> let (a, s') = f s
(b, s'') = runState (f' a) s'
in (b, s'')
The State Monad certainly is confusing the first time you see it. The first thing that's important to understand is its data declaration, which is
newtype State s a = State { runState :: s -> (a,s) }
so a State contains a function with the type s -> (a,s). We can think of this as a function acting on some sort of generator and returning a tuple of a value and a new generator. This is how random numbers work in Haskell, for example: s is the generator while a is the result of the function that takes a generator as input and outputs a random number a (say, of type Int, but it could just as easily be any other type).
Now let's talk about the instance declaration. Recall the type of (>>=) is
Monad m => m a -> (a -> m b) -> m b
In particular, we note that f should have the type a -> m b. In this case, m is State s, so the type of f should be a -> State s b. So now we can break down the instance declaration
(State h) >>= f = State $ \s -> let (a, newState) = h s
(State g) = f a
in g newState
Since f has the type a -> State s b, the type of State g must be State s b (i.e. g :: s -> (b,s)), and since h has the type s -> (a,s), we must have newState :: s. Thus the result of the bind expression is g newState, which is of type (b, s).
For further reading, here is a great article that helped me to understand the State Monad when I first came across it.
From the definition of the State monad at LYAH:
newtype State s a = State { runState :: s -> (a,s) }
This means the argument to the State data constructor is a function which takes a state and produces an a and a new state. Thus h in the example above is a function, and h s computes a and newState.
From Hoogle we see the definition of (>>=) is
(>>=) :: Monad m => m a -> (a -> m b) -> m b
which means f is also a function from a to State s b. Thus it makes sense to give f the argument a, and the result is a State. Just like h, g is the argument to a state constructor which takes a state (in this case newstate) and return a pair (a,newState2).
It might be more instructive to ask what (>>=) actually does: it lifts the function argument to a monad. A State is just a placeholder for a value depending on the current state, which is why the argument to the constructor depends on the state. Thus given a State "value", we first apply the state \s -> let (a, newState) = h s to get the corresponding value and a new state. Now we pass that value to the function (note that the types match up) and get a new state, i.e. a new function from a state to a value. Finally, we evaluate that state at newState to thread the state to the next part of the computation.
I'm working with pipes-4.0.0. In that library, the number of yields to downstream a pipe makes is in general unrelated to the number of awaits from upstream.
But suppose I wanted to build a restricted pipe that enforced that one and only one yield is performed for each await, while still being able to sequence these kinds of pipes using monadic (>>=).
I have observed that, in the bidirectional case, each value requested from upstream by a Proxy is matched with a value sent back. So maybe what I'm searching for is a function of type Proxy a' a () b m r -> Pipe a (Either b a') m r that "reflects" the values going upstream, turning them into additional yields to downstream. Or, less generally, Client a' a -> Pipe a a'. Is such a function possible?
You definitely do not want to use pipes for this. But, what you can do is define a restricted type that does this, do all your connections and logic within that restricted type, then promote it to a Pipe when you are done.
The type in question that you want is this, which is similar to the netwire Wire:
{-# LANGUAGE DeriveFunctor #-}
import Control.Monad.Trans.Free -- from the 'free' package
data WireF a b x = Pass (a -> (b, x)) deriving (Functor)
type Wire a b = FreeT (WireF a b)
That's automatically a monad and a monad transformer since it is implemented in terms of FreeT. Then you can implement this convenient operation:
pass :: (Monad m) => (a -> b) -> Wire a b m ()
pass f = liftF $ Pass (\a -> (f a, ()))
... and assemble custom wires using monadic syntax:
example :: Wire Int Int IO ()
example = do
pass (+ 1)
lift $ putStrLn "Hi!"
pass (* 2)
Then when you're done connecting things with this restricted Wire type you can promote it to a Pipe:
promote :: (Monad m) => Wire a b m r -> Pipe a b m r
promote w = do
x <- lift $ runFreeT w
case x of
Pure r -> return r
Free (Pass f) -> do
a <- await
let (b, w') = f a
yield b
promote w'
Note that you can define an identity and wire and wire composition:
idWire :: (Monad m) => Wire a a m r
idWire = forever $ pass id
(>+>) :: (Monad m) => Wire a b m r -> Wire b c m r -> Wire a c m r
w1 >+> w2 = FreeT $ do
x <- runFreeT w2
case x of
Pure r -> return (Pure r)
Free (Pass f2) -> do
y <- runFreeT w1
case y of
Pure r -> return (Pure r)
Free (Pass f1) -> return $ Free $ Pass $ \a ->
let (b, w1') = f1 a
(c, w2') = f2 b
in (c, w1' >+> w2')
I'm pretty sure those form a Category:
idWire >+> w = w
w >+> idWire = w
(w1 >+> w2) >+> w3 = w1 >+> (w2 >+> w3)
Also, I'm pretty sure that promote obeys the following functor laws:
promote idWire = cat
promote (w1 >+> w2) = promote w1 >-> promote w2
My gut feeling is that this is going to be very hard to do, if not outright impossible. Not only can you write producers and consumers full of complex loops but the monadic interface mans that the control flow of the consumer can depend on the values it gets from the producer.
consumer = do
n <- await
for i in 1..n do
m <- await
print m
Its going to be very hard to encode on the types of the producer that "this produces N + 1 numbers where N is the value of the first number yielded".
Going back on topic, I think you might have a better chance if you use your own combinators instead of the base monadic interface for pipes. For example, the boomerang web routes library uses a set of combinators to simultaneously build the code that does the (Route -> URL) conversion and teh code that does the (URL -> Route) conversion, thus guaranteeing that they are compatible and inverses of each other.
Is there some way to write a function f :: (a -> b -> ... -> t) -> (Monad m => m a -> m b -> ... -> m t), basically liftMn for any n?
(EDIT: fixed nonsensical example.)
I'm writing an FRP library, and thought it'd be neat if I could have code vaguely like:
main = do
input1 <- signalFromTextBoxTheUserMayTypeANumberInto
input2 <- signalFromAnotherTextBox
divided <- signal div input1 input2
signal (\x -> showTextAlert ("input1 `div` input2 is " ++ show x)) divided
I've been fiddling with type families to get it working, but I'm starting to think that it's actually not doable. I'm currently doing something like this:
type Action a = IORef a -> IO ()
type Listener = IO ()
newtype Signal a = Signal (IORef (SigData a))
data SigData a = SigData {
trigger :: Action a,
output :: IORef a,
listeners :: [Listener]
}
class Sig a where
type S a
mkSig :: [AnySignal] -> a -> S a
instance Sig b => Sig (a -> b) where
type S (a -> b) = Signal a -> S b
mkSig dependencies f =
\s#(Signal sig) ->
let x = unsafePerformIO $ readIORef sig >>= readIORef . output
in mkSig (AnySignal s : dependencies) (f x)
instance Sig Int where
type S Int = IO (Signal Int)
out <- newIORef x
self <- Signal <$> (newIORef $ SigData {
trigger = \ref -> writeIORef ref $! x,
output = out,
listeners = []
})
mapM_ (self `listensTo`) deps
return self
This obviously doesn't work, as the unsafePerformIO gets evaluated once and then keeps that value, and if did work it'd still be ugly, hacky and generally evil. Is there a way to do this, or will I just have to let go of the idea?
I'm kind of new to all of this, so forgive me if this is a silly answer, but isn't this exactly what applicative functors are for?
Applicatives let you do something like:
f :: a -> b -> ... -> c
f2 :: Applicative p => p a -> p b ... -> p c
f2 x ... y = f <$> x <*> ... <*> y
if I'm not mistaken. (The ellipses are any number of types/arguments)
How about the Strathclyde Haskell Environment preprocessor, which lets you use idiom brackets, the original notation for applicative functors? This lets you use (| f a b c |) for f <$> a <*> b <*> c. Your example would be (| input1 `div` input2 |).
By the way, it's probably a bad idea for your Signal type to have a Monad instance; this causes the well-known (in the FRP community) problem of time leaks; see this blog post for more information. An Applicative interface is OK, but a Monad interface is not. There are several solutions that prevent time leaks while still allowing the same dynamic event switching behaviour, involving things like an additional type parameter or another monad (as seen in, e.g. the sodium library).