---monadischer Taschenrechner
--   kombiniert mit einem Boolschen 
-- 
--  mit Eingabstrom
--  Nach main-Aufruf: 
--   Tastatureingaben  123*456=  
--    ergibt Resultat in neuer Zeile
--   man kann"c"  und Kommas verwenden
--
--  Kombination mit einer einfachen Zustandsmonade
--  die einen Booleschen Wert als Zustand hat
--   und diesen manipulieren kann mit und/oder, nicht
--   



module Main where

import Char
import IO


main::IO ()


main = do 
         hSetBuffering stdin NoBuffering  
         hSetBuffering stdout NoBuffering 
         combapply calcComb startStateBool startStateCalc
         return ()
         
 -- combapply calcComb startStateBool startStateCalc :: IO (((), BoolState), CalcState)


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

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

combapply (STT f) b x = apply (f b) 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 CalcTransformerComb = STT BoolState CalcTransformer

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
  

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


 
----

startStateCalc :: CalcState
startStateCalc = ((" ",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
 

startStateBool :: BoolState
startStateBool = (True,id)

calcStepComb :: Char -> CalcTransformerComb ()
calcStepComb x   
       | x == 'T'  = STT $ \(b,g) -> return ((),(g True,id)) 
       | x == 'F'  = STT $ \(b,g) -> return ((),(g False,id)) 
       | x == 'N'  = STT $ \(b,g) -> return ((),(not b,id)) 
       | x == 'O'  = STT $ \(b,g) -> return ((),(b,\x-> b || x) )
       | x == 'A'  = STT $ \(b,g) ->  return ((),(b,\x-> b && x) ) 
       | x == 'S'  = STT $ \(b,g) -> do {ioPrint "="; ioPrint b; return ((),(b,g))} 
       | otherwise = promote (  calcStep x) 
 
 
 

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

 

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

readResultComb :: Monad m => STT BoolState m Bool
readResultComb = STT $ \(b,g) -> return (g b,(g b,g))
 
 



calcComb :: CalcTransformerComb ()
calcComb =
  do {k <- ioGetChar;
      if k == '\n'
      then do {x <- promote readResult;
               y <- readResultComb;
               ioPrint (y,x)}
      else do {calcStepComb k;
               calcComb}}



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