{-# LANGUAGE CPP                       #-}
{-# LANGUAGE ExistentialQuantification #-}

-- |
-- Module      : Unicode.Internal.Unfold
-- Copyright   : (c) 2022 Composewell Technologies and Contributors
-- License     : BSD-3-Clause
-- Maintainer  : streamly@composewell.com
-- Stability   : experimental
-- Portability : GHC
--
-- @since 0.3.1
--

module Unicode.Internal.Unfold
    ( Unfold(..)
    , Step(..)
    , toList
    ) where

import GHC.Base (build)

-- | An @Unfold a b@ is a generator of a stream of values of type @b@ from a
-- seed of type @a@.
--
-- @since 0.3.1
#if MIN_VERSION_base(4,12,0)
data Unfold a b = forall s. Unfold
    (s -> Step s b)
    -- ^ /Step/ function: compute the next step from the current one.
    (a -> Step s b)
    -- ^ /Inject/ function: initialize the state with a seed value.
#else
data Unfold a b =
    -- | @Unfold step inject@
    forall s. Unfold (s -> Step s b) (a -> Step s b)
#endif

-- | A stream is a succession of 'Step's.
--
-- @since 0.3.1
data Step s a
    = Yield !a !s
    -- ^ Produces a single value and the next state of the stream.
    | Stop
    -- ^ Indicates there are no more values in the stream.

instance Functor (Step s) where
    {-# INLINE fmap #-}
    fmap :: forall a b. (a -> b) -> Step s a -> Step s b
fmap a -> b
f (Yield a
x s
s) = b -> s -> Step s b
forall s a. a -> s -> Step s a
Yield (a -> b
f a
x) s
s
    fmap a -> b
_ Step s a
Stop        = Step s b
forall s a. Step s a
Stop

-- | Convert an 'Unfold a a' to a list [a], if the resulting list is empty the
-- seed is used as a default output.
--
{-# INLINE toList #-}
toList :: Unfold a a -> a -> [a]
toList :: forall a. Unfold a a -> a -> [a]
toList (Unfold s -> Step s a
step a -> Step s a
inject) a
input =
    case a -> Step s a
inject a
input of
        Step s a
Stop -> [a
input]
        Yield a
b s
s0 -> a
b a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (forall b. (a -> b -> b) -> b -> b) -> [a]
forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
build
                        ( \a -> b -> b
c b
n ->
                            let go :: s -> b
go s
s = case s -> Step s a
step s
s of
                                    Yield a
a s
s' -> a
a a -> b -> b
`c` s -> b
go s
s'
                                    Step s a
Stop -> b
n
                            in s -> b
go s
s0
                        )