{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE StrictData #-}

-- | Helper functions and types for Data.Stream. You will typically not need them.
module Data.Stream.Internal where

-- | A strict tuple type
data JointState a b = JointState a b

-- | Internal state of the result of 'Alternative' constructions
data Alternatively stateL stateR = Undecided | DecideL stateL | DecideR stateR

-- | Internal state of 'many' and 'some'
data Many state x = NotStarted | Ongoing x state | Finished

-- newtype makes GHC loop on using fixStream
{- HLINT ignore Fix "Use newtype instead of data" -}
data Fix t = Fix {forall (t :: Type -> Type). Fix t -> t (Fix t)
getFix :: ~(t (Fix t))}

fixState :: (forall s. s -> t s) -> Fix t
fixState :: forall (t :: Type -> Type). (forall s. s -> t s) -> Fix t
fixState forall s. s -> t s
transformState = Fix t
go
  where
    go :: Fix t
go = t (Fix t) -> Fix t
forall (t :: Type -> Type). t (Fix t) -> Fix t
Fix (t (Fix t) -> Fix t) -> t (Fix t) -> Fix t
forall a b. (a -> b) -> a -> b
$ Fix t -> t (Fix t)
forall s. s -> t s
transformState Fix t
go