while loop for ST Monad

while.hs

{-# LANGUAGE PackageImports #-}
import Control.Monad
import Control.Applicative ((<$>),(<*>))
import Control.Monad.ST
import Data.STRef
import "mtl" Control.Monad.State

main = do
  print $ twdst 10 
  print $ tdwst 10 
  print $ twdst 0 
  print $ tdwst 0 
  print $ twds 10 
  print $ tdws 10 
  print $ twds 0 
  print $ tdws 0 


twdst :: Int -> (Int,[Int])
twdst m = runST $ do
  ri <- newSTRef 0
  rl <- newSTRef []
  whileDo ( (m>) <$> (readSTRef ri) ) $ do
    i <- readSTRef ri
    modifySTRef rl (i:)
    writeSTRef ri (i+1)

  (,) <$> readSTRef ri <*> readSTRef rl


twds :: Int -> (Int,[Int])
twds m = ( `execState` (0,[]) ) $
         whileDo ( (m>).fst <$> get ) $ modify $ \(i,l) -> (i+1,i:l)


tdwst :: Int -> (Int,[Int])
tdwst m = runST $ do
  ri <- newSTRef 0
  rl <- newSTRef []
  doWhile (
    do
      i <- readSTRef ri
      modifySTRef rl (i:)
      writeSTRef ri (i+1)
    ) $ (m>) <$> (readSTRef ri)
    
  (,) <$> readSTRef ri <*> readSTRef rl


tdws :: Int -> (Int,[Int])
tdws m = (`execState` (0,[])) $
         doWhile (modify $ \(i,l) -> (i+1,i:l)) $ (m>).fst <$> get 




whileDo :: Monad m => m Bool -> m () -> m ()
whileDo fcond fbody = loop
  where
    loop = do
      c <- fcond
      if c
        then fbody >> loop
        else return ()


doWhile :: Monad m => m () -> m Bool -> m ()
doWhile fbody fcond = loop
  where
    loop = do
      fbody
      c <- fcond
      if c
        then loop
        else return ()