laziness in IO

[S.M.Kahrs]

This is a multipart MIME message.

--==_Exmh_-17196631560
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: quoted-printable

I don't think you can do what you want to using standard lists,
not without some dirty trickery...

But you can define a datatype for such a purpose which would essentially
have to put the tail into the Monad.

Disadvantage: you would have to redo lots of the list stuff yourself.
I had once started writing such a module, it's attached...

With this you can write your program as follows:

main =3D
    do xs <- getStrings
       putStrLn(headML xs)

getStrings =3D
    do { x <- getLine; if x=3D=3D"stop" then return NIL
                       else return (x:<:getStrings)
       }

So, this uses headML instead of head, NIL instead of [], etc.
But the things that makes everything work is the different cons-operator,=

the :<: which allows the list tail to still sit in some monad.

Hope this helps
	Stefan Kahrs

--==_Exmh_-17196631560
Content-Type: text/plain ; name="ListForMonad.hs"; charset=us-ascii
Content-Description: ListForMonad.hs
Content-Disposition: attachment; filename="ListForMonad.hs"
Content-Transfer-Encoding: quoted-printable

module ListForMonad where

import Monad

data Mlist m a =3D NIL | a :<: m (Mlist m a)

nullML :: Mlist m a -> Bool
nullML NIL =3D True
nullML _ =3D False

(<:) :: Monad m =3D> a -> m (Mlist m a) -> m (Mlist m a)
x <: ms =3D return (x :<: ms)

(+<+) :: Monad m =3D> Mlist m a -> m (Mlist m a) -> m (Mlist m a)
xs +<+ ms =3D foldrML (<:) ms xs

(!<!) :: Monad m =3D> Mlist m a -> Int -> m a
NIL !<! _ =3D error "index out of bounds"
(x :<: ms) !<! 0 =3D return x
(_ :<: ms) !<! n =3D ms >>=3D (!<! (n-1))

lengthML :: Monad m =3D> Mlist m a -> m Int
lengthML NIL =3D return 0
lengthML (_ :<: ms) =3D liftM (+1) (ms >>=3D lengthML)

headML :: Mlist m a -> a
headML (x :<: _ ) =3D x
headML NIL =3D error "head of empty list"

lastML :: Monad m =3D> Mlist m a -> m a
lastML (x :<: ms) =3D
	do	xs<-ms
		case xs of NIL -> return x
                           p   -> lastML p
lastML NIL =3D error "last of empty list"

tailML :: Mlist m a -> m (Mlist m a)
tailML (_ :<: ms) =3D ms
tailML NIL =3D error "tail of empty list"

initML :: Monad m =3D> Mlist m a -> m (Mlist m a)
initML NIL =3D error "init of empty list"
initML (x :<: ms) =3D
	do	xs<-ms
		case xs of NIL -> return NIL
                           p   -> return (x :<: initML p)

replicateML :: Monad m =3D> Int -> m a -> m (Mlist m a)
replicateML n a =3D liftM (takeML n) (repeatML a)

repeatML :: Monad m =3D> m a -> m (Mlist m a)
repeatML action =3D xs
                  where
                  xs =3D do { r<-action; return (r :<: xs) }

takeML :: Monad m =3D> Int -> Mlist m a -> Mlist m a
takeML _ NIL =3D NIL
takeML 0 _ =3D NIL
takeML n (x:<:ms) =3D x :<: (liftM (takeML (n-1)) ms)

dropML :: Monad m =3D> Int -> Mlist m a -> m(Mlist m a)
dropML 0 xs =3D return xs
dropML _ NIL =3D return NIL
dropML n (x:<:ms) =3D ms >>=3D dropML (n-1)


splitAtML :: Monad m =3D> Int -> Mlist m a -> m (Mlist m a, m(Mlist m a))=

splitAtML 0 xs =3D return (NIL, return xs)
splitAtML n NIL =3D return (NIL, return NIL)
splitAtML n (x:<: ms) =3D
	do	m<-ms
		(as,ns)<-splitAtML (n-1) m
		return (x :<: return as,ns)

reverseML :: Monad m =3D> Mlist m a -> m (Mlist m a)
reverseML ms =3D
	do	xs <- mlToList ms
		foldr (<:) (return NIL) (reverse xs)

zipML :: Monad m =3D> Mlist m a -> Mlist m b -> Mlist m (a,b)		=

zipML (x:<:ms) (y:<:ns) =3D (x,y) :<: do { xs<-ms; ys<-ns; return(zipML x=
s ys) }
zipML _ _ =3D NIL

unzipML :: Monad m =3D> Mlist m (a,b) -> (Mlist m a,Mlist m b)
unzipML xs =3D (fmap fst xs,fmap snd xs) {- note: re-evaluation -}

instance Monad m =3D> Functor (Mlist m) where
	fmap f NIL =3D NIL
	fmap f (x:<:ms) =3D f x :<: (liftM (fmap f) ms)

mlToList :: Monad m =3D> Mlist m a -> m [a]
mlToList NIL =3D return []
mlToList (x :<: ms) =3D liftM (x:)(ms >>=3D mlToList)



foldrML :: Monad m =3D> (a -> m b -> m b) -> m b -> Mlist m a -> m b
foldrML f n NIL =3D n
foldrML f n (x :<: ms) =3D f x (ms >>=3D foldrML f n)

blift :: Monad m =3D> (a->b->b) -> (a-> m b -> m b)
blift f x act =3D liftM (f x) act

(&<&) :: Monad m =3D> Bool -> m Bool -> m Bool
True &<& xs =3D xs
False &<& _ =3D return False

(|<|) :: Monad m =3D> Bool -> m Bool -> m Bool
True |<| xs =3D return True
False |<| xs =3D xs

andML :: Monad m =3D> Mlist m Bool -> m Bool
andML xs =3D foldrML (&<&) (return True) xs
orML :: Monad m =3D> Mlist m Bool -> m Bool
orML xs =3D foldrML (|<|) (return False) xs

anyML :: Monad m =3D> (a->Bool) -> Mlist m a -> m(Bool)
anyML p xs =3D orML $ fmap p xs
allML :: Monad m =3D> (a->Bool) -> Mlist m a -> m(Bool)
allML p xs =3D andML $ fmap p xs

sumML :: (Monad m,Num a) =3D> Mlist m a -> m a
sumML NIL =3D return 0
sumML (x:<:ms) =3D liftM (+x) (ms>>=3D sumML)

productML :: (Monad m,Num a) =3D> Mlist m a -> m a
productML NIL =3D return 1
productML (x:<:ms) =3D liftM (*x) (ms>>=3D productML)

sequenceML :: Monad m =3D> [m a] -> m(Mlist m a)
sequenceML [] =3D return NIL
sequenceML (x:xs) =3D liftM (:<: sequenceML xs) x

listEmbed :: Monad m =3D> [a] -> Mlist m a
listEmbed [] =3D NIL
listEmbed (x:xs) =3D x :<: return (listEmbed xs)

filterML :: Monad m =3D> (a->Bool) -> Mlist m a -> m(Mlist m a)
filterML _ NIL =3D return NIL
filterML p (x :<: ms)
    | p x =3D return (x :<: rs)
    | otherwise =3D rs
      where rs =3D ms >>=3D filterML p

takeWhileML :: Monad m =3D> (a->Bool) -> Mlist m a -> Mlist m a
takeWhileML _ NIL =3D NIL
takeWhileML p (x :<: ms)
	| p x =3D x :<: (liftM (takeWhileML p) ms)
	| otherwise =3D NIL	=


dropWhileML :: Monad m =3D> (a->Bool) -> Mlist m a -> m(Mlist m a)
dropWhileML _ NIL =3D return NIL
dropWhileML p (x :<: ms)
	| p x =3D ms >>=3D dropWhileML p
	| otherwise =3D return (x :<: ms)

sequenceWhile_ :: Monad m =3D> (a-> Bool) -> [m a] -> m ()
sequenceWhile_ p xs =3D do
			ml<-sequenceML xs
			mlToList $ takeWhileML p ml
                        return ()

showMLIO :: Show a =3D> Mlist IO a -> IO ()
showMLIO NIL =3D putStr "[]"
showMLIO (x:<:ms) =3D =

	do
		putStr "["
		putStr (show x)
		ms >>=3D showRest
	where
	showRest NIL =3D putStr "]"
	showRest (y :<: ys) =3D
		do
			putStr ","
			putStr (show y)
			ys >>=3D showRest
			=

{- not lazy enough -}
showMLx :: (Monad m,Show a) =3D> Mlist m a -> m (String)
showMLx NIL =3D return "[]"
showMLx (x:<:ms) =3D =

	liftM (("[" ++ show x) ++) (ms >>=3D showRest)
	where
	showRest NIL =3D return "]"
	showRest (y :<: ys) =3D
		liftM ((","++show y)++) (ys >>=3D showRest)

singletonML x =3D x :<: return NIL

showML :: (Monad m,Show a) =3D> Mlist m a -> Mlist m Char
showML NIL =3D listEmbed "[]"
showML (x:<:ms) =3D
	'[' :<: (listEmbed(show x) +<+ liftM showRest ms)
	where
	showRest NIL =3D singletonML ']'
	showRest (y:<:ys) =3D
		',' :<: (listEmbed(show y) +<+ (liftM showRest ys))


putStrML :: Mlist IO Char -> IO ()
putStrML NIL =3D return ()
putStrML (c :<: cs) =3D putChar c >> (cs >>=3D putStrML)

{-
type StringM m =3D Mlist m Char
type ShowM m =3D m (StringM m) -> m (StringM m)

class ShowML where
	showML :: Monad m =3D> a -> m (StringM m)
	showsPrecML :: Monad m =3D> Int -> a -> ShowM m
	showML t =3D showsPrecML 0 t (return NIL)
	showsPrecML n t ms =3D showML t +<+ ms
-}
--==_Exmh_-17196631560--