sch

Main.hs

import Prelude hiding (lines)
import System.Console.Haskeline
import System.Directory
import System.Process
import Data.List hiding (lines)
import Data.Maybe (fromMaybe)
import Data.Conduit hiding (mapM_)
import Data.Conduit.List (sourceList,consume)
import Data.Conduit.ProcessOld
import Data.ByteString.Char8 (ByteString,pack,unpack,lines)
import Control.Applicative
import Control.Monad
import Control.Monad.Trans
import Control.Monad.Trans.Resource

exec :: String -> [ByteString] -> IO [ByteString]
exec s i = runResourceT $ sourceList i $= conduitCmd s $= makeLine $$ await >> consume where
  makeLine = do
    n <- await
    flip (maybe (return ())) n $ \r -> do
      mapM_ yield $ lines r
      makeLine

clamp :: [a] -> [a]
clamp [] = []
clamp xs = init xs

scheme :: [String] -> String -> InputT IO [String]
scheme store xs = do
  str <- lift $ exec "goshLoad" $ map pack $ store ++ [xs]
  return $ map unpack $ clamp str

setting :: Settings IO
setting = defaultSettings

main :: IO ()
main = do
  runInputT setting $ do
    withInterrupt $ loop []

loop :: [String] -> InputT IO ()
loop store = do
  let hdl :: MonadIO m => SomeException -> m (Maybe String)
      hdl _ = return Nothing
  cmd <- handle hdl $ getInputLine "Input> "
  case cmd of
    Nothing -> loop store
    Just "clear" -> loop []
    Just "exit" -> return ()
    Just "(exit)" -> return ()
    Just ":q" -> return ()
    Just cm -> do
      if "gosh> "`isPrefixOf`cm
        then do
          res <- scheme store $ drop 5 cm
          ans <- handle hdl $ getInputLine "Answer> "
          if not (null res) && last res == fromMaybe "" ans
            then outputStrLn "+++ Correct."
            else do
              outputStrLn $ "--- Wrong Answer"
              outputStrLn $ "    Yours  : " ++ last res
              outputStrLn $ "    Answer : " ++ fromMaybe "" ans
          loop $ store ++ [drop 5 cm ++ "\n"]
        else do
          scheme store cm >>= \xs -> when (not $ null xs) $ outputStrLn $ last xs
          loop $ store ++ [cm ++ "\n"]