-- | Traversing IO lists.
--
--   Code from this module is derived from [Twan van Laarhoven](https://www.twanvl.nl/blog/haskell/unsafe-sequence).
--
--   These operations are tail recursive, while building lists by appending
--   to its tail mutably.
module Data.Traversable.IO (
    sequenceIO
  , traverseIO
  , unfoldIO
) where

import Data.ListBuilder.Unsafe

import Prelude hiding (length)


-- | Traverse implemented in terms of unsafeSetField.
--
--   This operation is tail recursive.
traverseIO :: (a -> IO b) -> [a] -> IO [b]
traverseIO :: forall a b. (a -> IO b) -> [a] -> IO [b]
traverseIO a -> IO b
_ [] =
  [b] -> IO [b]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
traverseIO a -> IO b
f (a
mx0:[a]
xs0) = do
  b
x0 <- a -> IO b
f a
mx0
  let front :: [b]
front = [b
x0]
  [b] -> [a] -> IO ()
go [b]
front [a]
xs0
  [b] -> IO [b]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [b]
front
    where
  go :: [b] -> [a] -> IO ()
go [b]
_ [] = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  go [b]
back (a
mx:[a]
xs) = do
    b
x <- a -> IO b
f a
mx
    let back' :: [b]
back' = [b
x]
    Int -> [b] -> [b] -> IO ()
forall a b. Int -> a -> b -> IO ()
unsafeSetField Int
1 [b]
back [b]
back'
    [b] -> [a] -> IO ()
go [b]
back' [a]
xs
{-# INLINEABLE traverseIO #-}


-- | Sequence implemented in terms of unsafeSetField
--
--   This operation is tail recursive.
sequenceIO :: [IO a] -> IO [a]
sequenceIO :: forall a. [IO a] -> IO [a]
sequenceIO =
  (IO a -> IO a) -> [IO a] -> IO [a]
forall a b. (a -> IO b) -> [a] -> IO [b]
traverseIO IO a -> IO a
forall a. a -> a
id
{-# INLINE sequenceIO #-}


-- | Unfold a list from an IO action returning a 'Maybe' value.
--   As long as the function returns `Just`, its value will
--   be appended to the list.
unfoldIO :: IO (Maybe a) -> IO [a]
unfoldIO :: forall a. IO (Maybe a) -> IO [a]
unfoldIO IO (Maybe a)
p = do
  Maybe a
x <- IO (Maybe a)
p
  case Maybe a
x of
    Maybe a
Nothing ->
      [a] -> IO [a]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    Just a
a -> do
      let front :: [a]
front = [a
a]
      [a] -> IO ()
go [a]
front
      [a] -> IO [a]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [a]
front
    where
  go :: [a] -> IO ()
go [a]
back = do
    Maybe a
x <- IO (Maybe a)
p
    case Maybe a
x of
      Maybe a
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just a
a  -> do
        let back' :: [a]
back' = [a
a]
        Int -> [a] -> [a] -> IO ()
forall a b. Int -> a -> b -> IO ()
unsafeSetField Int
1 [a]
back [a]
back'
        [a] -> IO ()
go [a]
back'
{-# INLINEABLE unfoldIO #-}