Haskell bubble sort with ST monad and STref

bsort_st.hs

-- video https://www.youtube.com/watch?v=9JDPGvc6UmI
import Control.Monad.ST
import Data.IntMap.Strict
import Data.STRef (newSTRef, readSTRef, writeSTRef, modifySTRef)
import Control.Monad

until_ :: Monad m => m a -> m Bool -> m ()
until_ a p = do
              a
              b <- p
              if b then until_ a p else return ()

pa :: IO Bool
pa = readLn >>= (\l -> if l == "stop" then return False else return True)

bsort :: Ord a => [a] -> ST s [a]
bsort l = do
            l_ <- mapM newSTRef l
            let l__ = zip [0..] l_
            let d = fromList l__
            ref_last <- newSTRef $ length l - 2
            ref_swaped <- newSTRef $ False
            until_ (a ref_swaped ref_last d) (p ref_swaped ref_last)
            mapM readSTRef (elems d)
              where
                a ref_swaped ref_last d = do
                      last <- readSTRef ref_last
                      writeSTRef ref_swaped False
                      forM_ [0..last] $ \i -> do
                          let e1r = findWithDefault (error "no index") i d
                          let e2r = findWithDefault (error "no index") (i+1) d
                          e1 <- readSTRef e1r
                          e2 <- readSTRef e2r
                          when (e1>e2) $ do_swap ref_swaped e1r e1 e2r e2
                      modifySTRef ref_last (flip (-) 1)

                p ref_swaped ref_last= do
                      is_sw <- readSTRef ref_swaped
                      last <- readSTRef ref_last
                      if not is_sw || last == -1 then return False else return True
                do_swap ref_swaped e1r e1 e2r e2  = do
                            writeSTRef e1r e2
                            writeSTRef e2r e1
                            writeSTRef ref_swaped True




-- f x = let y = 1 in y + x + g
--       where g = x + 1 + y

video - https://www.youtube.com/watch?v=9JDPGvc6UmI