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 =
do xs <- getStrings
putStrLn(headML xs)
getStrings =
do { x <- getLine; if x=="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
module ListForMonad where
import Monad
data Mlist m a = NIL | a :<: m (Mlist m a)
nullML :: Mlist m a -> Bool
nullML NIL = True
nullML _ = False
(<:) :: Monad m => a -> m (Mlist m a) -> m (Mlist m a)
x <: ms = return (x :<: ms)
(+<+) :: Monad m => Mlist m a -> m (Mlist m a) -> m (Mlist m a)
xs +<+ ms = foldrML (<:) ms xs
(!<!) :: Monad m => Mlist m a -> Int -> m a
NIL !<! _ = error "index out of bounds"
(x :<: ms) !<! 0 = return x
(_ :<: ms) !<! n = ms >>= (!<! (n-1))
lengthML :: Monad m => Mlist m a -> m Int
lengthML NIL = return 0
lengthML (_ :<: ms) = liftM (+1) (ms >>= lengthML)
headML :: Mlist m a -> a
headML (x :<: _ ) = x
headML NIL = error "head of empty list"
lastML :: Monad m => Mlist m a -> m a
lastML (x :<: ms) =
do xs<-ms
case xs of NIL -> return x
p -> lastML p
lastML NIL = error "last of empty list"
tailML :: Mlist m a -> m (Mlist m a)
tailML (_ :<: ms) = ms
tailML NIL = error "tail of empty list"
initML :: Monad m => Mlist m a -> m (Mlist m a)
initML NIL = error "init of empty list"
initML (x :<: ms) =
do xs<-ms
case xs of NIL -> return NIL
p -> return (x :<: initML p)
replicateML :: Monad m => Int -> m a -> m (Mlist m a)
replicateML n a = liftM (takeML n) (repeatML a)
repeatML :: Monad m => m a -> m (Mlist m a)
repeatML action = xs
where
xs = do { r<-action; return (r :<: xs) }
takeML :: Monad m => Int -> Mlist m a -> Mlist m a
takeML _ NIL = NIL
takeML 0 _ = NIL
takeML n (x:<:ms) = x :<: (liftM (takeML (n-1)) ms)
dropML :: Monad m => Int -> Mlist m a -> m(Mlist m a)
dropML 0 xs = return xs
dropML _ NIL = return NIL
dropML n (x:<:ms) = ms >>= dropML (n-1)
splitAtML :: Monad m => Int -> Mlist m a -> m (Mlist m a, m(Mlist m a))
splitAtML 0 xs = return (NIL, return xs)
splitAtML n NIL = return (NIL, return NIL)
splitAtML n (x:<: ms) =
do m<-ms
(as,ns)<-splitAtML (n-1) m
return (x :<: return as,ns)
reverseML :: Monad m => Mlist m a -> m (Mlist m a)
reverseML ms =
do xs <- mlToList ms
foldr (<:) (return NIL) (reverse xs)
zipML :: Monad m => Mlist m a -> Mlist m b -> Mlist m (a,b)
zipML (x:<:ms) (y:<:ns) = (x,y) :<: do { xs<-ms; ys<-ns; return(zipML xs ys) }
zipML _ _ = NIL
unzipML :: Monad m => Mlist m (a,b) -> (Mlist m a,Mlist m b)
unzipML xs = (fmap fst xs,fmap snd xs) {- note: re-evaluation -}
instance Monad m => Functor (Mlist m) where
fmap f NIL = NIL
fmap f (x:<:ms) = f x :<: (liftM (fmap f) ms)
mlToList :: Monad m => Mlist m a -> m [a]
mlToList NIL = return []
mlToList (x :<: ms) = liftM (x:)(ms >>= mlToList)
foldrML :: Monad m => (a -> m b -> m b) -> m b -> Mlist m a -> m b
foldrML f n NIL = n
foldrML f n (x :<: ms) = f x (ms >>= foldrML f n)
blift :: Monad m => (a->b->b) -> (a-> m b -> m b)
blift f x act = liftM (f x) act
(&<&) :: Monad m => Bool -> m Bool -> m Bool
True &<& xs = xs
False &<& _ = return False
(|<|) :: Monad m => Bool -> m Bool -> m Bool
True |<| xs = return True
False |<| xs = xs
andML :: Monad m => Mlist m Bool -> m Bool
andML xs = foldrML (&<&) (return True) xs
orML :: Monad m => Mlist m Bool -> m Bool
orML xs = foldrML (|<|) (return False) xs
anyML :: Monad m => (a->Bool) -> Mlist m a -> m(Bool)
anyML p xs = orML $ fmap p xs
allML :: Monad m => (a->Bool) -> Mlist m a -> m(Bool)
allML p xs = andML $ fmap p xs
sumML :: (Monad m,Num a) => Mlist m a -> m a
sumML NIL = return 0
sumML (x:<:ms) = liftM (+x) (ms>>= sumML)
productML :: (Monad m,Num a) => Mlist m a -> m a
productML NIL = return 1
productML (x:<:ms) = liftM (*x) (ms>>= productML)
sequenceML :: Monad m => [m a] -> m(Mlist m a)
sequenceML [] = return NIL
sequenceML (x:xs) = liftM (:<: sequenceML xs) x
listEmbed :: Monad m => [a] -> Mlist m a
listEmbed [] = NIL
listEmbed (x:xs) = x :<: return (listEmbed xs)
filterML :: Monad m => (a->Bool) -> Mlist m a -> m(Mlist m a)
filterML _ NIL = return NIL
filterML p (x :<: ms)
| p x = return (x :<: rs)
| otherwise = rs
where rs = ms >>= filterML p
takeWhileML :: Monad m => (a->Bool) -> Mlist m a -> Mlist m a
takeWhileML _ NIL = NIL
takeWhileML p (x :<: ms)
| p x = x :<: (liftM (takeWhileML p) ms)
| otherwise = NIL
dropWhileML :: Monad m => (a->Bool) -> Mlist m a -> m(Mlist m a)
dropWhileML _ NIL = return NIL
dropWhileML p (x :<: ms)
| p x = ms >>= dropWhileML p
| otherwise = return (x :<: ms)
sequenceWhile_ :: Monad m => (a-> Bool) -> [m a] -> m ()
sequenceWhile_ p xs = do
ml<-sequenceML xs
mlToList $ takeWhileML p ml
return ()
showMLIO :: Show a => Mlist IO a -> IO ()
showMLIO NIL = putStr "[]"
showMLIO (x:<:ms) =
do
putStr "["
putStr (show x)
ms >>= showRest
where
showRest NIL = putStr "]"
showRest (y :<: ys) =
do
putStr ","
putStr (show y)
ys >>= showRest
{- not lazy enough -}
showMLx :: (Monad m,Show a) => Mlist m a -> m (String)
showMLx NIL = return "[]"
showMLx (x:<:ms) =
liftM (("[" ++ show x) ++) (ms >>= showRest)
where
showRest NIL = return "]"
showRest (y :<: ys) =
liftM ((","++show y)++) (ys >>= showRest)
singletonML x = x :<: return NIL
showML :: (Monad m,Show a) => Mlist m a -> Mlist m Char
showML NIL = listEmbed "[]"
showML (x:<:ms) =
'[' :<: (listEmbed(show x) +<+ liftM showRest ms)
where
showRest NIL = singletonML ']'
showRest (y:<:ys) =
',' :<: (listEmbed(show y) +<+ (liftM showRest ys))
putStrML :: Mlist IO Char -> IO ()
putStrML NIL = return ()
putStrML (c :<: cs) = putChar c >> (cs >>= putStrML)
{-
type StringM m = Mlist m Char
type ShowM m = m (StringM m) -> m (StringM m)
class ShowML where
showML :: Monad m => a -> m (StringM m)
showsPrecML :: Monad m => Int -> a -> ShowM m
showML t = showsPrecML 0 t (return NIL)
showsPrecML n t ms = showML t +<+ ms
-}
