{-# LANGUAGE Arrows #-} module Tutorial1 ( main -- * Tutorial 1 -- Coinslot -- ** Introduction -- $intro -- ** Overview -- $overview -- ** Program Structure -- $structure -- ** IO -- $io -- ** Logic -- $logic ) where import FRP.Timeless import Control.Concurrent import System.IO -- $intro -- This series of tutorial aims at its corresponding major version of Timeless. For example, -- a version number of 1.x.x.x means it should be compatible with Timeless version >= 1 and < 2. -- -- As a project goal, this tutorial series will also aid the development and refactor of Timeless. -- Major breakage is unlikely if you don't use underlying 'Signal's directly. However, if you do, -- good luck. And it is important that, if you have seen my timeless-0.9.x.x tutorials, they would -- probably still work with modifications. However, that version is way too primitive and messy to -- write, and doesn't really give any advantage of FRP, and gave me much more headache than writing -- using "normal" methods. -- -- This series should hopefully guide you to be familiar with "my" way of FR. Of course, I do not -- have real serious UI experiences, so I am also learning. Again, expect radical changes, but the -- code should still work. -- -- Feel free to skip this section if you don't want to read stories. -- -- Now, why would I write Timeless? -- -- Because I intuitively think FRP is the way to go. I have read /Functional Reactive Programming/, -- and I tried to learn Netwire because of the nice Arrow syntax. -- -- And of course, Timeless is forked originally from Netwire 5 because it is unmaintained and incomplete. -- And Timeless is just a random name I gave it. As of version 1, Timeless is really, timeless, -- because I removed the Session(with time information) that feeds into every 'Signal', as inherited -- from Netwire. The reason is, I think this makes reasoning with purity much harder, and I'd rather -- explicitly put down an IO signal just to read the time. That should compose much better. -- -- Timeless 1 imitates the /primitives/ like /Sodium/ as described in the book -- /Functional Reactive Programming/. Of course, since Timeless works on 'Arrows' instead of end -- points, exact details are different, and will be shown in the tutorials. -- -- Backstory nonsense is enough, and I will start to explain how to design a coinslot machine. -- $overview -- This program does one thing. -- -- > Current Coins: 0 -- > >>> Hello -- > Current Coins: 0 -- > >>> insert -- > Current Coins: 1 -- > >>> insert -- > Current Coins: 2 -- > >>> -- -- -- That's it. There is only one command, @insert@, which increments the coin coint. Everything else -- be ignored. Now proceed to writing the program! -- -- $structure -- As described in the book I mentioned multiple times, any Timeless program have two types of -- primitive signals: 'Stream' and 'Cell'. Names are from the book directly. 'Stream' represents -- a stream of events, which can arriveat any time, and only contains value when it is fired. -- 'Cell' represents continuous value in time, therefore always has a value. In a program, -- 'Cell's are used to store state, while 'Stream's model interaction. Detailed usage of primitives -- will be explained on the go. -- -- Also notice that most primitives are /transparent/ or /atomic/, which means the output value is -- immediately available. Except for the 'delay' primitive, which delays the information for an -- infinitesimal amount of time. For those have worked with state machines on FPGA, it should be -- obvious that if all primitives give delay, nasty timing design must be considered. This defeats -- the reason to use FRP at all, and makes programming as hard as designing hardware. -- -- The atomic property follows that, nothing should ever block, or ever cause any side effects inside -- a 'Stream' or 'Cell'. Description of performing side effects will be shown in next section. -- In addition, anything that blocks, or takes significant time should be forked to another thread, -- and use 'MVar' or alike to communicate. Detailed -- explanation is in the next section. -- $io -- To make the program easier to test, the first part to complete is IO. Let's do the simpler first: -- printing. -- -- We are not using any fancy ANSI terminal things, just a good old command line. Therefore, the simple -- 'putStr' function is enough, which updates every time Enter is pressed. Of course, `getLine` will -- echo input, so that part is automatically solved. -- -- Since this is a simple terminal, we should not print information continuously, or garbage will -- quickly flood the console. This gives the decision to make this output a 'Stream', as it is -- discrete. In this series, I will always prepend @s@ to the name of a 'Stream'. -- -- > sPutStrSink = sinkS $ \s -> putStr s >> hFlush stdout -- -- Time for some explanation. 'StreamSink' can be seen as a black box which devours value and spits -- nothing out. Perfect for performing side effects, because the effects will never be known to -- the rest of the program! Think @IO ()@. And in fact, Timeless provides: -- -- > sinkS :: (a -> IO ()) -> StreamSink a -- -- Therefore, the output is very straightforward. Notice that 'stdout' should be flushed, or the -- last line will not show up in terminal. -- -- Next, the input is slightly more complicated. To easily get a command, 'getLine' is the most -- straightforward way. However, it blocks! -- -- Now there is a good news. Haskell threads are virtually free, so use as many as you can! Since -- we are communicating using an 'MVar', we need: -- -- > sMVarSource mvar = sourceS $ tryTakeMVar mvar -- -- This 'Stream' fires when a value is present in the 'MVar'. How does that work? Look at the timeless -- provided constructor: -- -- > sourceS :: IO (Maybe b) -> StreamSource b -- -- As you might guess, when the IO action returns @Just b@, the 'Stream' fires with value 'b'. -- @tryTakeMVar@ is a perfect function to fit. -- -- Of course, we need to get that 'MVar' from somewhere, which means a thread must be spawned before -- the network is constructed and ran. -- -- -- > initPrint = do -- > mvar <- newEmptyMVar -- > forkIO $ loop mvar -- > return mvar -- > where -- > loop mvar = do -- > s <- getLine -- > putMVar mvar s -- > loop mvar -- -- -- This action will spawn the thread needed, and returns the 'MVar'. It is possible to do the -- initialization with just timeless(as I did in my previous versions), but it involves using -- 'Signal's directly, and adds quite some complexity to the final network. For now, use this -- simpler way. -- -- Now there is input and output. Let's test it! -- -- -- > testBox mvar = proc () -> do -- > str <- sMVarSource mvar -< () -- > sPutStrSink -< str -- -- -- "Box" is my name for a network of signals which is totally opaque. The box driver just keeps -- updating the box, and only cares whether it is shut down. In this tutorial, the "shut down" -- part is ignored. -- -- If you have seen the 'Arrow' syntax before, the flow should be straightforward. If you have -- not, just remember that 'proc' is like lambda, and the '()' is the single input that will -- be fed into the 'Arrow'. Here, since 'testBox' is a black box, the only input is '()', -- which is "no information except for its presence". Another important fact is that, the part -- between @<-@ and @-<@ are the Arrows themselves, while the outer part are their inputs and -- outputs. The Arrow network is static on compile time, and the "inner" and "outer" part have -- different scope, so do not try to reference variables between the two parts. One last note -- is that 'Arrow' does not have currying. Unfortunately, currying is a special property of -- functions, not the more generic Arrows. If you need more than one input, use a tuple or some -- ADT. -- -- To explain the box, the source is driven by the input @()@. This is mandatory since every -- arrow needs an input. It outputs to @str@, which is fed into the sink arrow. The box -- is driven as follows: -- -- -- > main = do -- > mvar <- initPrint -- > runBox $ testBox mvar -- -- -- Initialization is performed, and box is driven. Done! -- -- The final result is a program that echos lines of input. -- $logic -- First, we need to parse the command. Since we don't have any fancy function except for -- incrementing, parsing the command to be a 'Stream' of '()' is enough. This stream should -- fire whenever the command is "insert", so: -- -- > parse "insert" = Just () -- > parse _ = Nothing -- -- Bingo! Next, we need to store the current count of coins. -- -- > accumulator (_, coin) = coin + 1 -- -- The reason to do this is, Timeless gives a helper to construct a state: -- -- > state :: s -> ((a, s) -> s) -> StreamCell a s -- -- 'StreamCell' just means that it takes a 'Stream' as input, and outputs as a 'Cell'. -- The first parameter is the initial value, while the second is a function of state transition. -- Of course, @s@ is the state, and @a@ is the event. Here, 'accumulator' will count up -- whenever the input is fired. -- -- Next, we need to display the coin count, so we need a string. -- -- > display coin = "Current coins: " ++ (show coin) ++ "\n>>> " -- -- This function gives the string to display current coin count, and the prompt. -- -- FInally, we are coming to the point to print the screen. However, there is a problem. -- -- Remember we said that display is updated when Enter is pressed? -- -- What about when the program just started? -- -- This problem is solved in two parts. -- -- First, since we need a 'Stream' to display, some sort of sampler is needed. This -- 'Signal' will be used: -- -- > sample :: Signal IO (Maybe a, b) (Maybe b) -- -- I havn't introduced 'Signal' because using that directly will mess up the code. For now, -- just understand that 'sample' takes two input, when @Stream a@ fires, @Cell b@ would be -- sampled and fired on the Stream output. -- -- With this in mind, we need some trigger 'Stream' that fires once on startup, and -- on every subsequent Enter keypress. -- -- Nicely, Timeless has the following 'Stream' which does exactly as advertised: -- -- > onceS :: b -> StreamSource b -- -- The two triggers must be merged somehow. And here is the signal: -- -- > mergeSP :: Signal IO (Maybe a, Maybe a) (Maybe a) -- -- It is easy to guess that this 'Signal' takes two 'Stream's as input, and outputs one -- 'Stream'. More specifically, it prioritizes the first stream in case there is a -- simultaneous arrival. -- -- With these tools we can finally construct the real box. -- -- -- > box mvar = proc () -> do -- > sCommand <- sMVarSource mvar -< () -- > sTrigger <- arrS (const ()) -< sCommand -- > sAccumTrig <- arr (>>=parse) -< sCommand -- > cCoin <- state 0 accumulator -< sAccumTrig -- > cDisplay <- arr display -< cCoin -- > sInitTrig <- onceS () -< () -- > sDispTrig <- mergeSP -< (sInitTrig, sTrigger) -- > sDisplay <- sample -< (sDispTrig, cDisplay) -- > sPutStrSink -< sDisplay -- -- -- There are quite a lot going on. The code just does what it looks like, but there are things to note. -- As before, the IO arrows are easy to find, with input -- stored in @sCommand@ and final output in @sDisplay@. @sTrigger@ simply converts -- each input event into the information-less '()', while @sAccumTrig@ fires when -- coin is inserted. The display is triggered by @sDispTrig@, which merges @sInitTrig@ -- and @sTrigger@. Of course, @sInitTrig@ fires only once on startup. -- -- Now, run the program! sMVarSource mvar = sourceS $ tryTakeMVar mvar initPrint :: IO (MVar String) initPrint = do mvar <- newEmptyMVar forkIO $ loop mvar return mvar where loop mvar = do s <- getLine putMVar mvar s loop mvar sPutStrSink = sinkS $ \s -> putStr s >> hFlush stdout display coin = "Current coins: " ++ (show coin) ++ "\n>>> " accumulator :: ((), Integer) -> Integer accumulator (_, coin) = coin + 1 parse "insert" = Just () parse _ = Nothing box mvar = proc () -> do sCommand <- sMVarSource mvar -< () sTrigger <- arrS (const ()) -< sCommand sAccumTrig <- arr (>>=parse) -< sCommand cCoin <- state 0 accumulator -< sAccumTrig cDisplay <- arr display -< cCoin sInitTrig <- onceS () -< () sDispTrig <- mergeSP -< (sInitTrig, sTrigger) sDisplay <- sample -< (sDispTrig, cDisplay) sPutStrSink -< sDisplay testBox mvar = proc () -> do str <- sMVarSource mvar -< () sPutStrSink -< str main :: IO () main = do mvar <- initPrint --runBox $ testBox mvar runBox $ box mvar