问StateT与InputT相结合

EN

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

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

In[1]>
Out[1]>

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

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