{-# LANGUAGE BangPatterns #-}

module Text.EditDistance.MonadUtilities where

{-# INLINE loopM_ #-}
loopM_ :: Monad m => Int -> Int -> (Int -> m ()) -> m ()
loopM_ :: Int -> Int -> (Int -> m ()) -> m ()
loopM_ Int
xfrom Int
xto Int -> m ()
action = Int -> Int -> m ()
go Int
xfrom Int
xto
  where
    go :: Int -> Int -> m ()
go Int
from Int
to | Int
from Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
to = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
               | Bool
otherwise = do Int -> m ()
action Int
from
                                Int -> Int -> m ()
go (Int
from Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
to

-- foldM in Control.Monad is not defined using SAT style so optimises very poorly
{-# INLINE foldM #-}
foldM             :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a
foldM :: (a -> b -> m a) -> a -> [b] -> m a
foldM a -> b -> m a
f a
x [b]
xs = (b -> (a -> m a) -> a -> m a) -> (a -> m a) -> [b] -> a -> m a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\b
y a -> m a
rest a
a -> a -> b -> m a
f a
a b
y m a -> (a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> m a
rest) a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [b]
xs a
x
{-
-- If we define it like this, then we aren't able to deforest wrt. a "build" in xs, which would be sad :(
foldM f = go
  where go a (x:xs)  =  f a x >>= \fax -> go fax xs
        go a []      =  return a
-}

-- If we just use a standard foldM then our loops often box stuff up to return from the loop which is then immediately discarded
-- TODO: using this instead of foldM improves our benchmarks by about 2% but makes the code quite ugly.. figure out what to do
{-# INLINE foldMK #-}
foldMK             :: (Monad m) => (a -> b -> m a) -> a -> [b] -> (a -> m res) -> m res
foldMK :: (a -> b -> m a) -> a -> [b] -> (a -> m res) -> m res
foldMK a -> b -> m a
f a
x [b]
xs a -> m res
k = (b -> (a -> m res) -> a -> m res)
-> (a -> m res) -> [b] -> a -> m res
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\b
y a -> m res
rest a
a -> a -> b -> m a
f a
a b
y m a -> (a -> m res) -> m res
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> m res
rest) a -> m res
k [b]
xs a
x