combining StateT with InputT

2020-02-12 13:51发布

问题:

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) -> ... }

回答1:

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.



回答2:

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


回答3:

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