---monadischer Taschenrechner
--  
--  mit Eingabstrom
--  Nach main-Aufruf: 
--   Tastatureingaben  123*456=  
--    ergibt Resultat in neuer Zeile
--   man kann"c"  und Kommas verwenden




module Main where

import Char
import IO


main::IO ()


main = do 
         hSetBuffering stdin NoBuffering  -- neu
         hSetBuffering stdout NoBuffering -- neu 
         apply calc startState
         return ()
         
 ------   (apply calc startState) :: IO ((), CalcState)

type CalcState = ((String,Int), Double -> Double, Double)
--- type CalcState = (String,Double -> Double, Double)


--------------------
newtype STT s m a = STT (s -> m (a, s))

apply :: STT s m a -> s -> m (a, s)
apply (STT f) x = f x
 
instance Monad m => Monad (STT s m) where
  return x = STT $ \ s -> return (x, s)
  k1 >>= k2 = STT action
    where action s = do (x, s') <- apply k1 s
                        apply (k2 x) s'
 

 
type CalcTransformer = STT CalcState IO
 
class Monad m => IOMonad m where
  ioGetChar :: m Char
  ioPrint :: Show a => a -> m ()
 
instance IOMonad IO where
  ioGetChar = getChar
  ioPrint = print

instance IOMonad m => IOMonad (STT s m) where
  ioGetChar = promote ioGetChar
  ioPrint x = promote $ ioPrint x
  
--  das folgende ist eigentlich ueberfluessig:
--    es ist nur Vorbereitung fuer evtl. zusaetzich Monadenkomb.
--     prompote g = -Def haette gereicht
class MonadTransformer t where
  promote :: Monad m => m a -> t m a

instance MonadTransformer (STT s) where
    promote g = STT $ \ s -> do {x <- g; return (x, s)}


 
----
startState :: CalcState
startState = ((" ",0),id, 0.0)
 
calcStep :: Char -> CalcTransformer ()
calcStep x
  | isDigit x = digit (fromInteger (toInteger (ord x - ord '0')))
  | x == '+'  = oper (+)
  | x == '-'  = oper (-)
  | x == '*'  = oper (*)
  | x == '/'  = oper (/)
  | x == 'c'  = clear
  | x == '='  = total
  | x == '.'  = komma
  | otherwise = tunichts
 

  
 

clear :: Monad m => STT CalcState m ()
clear = STT action
  where 
  action (str,g, 0.0) = return ((), (("c",0),id, 0.0))
  action (str,g, z)   = return ((), (("c",0), g, 0.0))

total :: IOMonad m => STT CalcState m ()
total      = STT $ \(_,g, z) -> do {ioPrint $ g z; return ((), (("t",0),id, g z))}

--total :: IOMonad m => STT CalcState m ()
--total      = STT $ \(g, z) -> do {ioPrint $ g z; return ((), (id, 0.0))}

digit :: Monad m => Double -> STT CalcState m ()
digit d    = STT $ \((str,dignum),g, z) -> 
         if str == "t" then return ((),  (("d",0),g, d))
         else if str == "." then return ((),  ((".", dignum+1),g, z  + (0.1^dignum)*d))
         else return ((),  (("d",0), g, z*10.0 + d))

komma :: Monad m => STT CalcState m ()
komma    = STT $ \((str,_),g, z) ->  
          if str == "d" ||   str == "c"  || str == " "  || str == "o"  
          then return ((),  ((".",1),g, z))
           else  if  str == "t"  
          then return ((),  ((".",1),g, 0.0))
          else return ((),  ((".",30),g, z))
                                  
tunichts :: Monad m => STT CalcState m ()
tunichts    = STT $ \(sta,g, z) ->  return ((),  (sta,g, z))
                                  
oper :: Monad m => (Double -> Double -> Double) -> STT CalcState m ()
oper o     = STT $ \(_,g, z) -> return ((), (("o",0), o (g z), 0.0))
 

readResult :: Monad m => STT CalcState m Double
readResult = STT $ \(_,g, z) -> return (g z, (("r",0),g, z))
 
 


calc :: CalcTransformer ()
calc =
  do {k <- ioGetChar;
      if k == '\n'
      then do {x <- readResult;
               ioPrint x}
      else do {calcStep k;
               calc}}
 

-----   Aufruf:>  main
----  123*456=
----- Abwechselnd Eingabe und Ausgabe
-----    kein CR! Bei CR: Ende der Berechnung