-----------------------------------------------------------------------
--
--  Haskell: The Craft of Functional Programming
--  Simon Thompson
--  (c) Addison-Wesley, 1996-2011.
--
--  CalcToplevel.hs
--
--  Top-level interaction loop for a calculator
--
-----------------------------------------------------------------------

module CalcToplevel where

import System.IO 

import CalcTypes
import CalcStore
import CalcParseLib
import CalcParse
import CalcEval


calcStep :: Store -> IO Store

calcStep :: Store -> IO Store
calcStep Store
st
  = do String
line <- IO String
getLine
       let comm :: Command
comm = String -> Command
calcLine String
line
       let (Integer
val , Store
newSt) = Command -> Store -> (Integer, Store)
command Command
comm Store
st
       Integer -> IO ()
forall a. Show a => a -> IO ()
print Integer
val
       Store -> IO Store
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Store
newSt


calcSteps :: Store -> IO ()

calcSteps :: Store -> IO ()
calcSteps Store
st =
    do
      Bool
eof <- IO Bool
isEOF
      if Bool
eof
         then () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
         else do Store
newSt <- Store -> IO Store
calcStep Store
st
                 Store -> IO ()
calcSteps Store
newSt


mainCalc :: IO ()
mainCalc :: IO ()
mainCalc = 
    do
      Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdin BufferMode
LineBuffering
      Store -> IO ()
calcSteps Store
initial
      Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdin BufferMode
NoBuffering