combining StateT with InputT - haskell

It is a follow-up to this question. I'm trying to combine shell from #ErikR's answer in my InputT loop.
main :: IO [String]
main = do
c <- makeCounter
execStateT (repl c) []
repl :: Counter -> StateT [String] IO ()
repl c = lift $ runInputT defaultSettings loop
where
loop = do
minput <- getLineIO $ in_ps1 $ c
case minput of
Nothing -> lift $ outputStrLn "Goodbye."
Just input -> (liftIO $ process c input) >> loop
getLineIO :: (MonadException m) => IO String -> InputT m (Maybe String)
getLineIO ios = do
s <- liftIO ios
getInputLine s
And getting an error
Main.hs:59:10:
Couldn't match type ‘InputT m0’ with ‘IO’
Expected type: StateT [String] IO ()
Actual type: StateT [String] (InputT m0) ()
Relevant bindings include
loop :: InputT (InputT m0) () (bound at Main.hs:61:3)
In the expression: lift $ runInputT defaultSettings loop
In an equation for ‘repl’:
repl c
= lift $ runInputT defaultSettings loop
where
loop
= do { minput <- getLineIO $ in_ps1 $ c;
.... }
Main.hs:62:5:
No instance for (Monad m0) arising from a do statement
The type variable ‘m0’ is ambiguous
Relevant bindings include
loop :: InputT (InputT m0) () (bound at Main.hs:61:3)
Note: there are several potential instances:
instance Monad (Text.Parsec.Prim.ParsecT s u m)
-- Defined in ‘Text.Parsec.Prim’
instance Monad (Either e) -- Defined in ‘Data.Either’
instance Monad Data.Proxy.Proxy -- Defined in ‘Data.Proxy’
...plus 15 others
In a stmt of a 'do' block: minput <- getLineIO $ in_ps1 $ c
In the expression:
do { minput <- getLineIO $ in_ps1 $ c;
case minput of {
Nothing -> lift $ outputStrLn "Goodbye."
Just input -> (liftIO $ process c input) >> loop } }
In an equation for ‘loop’:
loop
= do { minput <- getLineIO $ in_ps1 $ c;
case minput of {
Nothing -> lift $ outputStrLn "Goodbye."
Just input -> (liftIO $ process c input) >> loop } }
The full code can be found here, it's based on Write you a haskell.
I know haskelline has a built-in support for history, but I'm trying to implement it myself as an exercise.
Feel free to suggest replacements for the monad transformers to get the same functionality.
My Real Problem
I'd like to add ipython like capabilities to the lambda REPL in Write You a Haskell, namely:
I. A counter for input and output, that will appear in the prompt, i.e
In[1]>
Out[1]>
This is already done.
II. Save each command to history (automatically), and display all previous commands using a special command, e.g. histInput (same as hist in ipython). Also, save a history of all output results and display them using histOutput. This is what I'm trying to do in this question (input history only for the moment).
III. Reference previous inputs and outputs, e.g. if In[1] was x, then In[1] + 2 should be substituted by x + 2, and likewise for the output.
Update
I've tried to combine #ErikR's answer, and temporarily disabled showStep, coming up with:
module Main where
import Syntax
import Parser
import Eval
import Pretty
import Counter
import Control.Monad
import Control.Monad.Trans
import System.Console.Haskeline
import Control.Monad.State
showStep :: (Int, Expr) -> IO ()
showStep (d, x) = putStrLn ((replicate d ' ') ++ "=> " ++ ppexpr x)
process :: Counter -> String -> InputT (StateT [String] IO) ()
process c line =
if ((length line) > 0)
then
if (head line) /= '%'
then do
modify (++ [line])
let res = parseExpr line
case res of
Left err -> outputStrLn $ show err
Right ex -> do
let (out, ~steps) = runEval ex
--mapM_ showStep steps
out_ps1 c $ out2iout $ show out
else do
let iout = handle_cmd line
out_ps1 c iout
-- TODO: don't increment counter for empty lines
else do
outputStrLn ""
out2iout :: String -> IO String
out2iout s = return s
out_ps1 :: Counter -> IO String -> InputT (StateT [String] IO) ()
out_ps1 c iout = do
out <- liftIO iout
let out_count = c 0
outputStrLn $ "Out[" ++ (show out_count) ++ "]: " ++ out
outputStrLn ""
handle_cmd :: String -> IO String
handle_cmd line = if line == "%hist"
then
evalStateT getHist []
else
return "unknown cmd"
getHist :: StateT [String] IO String
getHist = do
hist <- lift get
forM_ (zip [(1::Int)..] hist) $ \(i, h) -> do
show i ++ ": " ++ show h
main :: IO ()
main = do
c <- makeCounter
repl c
repl :: Counter -> IO ()
repl c = evalStateT (runInputT defaultSettings(loop c)) []
loop :: Counter -> InputT (StateT [String] IO) ()
loop c = do
minput <- getLineIO $ in_ps1 $ c
case minput of
Nothing -> return ()
Just input -> process c input >> loop c
getLineIO :: (MonadException m) => IO String -> InputT m (Maybe String)
getLineIO ios = do
s <- liftIO ios
getInputLine s
in_ps1 :: Counter -> IO String
in_ps1 c = do
let ion = c 1
n <- ion
let s = "Untyped: In[" ++ (show n) ++ "]> "
return s
which still doesn't compile:
Main.hs:59:5:
Couldn't match type ‘[]’ with ‘StateT [String] IO’
Expected type: StateT [String] IO String
Actual type: [()]
In a stmt of a 'do' block:
forM_ (zip [(1 :: Int) .. ] hist)
$ \ (i, h) -> do { show i ++ ": " ++ show h }
In the expression:
do { hist <- lift get;
forM_ (zip [(1 :: Int) .. ] hist) $ \ (i, h) -> do { ... } }
In an equation for ‘getHist’:
getHist
= do { hist <- lift get;
forM_ (zip [(1 :: Int) .. ] hist) $ \ (i, h) -> ... }

I'm going to take a guess at what you are trying to do.
This program recognizes the following commands:
hist -- show current history
add xxx -- add xxx to the history list
clear -- clear the history list
count -- show the count of history items
quit -- quit the command loop
Program source:
import System.Console.Haskeline
import Control.Monad.Trans.Class
import Control.Monad.Trans.State.Strict
import Control.Monad
main :: IO ()
main = evalStateT (runInputT defaultSettings loop) []
loop :: InputT (StateT [String] IO) ()
loop = do
minput <- getInputLine "% "
case minput of
Nothing -> return ()
Just "quit" -> return ()
Just input -> process input >> loop
process input = do
let args = words input
case args of
[] -> return ()
("hist": _) -> showHistory
("add" : x : _) -> lift $ modify (++ [x])
("clear": _) -> lift $ modify (const [])
("count": _) -> do hs <- lift get
outputStrLn $ "number of history items: " ++ show (length hs)
_ -> outputStrLn "???"
showHistory = do
hist <- lift get
forM_ (zip [(1::Int)..] hist) $ \(i,h) -> do
outputStrLn $ show i ++ " " ++ h

The first error is because you have declared
main :: IO ()
but also
execStateT (...) :: IO [String]
execStateT returns the computation's final state, and your state is of type [String]. Usually this is fixed by just not declaring a type for main and letting it be inferred to be IO a for some a. The second one I'm not sure about, but maybe it's the same thing.

The code you have here compiles, and it defines process as:
process :: Counter -> String -> IO ()
To create a version of process with this signature:
Counter -> String -> InputT (StateT [String] IO) ()
just use liftIO:
process' :: Counter -> String -> InputT (StateT [String] IO) ()
process' counter str = liftIO $ process counter str

Related

String vs Char mismatch in haskell

I'm getting an error about a type mismatch:
Main.hs:47:28:
Couldn't match type ‘[Char]’ with ‘Char’
Expected type: IO Char
Actual type: IO String
In the first argument of ‘liftIO’, namely ‘prompt’
In the second argument of ‘($)’, namely ‘liftIO prompt’
and struggling to understand why an IO Char is expected. Since prompt does type-check as IO String in line 46, and I thought, perhaps mistakenly, that liftIO would turn it to a String as suggested in this answer.
module Main where
import Syntax
import Parser
import Eval
import Pretty
import Counter
import Control.Monad
import Control.Monad.Trans
import System.Console.Haskeline
import Control.Monad.State
showStep :: (Int, Expr) -> IO ()
showStep (d, x) = putStrLn ((replicate d ' ') ++ "=> " ++ ppexpr x)
process :: Counter -> String -> InputT (StateT [String] IO) ()
process c line =
if ((length line) > 0)
then
if (head line) /= '%'
then do
modify (++ [line])
let res = parseExpr line
case res of
Left err -> outputStrLn $ show err
Right ex -> do
let (out, ~steps) = runEval ex
--mapM_ showStep steps
out_ps1 c $ out2iout $ show out
else do
let iout = handle_cmd line
out_ps1 c iout
-- TODO: don't increment counter for empty lines
else do
outputStrLn ""
out2iout :: String -> IO String
out2iout s = return s
out_ps1 :: Counter -> IO String -> InputT (StateT [String] IO) ()
out_ps1 c iout = do
--out <- liftIO iout
let out_count = c 0
let prompt = (getPrompt out_count iout) :: IO String
outputStrLn $ liftIO prompt
outputStrLn ""
getPrompt :: IO Int -> IO String -> IO String
getPrompt ion iout = do
n <- ion
out <- iout
return $ "Out[" ++ (show n) ++ "]: " ++ out
handle_cmd :: String -> IO String
handle_cmd line = if line == "%hist"
then
evalStateT getHist []
else
return "unknown cmd"
joinHist :: IO [String] -> IO String
joinHist ixs = do
xs <- ixs
return $ unlines xs
getHist :: StateT [String] IO String
getHist = do
hist <- lift get
let hists = (zip [(1::Int)..] hist) :: [(Int, String)]
return $ combineHist hists
combineHist :: [(Int, String)] -> String
combineHist hists = unlines $ map (\(i, h) -> show i ++ ": " ++ show h) hists
main :: IO ()
main = do
c <- makeCounter
repl c
repl :: Counter -> IO ()
repl c = evalStateT (runInputT defaultSettings(loop c)) []
loop :: Counter -> InputT (StateT [String] IO) ()
loop c = do
minput <- getLineIO $ in_ps1 $ c
case minput of
Nothing -> return ()
Just input -> process c input >> loop c
getLineIO :: (MonadException m) => IO String -> InputT m (Maybe String)
getLineIO ios = do
s <- liftIO ios
getInputLine s
in_ps1 :: Counter -> IO String
in_ps1 c = do
let ion = c 1
n <- ion
let s = "Untyped: In[" ++ (show n) ++ "]> "
return s
More context can be found here.
You are passing an IO action in place of a String to outputStrLn. You should instead do:
prompt <- liftIO $ getPrompt out_count iout
outputStrLn prompt
to obtain the String from the IO action, using liftIO and then passing this to outputStrLn.

Monad Stack and modifying reader environment

type InterpreterMonad = StateT (MEMORY, FUNCTIONS) (ReaderT (NameAddress, NameAddress) (ErrorT String IO))
interpreteStmt :: Stmt -> InterpreterMonad ()
handleFCall :: VarName -> [CallArg] -> InterpreterMonad ()
handleFCall (VarName name) argsCall = do
(memory, functions) <- get
case (Map.lookup (VarName name) functions) of
Nothing -> throwError $ "error"
(Just ((DefFun varname argsDef typ begin statements end), env)) -> (checkCoherenceTypesArgs varname argsDef argsCall) >>= \_ -> argsToContext argsDef argsCall env >>= \_ -> interpreter statements >>= \_ -> return ()
I don't put whole code to make my problem clearer.
And now, I would like to modify Reader monad ( I mean environment in Reader) in handleFCall Function for interpreter statements. How to do it?
P.S. My attempt: ( It doesn't work, please explain why )
argsToContext :: [DefArg] -> [CallArg] -> NameAddress -> InterpreterMonad ()
argsToContext xs ys env = do
(memory, fs) <- get
(mem, args) <- (argsToContext' xs ys memory Map.empty)
put ( mem, fs)
throwError $ "Tutej " ++ (show args) ++ " memory " ++ (show mem)
local (\_ -> (env, args)) ask
return ()
You use the local function. Here is a short example:
import Control.Monad.Reader
import Control.Monad.State
import Control.Monad.Except
type MyMonad = StateT String (ReaderT Int (ExceptT String IO))
foo :: Int -> MyMonad ()
foo x = do
env <- ask
liftIO $ putStrLn $ "x = " ++ show x ++ " and env is: " ++ show env
t1 :: MyMonad ()
t1 = do
foo 1 -- env = 13
local (+20) $ foo 2 -- env = 20+13 = 33
local (const 42) $ foo 3 -- env = 42
foo 4 -- env = 13
example = runExceptT (runReaderT (runStateT t1 "some state") 13)
Output from running example:
x = 1 and env is: 13
x = 2 and env is: 33
x = 3 and env is: 42
x = 4 and env is: 13
Right ((),"some state")
Initially the Reader environment is 13. The local (+20) call executes foo 2 with the Reader environment set to 13+20. Then foo 3 is executed with the Reader environment set to 42. Finally, foo 4 is executed in the original environment.

Scope of State Monad

I'm trying to understand what happens in the following code, the code behaves properly, but I'm trying to understand why.
import Control.Monad.State
import System.IO
import System.Environment
echoArgs :: [String] -> State Int [String]
echoArgs x = loopArgs x >> return x
where loopArgs [] = return ()
loopArgs s#(x':xs') = modify (+1) >> loopArgs xs'
main :: IO ()
main = do
argv <- getArgs
let s = echoArgs argv
mapM_ putStr' (evalState s 0)
putStrLn $ "\nNum Args = " ++ show (execState s 0)
where putStr' x = putStr $ x ++ " "
What I'm not understanding is why the state of the State monad does not get 'reset' with each successive call to loopArgs. Does the state get passed as a variable, with each >> and if so could someone show me how?
Does the state get passed as a variable, with each >> and if so could someone show me how?
It does indeed. It's helpful to look at a toy implementation of the State monad.
newtype State s a = State { runState :: s -> (a,s) }
instance Monad (State s) where
return a = State $ \s -> (a, s)
State act >>= k = State $ \s ->
let (a, s') = act s
in runState (k a) s'
get :: State s s
get = State $ \s -> (s, s)
put :: s -> State s ()
put s = State $ \_ -> ((), s)
modify :: (s -> s) -> State s ()
modify f = get >>= \x -> put (f x)
When you bind using >>= or >> the accumulated state is threaded through as an argument to the function on the right hand side.
When you run execState or evalState it then just extracts either the resulting value or the state from the resulting tuple.
execState :: State s a -> s -> s
execState act = snd . runState act
evalState :: State s a -> s -> a
evalState act = fst . runState act

How to use maybe monad inside another monad?

I have this code (inside happstack, but could be just the IO monad):
accountHandler conn = do
sessionId <- optional $ readCookieValue "sessionId"
case sessionId of
Nothing -> seeOther ("/" :: String) $ toResponse ()
Just s -> do
result <- loggedInUserId conn s
case result of
Just userId -> seeOther ("/account/" ++ unUserId userId) $ toResponse ()
Nothing -> seeOther ("/" :: String) $ toResponse ()
I want to remove the nested case statements and write something like:
accountHandler conn = do
let action = do
sessionId <- optional $ readCookieValue "sessionId"
userId <- loggedInUserId conn sessionId
return $ seeOther ("/account/" ++ userId)
maybe (seeOther ("/" :: String)) id action $ toResponse ()
... but userId ends up as a type of Maybe String rather than just String. How can I evaluate the nested do block using the maybe monad? (I would also accept a different refactoring that removes the nested cases.)
UPDATE: Below is a generic, though contrived, version of the same problem:
module Main where
getAnswer expected = do
l <- getLine
if l == expected
then return $ Just l
else return $ Nothing
main = do
a <- getAnswer "a"
case a of
Nothing -> putStrLn "nope"
Just x -> do
b <- getAnswer x
case b of
Nothing -> putStrLn "nope"
Just _ -> putStrLn "correct!"
Ok, with your generic example I could do something with Control¸Monad.Transformers. This allows you to create a stack of monads. You can check it out here: http://hackage.haskell.org/package/transformers-0.3.0.0/docs/Control-Monad-Trans-Maybe.html
You can apply MaybeT to everything of type IO (Maybe a) and then do all the computations in the inner do block and then check for Nothing at the end.
module Main where
import Control.Monad.Trans.Maybe
getAnswer expected = MaybeT $ do
l <- getLine
if l == expected
then return $ Just l
else return $ Nothing
main = do
y <- runMaybeT $ do a <- getAnswer "a"
b <- getAnswer a
return b
case y of Nothing -> putStrLn "failure"
(Just _) -> putStrLn "correct"
Another version using liftIO and the Alternative type class:
module Main where
import Control.Monad.Trans.Maybe
import Control.Monad.IO.Class
import Control.Applicative
getAnswer expected = MaybeT $ do
l <- getLine
if l == expected
then return $ Just l
else return $ Nothing
main = do
_ <- runMaybeT $ do a <- getAnswer "a"
b <- getAnswer a
liftIO $ putStrLn "correct"
<|> do liftIO $ putStrLn "failure"
return ()
But using many lift operations is not very elegant.
I'd like to add to MoFu's answer that once you have MaybeT IO, you can use the full power of its MonadPlus instance. For example, if you need to check that some condition holds, use guard or mfilter. So you can write:
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans
import Control.Monad.Trans.Maybe
getAnswer :: (MonadPlus m, MonadIO m) => String -> m String
getAnswer expected = mfilter (== expected) $ liftIO getLine
It's type is very generic, it works for any monad that is MonadPlus and MonadIO. This is handy if you decide to modify your monad stack later. But we could also use more specific type (MonadIO m) => String -> MaybeT m String.
For extracting a MaybeT IO value from your inner computation I'd suggest to write a variant of fromMaybe for MaybeT:
fromMaybeT :: (Monad m) => m a -> MaybeT m a -> m a
fromMaybeT onFail = maybe onFail return <=< runMaybeT
It extracts the result with runMaybeT. If it's Just, just return it, otherwise run onFail action.
Combined together, we get:
main = fromMaybeT (putStrLn "nope") $ do
a <- getAnswer "a"
b <- getAnswer a
liftIO $ putStrLn "correct!"

Haskell type error with forkFinally I just can't work out

Along with the error I'm having, any tips on how terrible what I'm doing is would be appreciated.
So I'll paste the code, it's a bit; but I think it's mostly correct, I just can't get forkFinally to type check...
The error is on the only line that calls forkFinally:
Ambiguous type variable `e0' in the constraint:
(Exception e0) arising from a use of `forkFinally'
Probable fix: add a type signature that fixes these type variable(s)
In a stmt of a 'do' block:
t <- forkFinally (echoHandler a) (exitPool p)
In the expression:
do { a <- accept s;
t <- forkFinally (echoHandler a) (exitPool p);
atomically
$ do { p' <- readTVar p;
writeTVar p (t : p') };
repeatAccept s p }
In an equation for `repeatAccept':
repeatAccept s p
= do { a <- accept s;
t <- forkFinally (echoHandler a) (exitPool p);
atomically
$ do { p' <- readTVar p;
.... };
.... } Failed, modules loaded: none.
Here's the code:
type ConnectionHandler = (Handle, HostName, PortNumber) -> IO ()
type Pool = TVar [ThreadId]
runConn = do
s <- withSocketsDo (listenOn (PortNumber 1234))
p <- atomically (newTVar ([]::[ThreadId]))
t <- forkIO (repeatAccept s p)
repeatUntilExit stdin stdout putChar ""
p' <- atomically (readTVar p)
mapM killThread (t:p')
repeatAccept s p = do
a <- accept s
t <- forkFinally (echoHandler a) (exitPool p) -- Error here, forkIO instead compiles fine.. (and I guess actually should work just fine too?)
atomically $ do
p' <- readTVar p
writeTVar p (t:p')
repeatAccept s p
exitPool :: Pool -> a -> IO ()
exitPool pool = \_ -> do
tid <- myThreadId
atomically $ do
pool' <- readTVar pool
writeTVar pool $ filter (/=tid) pool'
return ()
echoHandler :: ConnectionHandler
echoHandler a#(hdl,_,_) = repeatUntilExit hdl hdl echoToHandleAndStdout ""
where echoToHandleAndStdout x = hPutChar hdl x >> putChar x
repeatUntilExit :: Handle -> Handle -> (Char -> IO ()) -> [Char] -> IO ()
repeatUntilExit hIn hOut f "exit\n" = hPutStrLn hOut "bye\n"
repeatUntilExit hIn hOut f x = hGetChar hIn >>= \c -> f c >> repeatUntilExit hIn hOut f (appendToLastFive c)
where appendToLastFive a = (reverse . (:)a . take 4 . reverse) x
forkFinally :: Exception e => IO a -> (Either e a -> IO ()) -> IO ThreadId
forkFinally action and_then =
mask $ \restore ->
forkIO $ try (restore action) >>= and_then
Type signature for forkFinally in the latest Control.Concurrent:
forkFinally :: IO a -> (Either SomeException a -> IO ()) -> IO ThreadId
Type signature for forkFinally in your code:
forkFinally :: Exception e => IO a -> (Either e a -> IO ()) -> IO ThreadId
You have tried to generalise the exception type. This isn't a problem if the exception type can be deduced from forkFinally's second parameter. But this is forkFinally's second parameter:
exitPool p :: a' -> IO ()
The type checker tries to unify Either e a -> IO () with a' -> IO () and ends up not being able to deduce what e is.
General solution: specify an explicit type. e.g.
t <- forkFinally (echoHandler a) (exitPool p :: Either SomeException () -> IO ())
Better specific solution: restore the original type signature to forkFinally. It doesn't seem to make sense for it to only catch a limited set of exceptions.

Resources