{-# LANGUAGE GADTs #-}
{-|
  A simple embedded language for input/output. Deep embedding.
-}
module Program.Deep1 where

type Input   =  String
type Output  =  String

-- | The trivial deep embedding. We need to use a GADT to be allowed
--   the specific types on 'Get' and 'Put'.
data Program a where
  Put    :: Char -> Program ()
  Get    :: Program (Maybe Char)  -- (Nothing) signals "end of input"
  Return :: a -> Program a
  (:>>=) :: Program a -> (a -> Program b) -> Program b

type IOSem a = Input -> (a, Input, Output)
-- | run function: translate syntax to semantics
run :: Program a -> IOSem a
run (Put c)     i        =  ((),       i,   [c])
run Get         []       =  (Nothing,  [],  [])
run Get         (c : i)  =  (Just c,   i,   [])
run (Return x)  i        =  (x,        i,   [])
run (p :>>= f)  i        =  (y,        i2,  o1 ++ o2) 
  where  (x,  i1,  o1)   =  run p i
         (y,  i2,  o2)   =  run (f x) i1

instance Monad Program where
  return  =  Return
  (>>=)   =  (:>>=)
  -- fail has no natural definition for the (Program a) datatype

-- | Output a character.
putC :: Char -> Program ()
putC = Put

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