{-| 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, [])