State monad: How to `print` intermediate value in Haskell - haskell

I'm new in haskell and I have following code
module StateTest where
import Control.Monad.State.Lazy
tick :: State Int Int
tick = do n <- get
put (n+1)
return n
plusOne :: Int -> Int
plusOne = execState tick
main = print $ plusOne 1
And I want to print state value after put (n+1) and continue computation like this
tick = do n <- get
put (n+1)
print
return n
How whole code will look following to this?

If you want to run IO actions within a state computation you can change the type of tick to return a StateT Int IO Int and use liftIO. Then you can run it using execStateT:
import Control.Monad.State.Lazy
import Control.Monad.IO.Class (liftIO)
tick :: StateT Int IO Int
tick = do n <- get
put (n+1)
liftIO $ print (n+1)
return n
plusOne :: Int -> IO Int
plusOne = execStateT tick
main = plusOne 1 >> pure ()

Another option, since you would have to use IO anyway to print a value in the intermediate state, would be to use IORef. It's a container that has an updateable value.
module Main where
import Data.IORef
tick :: IORef Int -> IO (IORef Int)
tick ref = do
modifyIORef' ref (+1)
-- you can also print here since it is IO
pure ref
main :: IO ()
main = do
counter <- newIORef 0
tick counter
v2 <- readIORef counter
print v2
tick counter
v2 <- readIORef counter
print v2
You can then clean it up with ReaderT.
module Main where
import Data.IORef
import Control.Monad.Reader
readerTick :: ReaderT (IORef Int) IO ()
readerTick = do
ref <- ask
-- can also print here with liftIO $ print ...
liftIO $ modifyIORef' ref (+1)
main :: IO ()
main = do
counter <- newIORef 0
runReaderT readerTick counter
v1 <- readIORef counter
print v1
runReaderT readerTick counter
v2 <- readIORef counter
print v2

Related

Why is this variable out of scope? (Haskell)

I'll get right to it (I removed a bunch of extraneous code, in case this looks a little funny -- trying to make this a MCVE):
import System.IO
import Control.Monad
import Data.IORef
main :: IO ()
main = do
hSetBuffering stdout NoBuffering
input_line <- getLine
let input = words input_line
let x0 = read (input!!0) :: Int
x <- newIORef x0
loop
loop :: IO ()
loop = do
input_line <- getLine
let the_dir = input_line :: String
putStrLn x
loop
Just to test it I tried outputting x and it's saying it's out of scope. Why? How do I fix it so it is in scope? I need to access the variables but I also need to have them initialized before I enter the loop for the first time.
You can make x a parameter.
import System.IO
import Control.Monad
import Data.IORef
main :: IO ()
main = do
hSetBuffering stdout NoBuffering
input_line <- getLine
let input = words input_line
let x0 = read (input!!0) :: Int
x <- newIORef x0
loop x
loop :: Int -> IO ()
loop x = do
input_line <- getLine
let the_dir = input_line :: String
putStrLn $ show x
loop
Or simply use forever.
import Control.Monad
...
x <- newIORef x0
forever $ do
input_line <- getLine
let the_dir = input_line :: String
putStrLn $ show x

Simple Haskell program not behaving correct

I'm new to Haskell and trying to write simple program to find maximal element and it's index from intput. I receive values to compare one by one. Maximal element I'm holding in maxi variable, it's index - in maxIdx. Here's my program:
loop = do
let maxi = 0
let maxIdx = 0
let idx = 0
let idxN = 0
replicateM 5 $ do
input_line <- getLine
let element = read input_line :: Int
if maxi < element
then do
let maxi = element
let maxIdx = idx
hPutStrLn stderr "INNER CHECK"
else
hPutStrLn stderr "OUTER CHECK"
let idx = idxN + 1
let idxN = idx
print maxIdx
loop
Even though I know elements coming are starting from bigger to smaller (5, 4, 3, 2, 1) program enters INNER CHECK all the time (it should happen only for the first element!) and maxIdx is always 0.
What am I doing wrong?
Thanks in advance.
Anyway, let's have fun.
loop = do
let maxi = 0
let maxIdx = 0
let idx = 0
let idxN = 0
replicateM 5 $ do
input_line <- getLine
let element = read input_line :: Int
if maxi < element
then do
let maxi = element
let maxIdx = idx
hPutStrLn stderr "INNER CHECK"
else
hPutStrLn stderr "OUTER CHECK"
let idx = idxN + 1
let idxN = idx
print maxIdx
loop
is not a particularly Haskelly code (and as you know is not particularly correct).
Let's make if Haskellier.
What do we do here? We've an infinite loop, which is reading a line 5 times, does something to it, and then calls itself again for no particular reason.
Let's split it:
import Control.Monad
readFiveLines :: IO [Int]
readFiveLines = replicateM 5 readLn
addIndex :: [Int] -> [(Int, Int)]
addIndex xs = zip xs [0..]
findMaxIndex :: [Int] -> Int
findMaxIndex xs = snd (maximum (addIndex xs))
loop :: ()
loop = loop
main :: IO ()
main = do xs <- readFiveLines
putStrLn (show (findMaxIndex xs))
snd returns the second element from a tuple; readLn is essentially read . getLine; zip takes two lists and returns a list of pairs; maximum finds a maximum value.
I left loop intact in its original beauty.
You can be even Haskellier if you remember that something (huge expression) can be replaced with something $ huge expression ($ simply applies its left operand to its right operand), and the functions can be combined with .: f (g x) is the same as (f . g) x, or f . g $ x (see? it's working for the left side as well!). Additionally, zip x y can be rewritten as x `zip` y
import Control.Monad
readFiveLines :: IO [Int]
readFiveLines = replicateM 5 readLn
addIndex :: [Int] -> [(Int, Int)]
addIndex = (`zip` [0..])
findMaxIndex :: [Int] -> Int
findMaxIndex = snd . maximum . addIndex
main :: IO ()
main = do xs <- readFiveLines
putStrLn . show . findMaxIndex $ xs
As for debug print, there's a package called Debug.Trace and a function traceShow which prints its first argument (formatted with show, hence the name) to stderr, and returns its second argument:
findMaxIndex :: [Int] -> Int
findMaxIndex = snd . (\xs -> traceShow xs (maximum xs)) . addIndex
That allows you to tap onto any expression and see what's coming in (and what are the values around — you can show tuples, lists, etc.)
I think alf's answer is very good, but for what it's worth, here's how I would interpret your intention.
{-# LANGUAGE FlexibleContexts #-}
module Main where
import System.IO
import Control.Monad.State
data S = S { maximum :: Int
, maximumIndex :: Int
, currentIndex :: Int }
update :: Int -> Int -> S -> S
update m mi (S _ _ ci) = S m mi ci
increment :: S -> S
increment (S m mi ci) = S m mi (ci+1)
next :: (MonadIO m, MonadState S m) => m ()
next = do
S maxi maxIdx currIdx <- get
input <- liftIO $ getLine
let element = read input :: Int
if maxi < element
then do
modify (update element currIdx)
liftIO $ hPutStrLn stderr "INNER CHECK"
else
liftIO $ hPutStrLn stderr "OUTER CHECK"
modify increment
run :: Int -> IO S
run n = execStateT (replicateM_ n next) (S 0 0 0)
main :: IO ()
main = do
S maxi maxIdx _ <- run 5
putStrLn $ "maxi: " ++ (show maxi) ++ " | maxIdx: " ++ (show maxIdx)
This uses a monad transformer to combine a stateful computation with IO. The get function retrieves the current state, and the modify function lets you change the state.

Stateful integer generation in Haskell

I'd like to write a Haskell function to generate integers. The function would return 1 the first time it is called, then return the next integer each subsequent time the function is called.
In Python I've used the idea of generators — an integer generator might look something like this:
def intGen():
x = 1
while True:
yield x
x += 1
integer = intGen()
# Use the generator
next(integer) # 1
next(integer) # 2
next(integer) # 3
How do I accomplish something like this in Haskell? I know I probably need the State monad, but I'm not quite sure on how to set that up; I am fairly new to monads.
Haskell is pure, function can't generate different data on same arguments.
If you really want to use it, you should use IO a or ST a data, like IORef a and STRef a.
But you could use pure methods in different way:
intGen = [1 .. 10]
intRes = map next intGen
Using IORefs, you could do something like
import Data.IORef
import Control.Monad ((=<<))
type IntGen = IORef Int
intGen :: IO IntGen
intGen = newIORef 1
next :: IntGen -> IO Int
next gen = do
val <- readIORef gen
writeIORef gen $ val + 1
return val
main :: IO ()
main = do
integer <- intGen
-- f =<< m == m >>= f
print =<< next integer
print =<< next integer
print =<< next integer
Or you can use the State monad to do this purely:
import Control.Monad.State
next :: Monad m => StateT Int m Int
next = do
val <- get
put $ val + 1
return val
app :: StateT Int IO ()
app = do
let stprint = liftIO . print
stprint =<< next
stprint =<< next
stprint =<< next
main :: IO ()
main = void $ runStateT app 1
In the second one, your initial value is the 1 supplied to runStateT, so it's more flexible in that you can start from different values.
All this being said, usually when you need lazily generated integer values, a list is the way to go. For example, I might have something like
def processFile(directory):
integer = intGen()
for fname in os.listdir(directory):
full_fname = os.path.join(directory, fname)
if os.path.isfile(full_fname):
i = next(integer)
new_fname = '{}-{}'.format(i, fname)
os.rename(full_fname, os.path.join(directory, new_fname))
but in Haskell I'd prefer to write something like
import Control.Monad
import System.Directory
import System.FilePath
processFiles :: FilePath -> IO ()
processFiles directory = do
contents <- getDirectoryContents directory
files <- filterM doesFileExist $ map (directory </>) contents
forM_ (zip [1..] files) $ \(i, fname) -> do
let newFName = show i ++ "-" ++ fname
renameFile (directory </> fname) (directory </> newFName)

MVars are blocking indefinitely; but only in certain scenarios.

First, because this is about a specific case, I haven't reduced the code at all, so it will be quite long, and in 2 parts (Helper module, and the main).
SpawnThreads in ConcurHelper takes a list of actions, forks them, and gets an MVar containing the result of the action. It them combines the results, and returns the resulting list. It works fine in certain cases, but blocks indefinitely on others.
If I give it a list of putStrLn actions, it executes them fine, then returns the resulting ()s (yes, I know running print commands on different threads at the same time is bad in most cases).
If I try running multiTest in Scanner though (which takes either scanPorts or scanAddresses, the scan range, and the number of threads to use; then splits the scan range over the threads, and passes the list of actions to SpawnThreads), it will block indefinitely. The odd thing is, according to the debug prompts scattered around ConcurHelper, on each thread, ForkIO is returning before the MVar is filled. This would make sense if it wasn't in a do block, but shouldn't the actions be performed sequentially? (I don't know if this is related to the problem or not; it's just something I noticed while attempting to debug it).
I've thought it out step by step, and if it's executing in the order laid out in spawnThreads, the following should happen:
An empty MVar should be created inside forkIOReturnMVar, and passed to mVarWrapAct.
mVarWrapAct should execute the action, and put the result in the MVar (this is where the problem seems to lie. "MVar filled" is never shown, suggesting the MVar is never put into)
getResults should then take from the resulting list of MVars, and return the results
If point #2 isn't the issue, I can see where the problem would be (and if it is the issue, I can't see why putMVar never executes. Inside the scanner module, the only real function of interest for this question is multiTest. I only included the rest so it could be run).
To do a simple test, you can run the following:
spawnThreads [putStrLn "Hello", putStrLn "World"] (should return [(),()])
multiTest (scanPorts "127.0.0.1") 1 (0,5) (Creates the MVar, hangs for a sec, then crashes with the aforementioned error)
Any help in understanding whats going on here would be appreciated. I can't see what the difference between the 2 use cases are.
Thank you
(And I'm using this atrocious exception handling system because IO errors don't give codes for specific network exceptions, so I've been left with parsing messages to find out what happened)
Main:
module Scanner where
import Network
import Network.Socket
import System.IO
import Control.Exception
import Control.Concurrent
import ConcurHelper
import Data.Maybe
import Data.Char
import NetHelp
data NetException = NetNoException | NetTimeOut | NetRefused | NetHostUnreach
| NetANotAvail | NetAccessDenied | NetAddrInUse
deriving (Show, Eq)
diffExcept :: Either SomeException Handle -> Either NetException Handle
diffExcept (Right h) = Right h
diffExcept (Left (SomeException m))
| err == "WSAETIMEDOUT" = Left NetTimeOut
| err == "WSAECONNREFUSED" = Left NetRefused
| err == "WSAEHOSTUNREACH" = Left NetHostUnreach
| err == "WSAEADDRNOTAVAIL" = Left NetANotAvail
| err == "WSAEACCESS" = Left NetAccessDenied
| err == "WSAEADDRINUSE" = Left NetAddrInUse
| otherwise = error $ show m
where
err = reverse . dropWhile (== ')') . reverse . dropWhile (/='W') $ show m
extJust :: Maybe a -> a
extJust (Just a) = a
selectJusts :: IO [Maybe a] -> IO [a]
selectJusts mayActs = do
mays <- mayActs; return . map extJust $ filter isJust mays
scanAddresses :: Int -> Int -> Int -> IO [String]
scanAddresses port minAddr maxAddr =
selectJusts $ mapM (\addr -> do
let sAddr = "192.168.1." ++ show addr
print $ "Trying " ++ sAddr ++ " " ++ show port
connection <- testConn sAddr port
if isJust connection
then do hClose $ extJust connection; return $ Just sAddr
else return Nothing) [minAddr..maxAddr]
scanPorts :: String -> Int -> Int -> IO [Int]
scanPorts addr minPort maxPort =
selectJusts $ mapM (\port -> do
--print $ "Trying " ++ addr ++ " " ++ show port
connection <- testConn addr port
if isJust connection
then do hClose $ extJust connection; return $ Just port
else return Nothing) [minPort..maxPort]
main :: IO ()
main = do
withSocketsDo $ do
putStrLn "Scan Addresses or Ports? (a/p)"
choice <- getLine
if (toLower $ head choice) == 'a'
then do
putStrLn "On what port?"
sPort <- getLine
addrs <- scanAddresses (read sPort :: Int) 0 255
print addrs
else do
putStrLn "At what address?"
address <- getLine
ports <- scanPorts address 0 9999
print ports
main
testConn :: HostName -> Int -> IO (Maybe Handle)
testConn host port = do
result <- try $ timedConnect 1 host port
let result' = diffExcept result
case result' of
Left e -> do putStrLn $ "\t" ++ show e; return Nothing
Right h -> return $ Just h
setPort :: AddrInfo -> Int -> AddrInfo
setPort addInf nPort = case addrAddress addInf of
(SockAddrInet _ host) -> addInf { addrAddress = (SockAddrInet (fromIntegral nPort) host)}
getHostAddress :: HostName -> Int -> IO SockAddr
getHostAddress host port = do
addrs <- getAddrInfo Nothing (Just host) Nothing
let adInfo = head addrs
newAdInfo = setPort adInfo port
return $ addrAddress newAdInfo
timedConnect :: Int -> HostName -> Int -> IO Handle
timedConnect time host port = do
s <- socket AF_INET Stream defaultProtocol
setSocketOption s RecvTimeOut time; setSocketOption s SendTimeOut time
addr <- getHostAddress host port
connect s addr
socketToHandle s ReadWriteMode
multiTest :: (Int -> Int -> IO a) -> Int -> (Int, Int) -> IO [a]
multiTest partAction threads (mi,ma) =
spawnThreads $ recDiv [mi,perThread..ma]
where
perThread = ((ma - mi) `div` threads) + 1
recDiv [] = []
recDiv (curN:restN) =
partAction (curN + 1) (head restN) : recDiv restN
Helper:
module ConcurHelper where
import Control.Concurrent
import System.IO
spawnThreads :: [IO a] -> IO [a]
spawnThreads actions = do
ms <- mapM (\act -> do m <- forkIOReturnMVar act; return m) actions
results <- getResults ms
return results
forkIOReturnMVar :: IO a -> IO (MVar a)
forkIOReturnMVar act = do
m <- newEmptyMVar
putStrLn "Created MVar"
forkIO $ mVarWrapAct act m
putStrLn "Fork returned"
return m
mVarWrapAct :: IO a -> MVar a -> IO ()
mVarWrapAct act m = do a <- act; putMVar m a; putStrLn "MVar filled"
getResults :: [MVar a] -> IO [a]
getResults mvars = do
unpacked <- mapM (\m -> do r <- takeMVar m; return r) mvars
putStrLn "MVar taken from"
return unpacked
Your forkIOReturnMVar isn't exception safe: whenever act throws, the MVar isn't going to be filled.
Minimal example
import ConcurHelper
main = spawnThreads [badOperation]
where badOperation = do
error "You're never going to put something in the MVar"
return True
As you can see, badOperation throws, and therefore the MVar won't get filled in mVarWrapAct.
Fix
Fill the MVar with an appropriate value if you encounter an exception. Since you cannot provide a default value for all possible types a, it's better to use MVar (Maybe a) or MVar (Either b a) as you already do in your network code.
In order to catch the exceptions, use one of the operations provided in Control.Exception. For example, you could use onException:
mVarWrapAct :: IO a -> MVar (Maybe a) -> IO ()
mVarWrapAct act m = do
onException (act >>= putMVar m . Just) (putMVar m Nothing)
putStrLn "MVar filled"
However, you might want to preserve the actual exception for more information. In this case you could simply use catch together with Either SomeException a :
mVarWrapAct :: IO a -> MVar (Either SomeException a) -> IO ()
mVarWrapAct act m = do
catch (act >>= putMVar m . Right) (putMVar m . Left)
putStrLn "MVar filled"

How to abort getChar safely?

I would like to optionally abort a getChar action.
I need the following function:
getChar' :: (Char -> IO ()) -> IO (IO ())
In case of abort <- getChar' callback , a character is read from standard input, unless abort is called before a character is available.
If a character is read, callback is called with it.
I have the following prototype implementation:
import Control.Monad
import Control.Concurrent
getChar' :: (Char -> IO ()) -> IO (IO ())
getChar' callback = do
v <- newEmptyMVar
tid <- forkIO $ do
c <- getChar
b <- tryPutMVar v ()
when b $ callback c
return $ do
b <- tryPutMVar v ()
when b $ killThread tid
The problem is that killThread may abort the thread after reading the char but before putting () into the MVar.
I have no idea how to solve this problem, is it possible at all with the base package?
If not, have you seen a similar function implemented in other packages?
I think the easiest way to achieve this is to perform your own buffering. Here's a simple prototype. It assumes that you call launchIOThread exactly once in your program. It doesn't handle EOF or other IO exceptions, but that should be easy.
import Control.Concurrent
import Control.Concurrent.STM
import Data.Maybe
import Control.Monad
type Buffer = TVar (Maybe Char)
launchIOThread :: IO Buffer
launchIOThread = do
buf <- atomically $ newTVar Nothing
_ <- forkIO $ ioThread buf
return buf
ioThread :: Buffer -> IO ()
ioThread buf = loop where
loop =
join $ atomically $ do
contents <- readTVar buf
if isJust contents -- no-one has taken the character yet
then retry -- relax
else return $ do
c <- getChar
atomically $ writeTVar buf (Just c)
loop
getChar' :: Buffer -> (Char -> IO ()) -> IO (IO ())
getChar' buf callback = do
abortFlag <- atomically $ newTVar False
_ <- forkIO $ doGetChar abortFlag
return $ atomically $ writeTVar abortFlag True
where
doGetChar abortFlag = join $ atomically $ do
mbC <- readTVar buf
abort <- readTVar abortFlag
case mbC of
Just c ->
do writeTVar buf Nothing; return $ callback c
Nothing | abort -> return $ return ()
_ -> retry
What you want to do is use exception-handling constructs such that regardless of exceptions, the MVar is always left in a safe state. In particular, you probably want withMVar.

Resources