Loop with the StateT monad

This is an exercise to learn the StateT monad. The program implements the game Morra. The two players are the computer and a person. The state accumulates the score of the computer and player. The program works for one iteration of function morra only. However I am at a loss how to loop it. I have tried a few things but nothing seems to work. I have narrowed the problem down to the "p <- liftIO getChar" statement. The second time through the loop it isn't executed. I have bracketed the statement with "liftIO $ putStrLn "before" and liftIO $ putStrLn "after". This is the program: module Morra where import Control.Monad.Trans.State.Lazy import Control.Monad.IO.Class import Data.Char (isDigit, digitToInt) import System.Random (randomRIO) import Control.Monad (when) morra :: StateT (Int, Int) IO () morra = do liftIO $ putStrLn "before" p <- liftIO getChar liftIO $ putStrLn "after" when (isDigit p) $ do let p' = digitToInt p c <- liftIO $ randomRIO (1, 2) liftIO $ putStrLn ("P: " ++ [p]) liftIO $ putStrLn ("C: " ++ show c) (pt, ct) <- get if even (c + p') then do liftIO $ putStrLn "Computer Wins" put (pt, ct + 1) else do liftIO $ putStrLn "Player Wins" put (pt + 1, ct) morra main :: IO () main = do putStrLn "-- p is Player" putStrLn "-- c is Computer" putStrLn "-- Player is odds, Computer is evens." (personS,compS) <- execStateT morra (0,0) putStrLn ("Person Score: " ++ show personS) putStrLn ("Computer Score: " ++ show compS) if personS > compS then putStrLn "Winner is Person" else putStrLn "Winner is Computer" and this is the output: *Morra> main -- p is Player -- c is Computer -- Player is odds, Computer is evens. before 1 after P: 1 C: 2 Player Wins before after Person Score: 1 Computer Score: 0 Winner is Person *Morra>

On Sat, Mar 18, 2017 at 1:52 AM,
I have narrowed the problem down to the "p <- liftIO getChar" statement.
It does run the second time, and gets the newline following the entered character. You should probably use getLine, or learn how your platform switches between default line-oriented input and character-oriented --- and how to switch it back afterward. (In C on Unix-like systems, this involves termios.) -- brandon s allbery kf8nh sine nomine associates allbery.b@gmail.com ballbery@sinenomine.net unix, openafs, kerberos, infrastructure, xmonad http://sinenomine.net

Am 18.03.2017 um 07:45 schrieb Brandon Allbery:
On Sat, Mar 18, 2017 at 1:52 AM,
wrote: I have narrowed the problem down to the "p <- liftIO getChar" statement.
It does run the second time, and gets the newline following the entered character. You should probably use getLine, or learn how your platform switches between default line-oriented input and character-oriented --- and how to switch it back afterward. (In C on Unix-like systems, this involves termios.)
System.IO.hSetBuffering is your friend ben@yuiitsu1:~> ghci Prelude> import System.IO Prelude System.IO> :info hSetBuffering hSetBuffering :: Handle -> BufferMode -> IO () Prelude System.IO> :info BufferMode data BufferMode = NoBuffering | LineBuffering | BlockBuffering (Maybe Int) Prelude System.IO> hSetBuffering stdin NoBuffering Prelude System.IO> getChar >> getChar Prelude System.IO> getChar >> getChar xy'y' # prompt returns immediately after i hit 'y' Prelude System.IO>

On Sat, Mar 18, 2017 at 6:27 PM, Ben Franksen
System.IO.hSetBuffering is your friend
Except when it's your enemy: https://github.com/commercialhaskell/stack/issues/2884 see also http://tunes.org/~nef/logs/haskell/17.03.18 at 02:48:19 and following. This conflation is stupid, prone to cause problems when multiple processes are involved, and needs to go away. Trying to hide the difference between buffering and tty mode from users just causes problems, because buffering is process local but the tty mode is shared between all processes using the tty. -- brandon s allbery kf8nh sine nomine associates allbery.b@gmail.com ballbery@sinenomine.net unix, openafs, kerberos, infrastructure, xmonad http://sinenomine.net

Am 18.03.2017 um 23:34 schrieb Brandon Allbery:
On Sat, Mar 18, 2017 at 6:27 PM, Ben Franksen
wrote: System.IO.hSetBuffering is your friend
Except when it's your enemy: https://github.com/commercialhaskell/stack/issues/2884 see also http://tunes.org/~nef/logs/haskell/17.03.18 at 02:48:19 and following.
This conflation is stupid, prone to cause problems when multiple processes are involved, and needs to go away. Trying to hide the difference between buffering and tty mode from users just causes problems, because buffering is process local but the tty mode is shared between all processes using the tty.
I don't understand. """ geekosaur commented on 30 Dec 2016 some ghc versions back, ghc's Unix runtime started conflating NoBuffering with stty -icanon """ What exactly is meant here with "conflate"? When you turn off buffering for stdin, then of course backspace cannot work. That should be clear. Cheers Ben

On Sat, Mar 18, 2017 at 6:51 PM, Ben Franksen
What exactly is meant here with "conflate"?
Confusing two distinct mechanisms that appear on the surface to be similar. See below for why this is an inappropriate conflation.
When you turn off buffering for stdin, then of course backspace cannot work. That should be clear.
Except that is not true anywhere but recent versions of ghc's runtime, and (specifically because they use readline or editline) things like Python's REPL. Try it in a simple C program. Buffering means the program reads in chunks instead of character at a time. This is an attribute of a program, specifically of whatever I/O library it is using. It does not include line editing (you don't generally want to interpret a backspace in a text file you are reading. You *certainly* don't want to interpret control-C or control-D). Things like backspace *do not live in the program*, unless you are using a library like readline or editline. For most programs, they rely on the tty driver to do this. This is why stty works from the shell, not as instrumentation for whatever program. The default on Unixlikes is line mode (stty icanon), which implements basic line editing and only sends a line to the program when you press Enter or the EOF character (in the middle of a line, this will send the incomplete line; press it a second time, or on an empty line, and the program gets a zero-character read response, which is the standard Unix EOF indication). In ghc this is complicated by two things: - ghci uses haskeline, a readline alternative, so the tty is always in -icanon. Compiled ghc programs do not use haskeline unless specifically written to do so. - At some point, the ghc runtime started tweaking termios settings in hSetBuffering. This is incomplete (per the IRC log I mentioned, apparently nothing at all is done with LineBuffering), and causes confusion when multiple ghc-compiled programs are involved (the program starts out in LineBuffering and assumes stty icanon, but whether the tty is in icanon or -icanon depends on what the invoking program did; this is the stack bug I linked). On Windows, this works differently; IIRC, whether you see "character mode" or "line mode" depends on which API you use for reads, and line editing indeed lives within the program. -- brandon s allbery kf8nh sine nomine associates allbery.b@gmail.com ballbery@sinenomine.net unix, openafs, kerberos, infrastructure, xmonad http://sinenomine.net

Am 19.03.2017 um 00:08 schrieb Brandon Allbery:
On Sat, Mar 18, 2017 at 6:51 PM, Ben Franksen
wrote: What exactly is meant here with "conflate"?
Confusing two distinct mechanisms that appear on the surface to be similar. See below for why this is an inappropriate conflation.
My question was meant as "technically, how exactly do they do the conflation". So IIUC you say that when I use hSetBuffering, nowadays it does /more/ then just change buffering mode, it /also/ (sometimes) reconfigures the terminal. And this is the reason it can be used for the purpose of the OP but it is a bad idea to rely on that because that 'feature' was a bad idea in the first place.
When you turn off buffering for stdin, then of course backspace cannot work. That should be clear.
Except that is not true anywhere but recent versions of ghc's runtime, and (specifically because they use readline or editline) things like Python's REPL. Try it in a simple C program.
I was not aware of that. I just tried it in C and it turns out you are right.
Buffering means the program reads in chunks instead of character at a time. This is an attribute of a program, specifically of whatever I/O library it is using.
Of course.
It does not include line editing (you don't generally want to interpret a backspace in a text file you are reading. You *certainly* don't want to interpret control-C or control-D).
Hm, no, probably not.
Things like backspace *do not live in the program*, unless you are using a library like readline or editline.
As long as you leave control over these things to the terminal, yes. But what if your program wants to control that itself? E.g. react to keystrokes, rather than edited lines, as the OP seemed to want? I guess what I want to say/ask is: if it is a bad idea to conflate terminal configuration and buffering (and i agree it is: it mis-educated me to think this is how it works in Unix), could and should not Haskell still offer a simple and portable way to configure this (explicitly) from inside the program? Should I import haskeline just to turn off the terminal's line editing mode? Cheers Ben

On Sat, Mar 18, 2017 at 7:57 PM, Ben Franksen
As long as you leave control over these things to the terminal, yes. But what if your program wants to control that itself? E.g. react to keystrokes, rather than edited lines, as the OP seemed to want?
https://downloads.haskell.org/~ghc/8.0.2/docs/html/libraries/unix-2.7.2.1/Sy... Admittedly some wrappers would be nice... but with care, lest you reproduce the same issues stack is having. -- brandon s allbery kf8nh sine nomine associates allbery.b@gmail.com ballbery@sinenomine.net unix, openafs, kerberos, infrastructure, xmonad http://sinenomine.net

Am 19.03.2017 um 01:27 schrieb Brandon Allbery:
On Sat, Mar 18, 2017 at 7:57 PM, Ben Franksen
wrote: As long as you leave control over these things to the terminal, yes. But what if your program wants to control that itself? E.g. react to keystrokes, rather than edited lines, as the OP seemed to want?
https://downloads.haskell.org/~ghc/8.0.2/docs/html/libraries/unix-2.7.2.1/Sy...
Can System.Posix.Terminal be used on Windows?
Admittedly some wrappers would be nice... but with care, lest you reproduce the same issues stack is having.
Right. With hindsight it seems obvious how to do this right: save the initial terminal settings and restore them when the program exits. Let's see if haskeline does the right thing. The following seems to work: import System.Console.Haskeline getKey = runInputT defaultSettings (getInputChar "") main = getKey >>= print Now we want to see if this leaves the terminal in the same state as it was before. Unfortunately the obvious thing doesn't work: import System.Console.Haskeline import System.Posix.Terminal getKey = runInputT defaultSettings (getInputChar "") main = do before <- getTerminalAttributes 0 getKey >>= print after <- getTerminalAttributes 0 print (before == after) because there is no Eq instance for TerminalAttributes. So I asked stty: before=$(stty -a) ./test after=$(stty -a) if test "$before" = "$after"; then echo good; else echo bad; fi and that reports "good". So, perhaps a better answer to the OP would have been: import System.Console.Haskeline then define getKey = runInputT defaultSettings (getInputChar "") and use that instead of getChar. Cheers Ben
participants (3)
-
Ben Franksen
-
Brandon Allbery
-
p75213@gmail.com