[Haskell-cafe] Towards an IO-Comonad that preserves referential integry (was: "comonads, io" Jan 02, 2003)

[Sven Biedermann]

Dear Haskellers,

The OI Comonad in Richard Kieburtz' paper does break referential
integrity, but he worte, that the implementation is just something
"...to experiment with". In this papers he states, that a real
OI needs special properties. For instance enableOI needs "...to have the
effect of copying pointers to currently accessible IO resources, in
effect duplicating the current IO environment."

So, I wrote a simple OI-Comonad for stdin/stdout only, that preserves
referential integrity. At least, my reasoning and the tests I made
didn't reveal anything different.
The code and some explanations are presented at the end of this mail.

Haskellers: Could you review the solution, please?  Does it really
preserves referential integrity? Or am I completely wrong?
Do you have any suggestions on generalizing the idea?

I would be glad to hear from you!

Best regards

Sven Biedermann


----------------------------------------------------------------

  The implementation is based on two ideas:

1) The OI outside world is modeled an infinite structure (OIReality)
that keeps track effects created in the outside world. All "futures" of
a reality at a point of "time" are remembered in a lazy fashion. So, if
one probes on referential integrity, the structure will be re-iterated
through, playing back already computed results. If a reality at some
point of "time" isn't referenced any more, that reality will be
reclaimed by the garbage collector.

The following statement is an example, that no space leaks occur as long
as a specific reality isn't remembered (stdPutStr builds on basic
stdPutChar using the standard operators .>> and =>>):

	extract $ mkOI 'x' .>> (cycle ['A'..'z']) =>> oiPutStr

Amazingly,

	extract $ mkOI 'x' .>> (cycle ['A'..'z']) =>> oiPutStrLn

produces a space leak, because the implementation isn't lazy enough,  
yet.

2) The OI-Comonad is a pointer to the current reality, together with the
value, that can be extracted from OI. Whenever an OI ist rememberable by
the user, the pointer will be duplicated. This is crucial for
referential integrity.

Comain, as defined by Andrew Bromage in :

	comain :: OI a -> ()
	comain w = extract (w .>> show (a,b) =>> oiPutStrLn)
			where a = extract (w .>> () =>> oiGetChar)
			          b = extract (w .>> () =>> oiGetChar)


now works as intended and delivers, if 'x' is typed in on standard
input:

	('x','x')

"a = ..." runs on reality w, yielding 'x' . "b = ..." is just a play
back of "a = ...". "extract (w.>> show (a,b) =>> stdPutStrLn)" is
another future of w, which just prints ('x','x').





module SimpleOI where

import Control.Monad.Instances
import System.IO.Unsafe
import Data.Char
import Data.IORef

--------------------------------------
-- copied from http://www.eyrie.org/~zednenem/2004/hsce/

class Functor w => Comonad w where
   extract   :: w a -> a
   duplicate :: w a -> w (w a)
   extend    :: (w a -> b) -> (w a -> w b)

   extend f  = fmap f . duplicate
   duplicate = extend id

-- | 'fmap' defined in terms of 'extend'
liftW :: Comonad w => (a -> b) -> (w a -> w b)
liftW f = extend (f . extract)

-- | 'extend' with the arguments swapped. Dual to '>>=' for monads.
(=>>) :: Comonad w => w a -> (w a -> b) -> w b
(=>>) = flip extend

-- | Injects a value into the comonad.
(.>>) :: Comonad w => w a -> b -> w b
w .>> b = extend (\_ -> b) w

-- end of copy
-------------------------------------

data OIReality = OIReality GetChar [PutChar] Char
data GetChar = GetChar Char OIReality
data PutChar = PutChar () OIReality

constructReality :: Char -> OIReality
constructReality c = let r = OIReality (constructGet r)  
(constructPuts r) c
					 in r

constructGet :: OIReality -> GetChar
constructGet r = let c = unsafePerformIO $ seq r getChar in GetChar c  
(constructReality c)


constructPut :: OIReality -> Char -> PutChar
constructPut r c = let v = unsafePerformIO  $ seq r $ putChar c in   
PutChar v (constructReality c)

constructPuts :: OIReality -> [PutChar]
constructPuts r = map (constructPut r.chr) [0..255]

nextGetCharReality :: OIReality -> OIReality
nextGetCharReality (OIReality (GetChar c r) _ _) = r

nextPutCharReality :: Char -> OIReality -> OIReality
nextPutCharReality c (OIReality _ puts _)  = let PutChar v r =  
puts !! (ord c) in  seq v r



data OIComonad a = OI (IORef OIReality) a

-- extract    OI _ a   = a
instance Functor OIComonad where
	fmap f (OI ref a) = seq a $ OI (unsafeDuplicateRef ref) (f a) -- too  
many seq's at the moment

instance Comonad OIComonad where
     duplicate w = fmap (const w) w
     extract (OI _ a) = a

mkOI :: Char -> OIComonad Char
mkOI c = OI (unsafePerformIO $ newIORef $ constructReality c) c

oiGetChar :: OIComonad a -> Char
oiGetChar (OI ref _) = unsafePerformIO $ do {
							modifyIORef ref nextGetCharReality;
							OIReality _ _ c <- readIORef ref;
							return (c) }

oiPutChar :: OIComonad Char -> ()
oiPutChar (OI ref c) = unsafePerformIO $ do {
							modifyIORef ref (nextPutCharReality c);
							OIReality _ _ d <- readIORef ref; -- not!? modified without  
further read
							return $ seq d ()}

unsafeDuplicateRef :: IORef OIReality -> IORef OIReality
unsafeDuplicateRef ref = unsafePerformIO $ do {
										r <- readIORef ref;
										newIORef r; }				

oiPutStrLn w = extract $ w =>> oiPutStr .>> '\n' =>> oiPutChar --  
space leak if input string is suffiently long
                                                                --  
too many seqs in code

oiPutStr w = extract $ oiPutStrS w .>> ()

oiPutStrS :: OIComonad String -> OIComonad String
oiPutStrS w = case (extract w) of
                    [] -> w
                    (c:cs) -> oiPutStrS (w .>> c =>> oiPutChar .>> cs)

oiGetLine = "t.b.d. using oiGetChar"


-- adapted from http://www.mail-archive.com/haskell-cafe@haskell.org/ 
msg02408.html
comain w = extract (w .>> show (a,b) =>> oiPutStr)
             where
                 a = extract (w .>> () =>> oiGetChar)
                 b = extract (w .>> () =>> oiGetChar)

										
{- Original from http://www.mail-archive.com/haskell-cafe@haskell.org/ 
msg02408.html

-- Bootstrap into the OI comonad
         main :: IO ()
         main = return $! comain stdOI

         -- The following are the OI functions which we use.
         -- stdGetChar :: OI () -> Char
         -- stdPutStrLn :: OI String -> ()

         comain :: OI a -> ()
         comain w
             = coeval (w .>> show (a,b) =>> stdPutStrLn)
             where
                 a = coeval (w .>> () =>> stdGetChar)
                 b = coeval (w .>> () =>> stdGetChar)

-}