{-|
  A simple embedded language for input/output. Deep embedding.
-}
module Program.Deep2 where
import Control.Monad((>=>))
-- > (>=>) :: Monad m => (a -> m b) -> (b -> m c) -> (a -> m c)
-- > f >=> g   =   \c ->  f c >>= g

type Input   =  String
type Output  =  String

-- | Other approach...
data Program a = PutBind Char (Program a)          
               | GetBind (Maybe Char -> Program a) 
               | Return a

-- | It turns out that bind can still be defined!
instance Monad Program where
  return = Return
  PutBind c p  >>=  k   =  PutBind c (p >>= k)
  GetBind f    >>=  k   =  GetBind (f >=> k)
  Return x     >>=  k   =  k x



{- I pulled the above out of my hat, but...
   We can *calculate* the correct definition of (>>=) using
   the follwing intuitive meaning of PutBind and GetBind

    @PutBind c p == putC c >> p@
    @GetBind f   == getC >>= f@

 and the monad laws:

    Law 1.  return x >>= f   ==  f x

    Law 2.  m >>= return     ==  m

    Law 3.  (m >>= f) >>= g  ==  m >>= (\x -> f x >>= g)

   For instance,

      GetBind f >>= k             { meaning of GetBind }
  ==  (getC >>= f) >>= k          { third monad law }
  ==  getC >>= (\c -> f c >>= k)  { meaning of GetBind }
  ==  GetBind (\c -> f c >>= k)
  ==  GetBind (f >=> k)

-}

-- | Output a character.
putC :: Char -> Program ()
putC c = PutBind c $ Return ()

-- | Input a character.
getC :: Program (Maybe Char)
getC = GetBind Return

type IOSem a = Input -> (a, Input, Output)
-- | The run function is easier than before
run :: Program a -> IOSem a
run (PutBind c p)  i        =  (x,  i',  c : o)
  where (x, i', o)  =  run p i
run (GetBind f)    []       =  run (f Nothing)   []
run (GetBind f)    (c : i)  =  run (f $ Just c)  i
run (Return x)     i        =  (x,  i,  [])