{-# OPTIONS_GHC -Wno-redundant-constraints -Wno-orphans #-}

module DeferredFolds.Defs.Unfoldr where

import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Short.Internal as ShortByteString
import qualified Data.HashMap.Strict as HashMap
import qualified Data.IntMap.Strict as IntMap
import qualified Data.IntSet as IntSet
import qualified Data.Map.Strict as Map
import qualified Data.Text.Internal as TextInternal
import qualified Data.Vector.Generic as GenericVector
import DeferredFolds.Prelude hiding (fold, reverse)
import qualified DeferredFolds.Prelude as Prelude
import DeferredFolds.Types
import qualified DeferredFolds.Util.TextArray as TextArrayUtil

deriving instance Functor Unfoldr

instance Applicative Unfoldr where
  pure :: forall a. a -> Unfoldr a
pure a
x = (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
forall a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr (\a -> x -> x
step -> a -> x -> x
step a
x)
  <*> :: forall a b. Unfoldr (a -> b) -> Unfoldr a -> Unfoldr b
(<*>) = Unfoldr (a -> b) -> Unfoldr a -> Unfoldr b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Alternative Unfoldr where
  empty :: forall a. Unfoldr a
empty = (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
forall a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr ((x -> x) -> (a -> x -> x) -> x -> x
forall a b. a -> b -> a
const x -> x
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id)
  {-# INLINE (<|>) #-}
  <|> :: forall a. Unfoldr a -> Unfoldr a -> Unfoldr a
(<|>) (Unfoldr forall x. (a -> x -> x) -> x -> x
left) (Unfoldr forall x. (a -> x -> x) -> x -> x
right) = (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
forall a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr (\a -> x -> x
step x
init -> (a -> x -> x) -> x -> x
forall x. (a -> x -> x) -> x -> x
left a -> x -> x
step ((a -> x -> x) -> x -> x
forall x. (a -> x -> x) -> x -> x
right a -> x -> x
step x
init))

instance Monad Unfoldr where
  return :: forall a. a -> Unfoldr a
return = a -> Unfoldr a
forall a. a -> Unfoldr a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  {-# INLINE (>>=) #-}
  >>= :: forall a b. Unfoldr a -> (a -> Unfoldr b) -> Unfoldr b
(>>=) (Unfoldr forall x. (a -> x -> x) -> x -> x
left) a -> Unfoldr b
rightK =
    (forall x. (b -> x -> x) -> x -> x) -> Unfoldr b
forall a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr ((forall x. (b -> x -> x) -> x -> x) -> Unfoldr b)
-> (forall x. (b -> x -> x) -> x -> x) -> Unfoldr b
forall a b. (a -> b) -> a -> b
$ \b -> x -> x
step -> (a -> x -> x) -> x -> x
forall x. (a -> x -> x) -> x -> x
left ((a -> x -> x) -> x -> x) -> (a -> x -> x) -> x -> x
forall a b. (a -> b) -> a -> b
$ \a
input -> case a -> Unfoldr b
rightK a
input of Unfoldr forall x. (b -> x -> x) -> x -> x
right -> (b -> x -> x) -> x -> x
forall x. (b -> x -> x) -> x -> x
right b -> x -> x
step

instance MonadPlus Unfoldr where
  mzero :: forall a. Unfoldr a
mzero = Unfoldr a
forall a. Unfoldr a
forall (f :: * -> *) a. Alternative f => f a
empty
  mplus :: forall a. Unfoldr a -> Unfoldr a -> Unfoldr a
mplus = Unfoldr a -> Unfoldr a -> Unfoldr a
forall a. Unfoldr a -> Unfoldr a -> Unfoldr a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)

instance Semigroup (Unfoldr a) where
  <> :: Unfoldr a -> Unfoldr a -> Unfoldr a
(<>) = Unfoldr a -> Unfoldr a -> Unfoldr a
forall a. Unfoldr a -> Unfoldr a -> Unfoldr a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)

instance Monoid (Unfoldr a) where
  mempty :: Unfoldr a
mempty = Unfoldr a
forall a. Unfoldr a
forall (f :: * -> *) a. Alternative f => f a
empty
  mappend :: Unfoldr a -> Unfoldr a -> Unfoldr a
mappend = Unfoldr a -> Unfoldr a -> Unfoldr a
forall a. Semigroup a => a -> a -> a
(<>)

instance Foldable Unfoldr where
  {-# INLINE foldMap #-}
  foldMap :: forall m a. Monoid m => (a -> m) -> Unfoldr a -> m
foldMap a -> m
fn (Unfoldr forall x. (a -> x -> x) -> x -> x
unfoldr) = (a -> m -> m) -> m -> m
forall x. (a -> x -> x) -> x -> x
unfoldr (m -> m -> m
forall a. Monoid a => a -> a -> a
mappend (m -> m -> m) -> (a -> m) -> a -> m -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> m
fn) m
forall a. Monoid a => a
mempty
  {-# INLINE foldr #-}
  foldr :: forall a b. (a -> b -> b) -> b -> Unfoldr a -> b
foldr a -> b -> b
step b
state (Unfoldr forall x. (a -> x -> x) -> x -> x
run) = (a -> b -> b) -> b -> b
forall x. (a -> x -> x) -> x -> x
run a -> b -> b
step b
state
  foldl :: forall b a. (b -> a -> b) -> b -> Unfoldr a -> b
foldl = (b -> a -> b) -> b -> Unfoldr a -> b
forall b a. (b -> a -> b) -> b -> Unfoldr a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
  {-# INLINE foldl' #-}
  foldl' :: forall b a. (b -> a -> b) -> b -> Unfoldr a -> b
foldl' b -> a -> b
leftStep b
state (Unfoldr forall x. (a -> x -> x) -> x -> x
unfoldr) = (a -> (b -> b) -> b -> b) -> (b -> b) -> b -> b
forall x. (a -> x -> x) -> x -> x
unfoldr a -> (b -> b) -> b -> b
rightStep b -> b
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id b
state
    where
      rightStep :: a -> (b -> b) -> b -> b
rightStep a
element b -> b
k b
state = b -> b
k (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$! b -> a -> b
leftStep b
state a
element

instance Traversable Unfoldr where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Unfoldr a -> f (Unfoldr b)
traverse a -> f b
f (Unfoldr forall x. (a -> x -> x) -> x -> x
unfoldr) =
    (a -> f (Unfoldr b) -> f (Unfoldr b))
-> f (Unfoldr b) -> f (Unfoldr b)
forall x. (a -> x -> x) -> x -> x
unfoldr (\a
a f (Unfoldr b)
next -> (b -> Unfoldr b -> Unfoldr b)
-> f b -> f (Unfoldr b) -> f (Unfoldr b)
forall a b c. (a -> b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 b -> Unfoldr b -> Unfoldr b
forall a. a -> Unfoldr a -> Unfoldr a
cons (a -> f b
f a
a) f (Unfoldr b)
next) (Unfoldr b -> f (Unfoldr b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Unfoldr b
forall a. Monoid a => a
mempty)

instance (Eq a) => Eq (Unfoldr a) where
  == :: Unfoldr a -> Unfoldr a -> Bool
(==) Unfoldr a
left Unfoldr a
right = Unfoldr a -> [Item (Unfoldr a)]
forall l. IsList l => l -> [Item l]
toList Unfoldr a
left [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== Unfoldr a -> [Item (Unfoldr a)]
forall l. IsList l => l -> [Item l]
toList Unfoldr a
right

instance (Show a) => Show (Unfoldr a) where
  show :: Unfoldr a -> String
show = [Item (Unfoldr a)] -> String
forall a. Show a => a -> String
show ([Item (Unfoldr a)] -> String)
-> (Unfoldr a -> [Item (Unfoldr a)]) -> Unfoldr a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Unfoldr a -> [Item (Unfoldr a)]
forall l. IsList l => l -> [Item l]
toList

instance IsList (Unfoldr a) where
  type Item (Unfoldr a) = a
  fromList :: [Item (Unfoldr a)] -> Unfoldr a
fromList [Item (Unfoldr a)]
list = [a] -> Unfoldr a
forall (foldable :: * -> *) a.
Foldable foldable =>
foldable a -> Unfoldr a
foldable [a]
[Item (Unfoldr a)]
list
  toList :: Unfoldr a -> [Item (Unfoldr a)]
toList = (a -> [a] -> [a]) -> [a] -> Unfoldr a -> [a]
forall a b. (a -> b -> b) -> b -> Unfoldr a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (:) []

-- | Apply a Gonzalez fold
{-# INLINE fold #-}
fold :: Fold input output -> Unfoldr input -> output
fold :: forall input output. Fold input output -> Unfoldr input -> output
fold (Fold x -> input -> x
step x
init x -> output
extract) (Unfoldr forall x. (input -> x -> x) -> x -> x
run) =
  (input -> (x -> output) -> x -> output)
-> (x -> output) -> x -> output
forall x. (input -> x -> x) -> x -> x
run (\input
input x -> output
next x
state -> x -> output
next (x -> output) -> x -> output
forall a b. (a -> b) -> a -> b
$! x -> input -> x
step x
state input
input) x -> output
extract x
init

-- | Apply a monadic Gonzalez fold
{-# INLINE foldM #-}
foldM :: (Monad m) => FoldM m input output -> Unfoldr input -> m output
foldM :: forall (m :: * -> *) input output.
Monad m =>
FoldM m input output -> Unfoldr input -> m output
foldM (FoldM x -> input -> m x
step m x
init x -> m output
extract) (Unfoldr forall x. (input -> x -> x) -> x -> x
unfoldr) =
  m x
init m x -> (x -> m x) -> m x
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (input -> (x -> m x) -> x -> m x) -> (x -> m x) -> x -> m x
forall x. (input -> x -> x) -> x -> x
unfoldr (\input
input x -> m x
next x
state -> x -> input -> m x
step x
state input
input m x -> (x -> m x) -> m x
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= x -> m x
next) x -> m x
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return m x -> (x -> m output) -> m output
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= x -> m output
extract

-- | Construct from any value by supplying a definition of foldr
{-# INLINE foldrAndContainer #-}
foldrAndContainer :: (forall x. (elem -> x -> x) -> x -> container -> x) -> container -> Unfoldr elem
foldrAndContainer :: forall elem container.
(forall x. (elem -> x -> x) -> x -> container -> x)
-> container -> Unfoldr elem
foldrAndContainer forall x. (elem -> x -> x) -> x -> container -> x
foldr container
a = (forall x. (elem -> x -> x) -> x -> x) -> Unfoldr elem
forall a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr (\elem -> x -> x
step x
init -> (elem -> x -> x) -> x -> container -> x
forall x. (elem -> x -> x) -> x -> container -> x
foldr elem -> x -> x
step x
init container
a)

-- | Construct from any foldable
{-# INLINE foldable #-}
foldable :: (Foldable foldable) => foldable a -> Unfoldr a
foldable :: forall (foldable :: * -> *) a.
Foldable foldable =>
foldable a -> Unfoldr a
foldable = (forall x. (a -> x -> x) -> x -> foldable a -> x)
-> foldable a -> Unfoldr a
forall elem container.
(forall x. (elem -> x -> x) -> x -> container -> x)
-> container -> Unfoldr elem
foldrAndContainer (a -> x -> x) -> x -> foldable a -> x
forall x. (a -> x -> x) -> x -> foldable a -> x
forall a b. (a -> b -> b) -> b -> foldable a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr

-- | Elements of IntSet.
{-# INLINE intSet #-}
intSet :: IntSet -> Unfoldr Int
intSet :: IntSet -> Unfoldr Int
intSet = (forall x. (Int -> x -> x) -> x -> IntSet -> x)
-> IntSet -> Unfoldr Int
forall elem container.
(forall x. (elem -> x -> x) -> x -> container -> x)
-> container -> Unfoldr elem
foldrAndContainer (Int -> x -> x) -> x -> IntSet -> x
forall x. (Int -> x -> x) -> x -> IntSet -> x
IntSet.foldr

-- | Filter the values given a predicate
{-# INLINE filter #-}
filter :: (a -> Bool) -> Unfoldr a -> Unfoldr a
filter :: forall a. (a -> Bool) -> Unfoldr a -> Unfoldr a
filter a -> Bool
test (Unfoldr forall x. (a -> x -> x) -> x -> x
run) = (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
forall a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr (\a -> x -> x
step -> (a -> x -> x) -> x -> x
forall x. (a -> x -> x) -> x -> x
run (\a
element x
state -> if a -> Bool
test a
element then a -> x -> x
step a
element x
state else x
state))

-- | Ascending infinite stream of enums starting from the one specified
{-# INLINE enumsFrom #-}
enumsFrom :: (Enum a) => a -> Unfoldr a
enumsFrom :: forall a. Enum a => a -> Unfoldr a
enumsFrom a
from = (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
forall a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr ((forall x. (a -> x -> x) -> x -> x) -> Unfoldr a)
-> (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
forall a b. (a -> b) -> a -> b
$ \a -> x -> x
step x
init ->
  let loop :: a -> x
loop a
int = a -> x -> x
step a
int (a -> x
loop (a -> a
forall a. Enum a => a -> a
succ a
int))
   in a -> x
loop a
from

-- | Enums in the specified inclusive range
{-# INLINE enumsInRange #-}
enumsInRange :: (Enum a, Ord a) => a -> a -> Unfoldr a
enumsInRange :: forall a. (Enum a, Ord a) => a -> a -> Unfoldr a
enumsInRange a
from a
to =
  (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
forall a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr ((forall x. (a -> x -> x) -> x -> x) -> Unfoldr a)
-> (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
forall a b. (a -> b) -> a -> b
$ \a -> x -> x
step x
init ->
    let loop :: a -> x
loop a
int =
          if a
int a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
to
            then a -> x -> x
step a
int (a -> x
loop (a -> a
forall a. Enum a => a -> a
succ a
int))
            else x
init
     in a -> x
loop a
from

-- | Ascending infinite stream of ints starting from the one specified
{-# INLINE intsFrom #-}
intsFrom :: Int -> Unfoldr Int
intsFrom :: Int -> Unfoldr Int
intsFrom = Int -> Unfoldr Int
forall a. Enum a => a -> Unfoldr a
enumsFrom

-- | Ints in the specified inclusive range
{-# INLINE intsInRange #-}
intsInRange :: Int -> Int -> Unfoldr Int
intsInRange :: Int -> Int -> Unfoldr Int
intsInRange = Int -> Int -> Unfoldr Int
forall a. (Enum a, Ord a) => a -> a -> Unfoldr a
enumsInRange

-- | Associations of a map
{-# INLINE mapAssocs #-}
mapAssocs :: Map key value -> Unfoldr (key, value)
mapAssocs :: forall key value. Map key value -> Unfoldr (key, value)
mapAssocs Map key value
map =
  (forall x. ((key, value) -> x -> x) -> x -> x)
-> Unfoldr (key, value)
forall a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr (\(key, value) -> x -> x
step x
init -> (key -> value -> x -> x) -> x -> Map key value -> x
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey (\key
key value
value x
state -> (key, value) -> x -> x
step (key
key, value
value) x
state) x
init Map key value
map)

-- | Associations of an intmap
{-# INLINE intMapAssocs #-}
intMapAssocs :: IntMap value -> Unfoldr (Int, value)
intMapAssocs :: forall value. IntMap value -> Unfoldr (Int, value)
intMapAssocs IntMap value
intMap =
  (forall x. ((Int, value) -> x -> x) -> x -> x)
-> Unfoldr (Int, value)
forall a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr (\(Int, value) -> x -> x
step x
init -> (Int -> value -> x -> x) -> x -> IntMap value -> x
forall a b. (Int -> a -> b -> b) -> b -> IntMap a -> b
IntMap.foldrWithKey (\Int
key value
value x
state -> (Int, value) -> x -> x
step (Int
key, value
value) x
state) x
init IntMap value
intMap)

-- | Keys of a hash-map
{-# INLINE hashMapKeys #-}
hashMapKeys :: HashMap key value -> Unfoldr key
hashMapKeys :: forall key value. HashMap key value -> Unfoldr key
hashMapKeys HashMap key value
hashMap =
  (forall x. (key -> x -> x) -> x -> x) -> Unfoldr key
forall a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr (\key -> x -> x
step x
init -> (key -> value -> x -> x) -> x -> HashMap key value -> x
forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
HashMap.foldrWithKey (\key
key value
_ x
state -> key -> x -> x
step key
key x
state) x
init HashMap key value
hashMap)

-- | Associations of a hash-map
{-# INLINE hashMapAssocs #-}
hashMapAssocs :: HashMap key value -> Unfoldr (key, value)
hashMapAssocs :: forall key value. HashMap key value -> Unfoldr (key, value)
hashMapAssocs HashMap key value
hashMap =
  (forall x. ((key, value) -> x -> x) -> x -> x)
-> Unfoldr (key, value)
forall a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr (\(key, value) -> x -> x
step x
init -> (key -> value -> x -> x) -> x -> HashMap key value -> x
forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
HashMap.foldrWithKey (\key
key value
value x
state -> (key, value) -> x -> x
step (key
key, value
value) x
state) x
init HashMap key value
hashMap)

-- | Value of a hash-map by key
{-# INLINE hashMapAt #-}
hashMapAt :: (Hashable key, Eq key) => HashMap key value -> key -> Unfoldr value
hashMapAt :: forall key value.
(Hashable key, Eq key) =>
HashMap key value -> key -> Unfoldr value
hashMapAt HashMap key value
hashMap key
key = Maybe value -> Unfoldr value
forall (foldable :: * -> *) a.
Foldable foldable =>
foldable a -> Unfoldr a
foldable (key -> HashMap key value -> Maybe value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup key
key HashMap key value
hashMap)

-- | Value of a hash-map by key
{-# INLINE hashMapValue #-}
{-# DEPRECATED hashMapValue "Use 'hashMapAt' instead" #-}
hashMapValue :: (Hashable key, Eq key) => key -> HashMap key value -> Unfoldr value
hashMapValue :: forall key value.
(Hashable key, Eq key) =>
key -> HashMap key value -> Unfoldr value
hashMapValue key
key = Maybe value -> Unfoldr value
forall (foldable :: * -> *) a.
Foldable foldable =>
foldable a -> Unfoldr a
foldable (Maybe value -> Unfoldr value)
-> (HashMap key value -> Maybe value)
-> HashMap key value
-> Unfoldr value
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. key -> HashMap key value -> Maybe value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup key
key

-- | Values of a hash-map by their keys
{-# INLINE hashMapValues #-}
hashMapValues :: (Hashable key, Eq key) => HashMap key value -> Unfoldr key -> Unfoldr value
hashMapValues :: forall key value.
(Hashable key, Eq key) =>
HashMap key value -> Unfoldr key -> Unfoldr value
hashMapValues HashMap key value
hashMap Unfoldr key
keys = Unfoldr key
keys Unfoldr key -> (key -> Unfoldr value) -> Unfoldr value
forall a b. Unfoldr a -> (a -> Unfoldr b) -> Unfoldr b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (key -> HashMap key value -> Unfoldr value)
-> HashMap key value -> key -> Unfoldr value
forall a b c. (a -> b -> c) -> b -> a -> c
flip key -> HashMap key value -> Unfoldr value
forall key value.
(Hashable key, Eq key) =>
key -> HashMap key value -> Unfoldr value
hashMapValue HashMap key value
hashMap

-- | Bytes of a bytestring
{-# INLINE byteStringBytes #-}
byteStringBytes :: ByteString -> Unfoldr Word8
byteStringBytes :: ByteString -> Unfoldr Word8
byteStringBytes ByteString
bs = (forall x. (Word8 -> x -> x) -> x -> x) -> Unfoldr Word8
forall a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr (\Word8 -> x -> x
step x
init -> (Word8 -> x -> x) -> x -> ByteString -> x
forall a. (Word8 -> a -> a) -> a -> ByteString -> a
ByteString.foldr Word8 -> x -> x
step x
init ByteString
bs)

-- | Bytes of a short bytestring
{-# INLINE shortByteStringBytes #-}
shortByteStringBytes :: ShortByteString -> Unfoldr Word8
shortByteStringBytes :: ShortByteString -> Unfoldr Word8
shortByteStringBytes (ShortByteString.SBS ByteArray#
ba#) = PrimArray Word8 -> Unfoldr Word8
forall prim. Prim prim => PrimArray prim -> Unfoldr prim
primArray (ByteArray# -> PrimArray Word8
forall a. ByteArray# -> PrimArray a
PrimArray ByteArray#
ba#)

-- | Elements of a prim array
{-# INLINE primArray #-}
primArray :: (Prim prim) => PrimArray prim -> Unfoldr prim
primArray :: forall prim. Prim prim => PrimArray prim -> Unfoldr prim
primArray PrimArray prim
ba = (forall x. (prim -> x -> x) -> x -> x) -> Unfoldr prim
forall a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr ((forall x. (prim -> x -> x) -> x -> x) -> Unfoldr prim)
-> (forall x. (prim -> x -> x) -> x -> x) -> Unfoldr prim
forall a b. (a -> b) -> a -> b
$ \prim -> x -> x
f x
z -> (prim -> x -> x) -> x -> PrimArray prim -> x
forall a b. Prim a => (a -> b -> b) -> b -> PrimArray a -> b
foldrPrimArray prim -> x -> x
f x
z PrimArray prim
ba

-- | Elements of a prim array coming paired with indices
{-# INLINE primArrayWithIndices #-}
primArrayWithIndices :: (Prim prim) => PrimArray prim -> Unfoldr (Int, prim)
primArrayWithIndices :: forall prim. Prim prim => PrimArray prim -> Unfoldr (Int, prim)
primArrayWithIndices PrimArray prim
pa = (forall x. ((Int, prim) -> x -> x) -> x -> x)
-> Unfoldr (Int, prim)
forall a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr ((forall x. ((Int, prim) -> x -> x) -> x -> x)
 -> Unfoldr (Int, prim))
-> (forall x. ((Int, prim) -> x -> x) -> x -> x)
-> Unfoldr (Int, prim)
forall a b. (a -> b) -> a -> b
$ \(Int, prim) -> x -> x
step x
state ->
  let !size :: Int
size = PrimArray prim -> Int
forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray prim
pa
      loop :: Int -> x
loop Int
index =
        if Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
size
          then (Int, prim) -> x -> x
step (Int
index, PrimArray prim -> Int -> prim
forall a. Prim a => PrimArray a -> Int -> a
indexPrimArray PrimArray prim
pa Int
index) (Int -> x
loop (Int -> Int
forall a. Enum a => a -> a
succ Int
index))
          else x
state
   in Int -> x
loop Int
0

-- | Elements of a vector
{-# INLINE vector #-}
vector :: (GenericVector.Vector vector a) => vector a -> Unfoldr a
vector :: forall (vector :: * -> *) a.
Vector vector a =>
vector a -> Unfoldr a
vector vector a
vector = (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
forall a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr ((forall x. (a -> x -> x) -> x -> x) -> Unfoldr a)
-> (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
forall a b. (a -> b) -> a -> b
$ \a -> x -> x
step x
state -> (a -> x -> x) -> x -> vector a -> x
forall (v :: * -> *) a b.
Vector v a =>
(a -> b -> b) -> b -> v a -> b
GenericVector.foldr a -> x -> x
step x
state vector a
vector

-- | Elements of a vector coming paired with indices
{-# INLINE vectorWithIndices #-}
vectorWithIndices :: (GenericVector.Vector vector a) => vector a -> Unfoldr (Int, a)
vectorWithIndices :: forall (vector :: * -> *) a.
Vector vector a =>
vector a -> Unfoldr (Int, a)
vectorWithIndices vector a
vector = (forall x. ((Int, a) -> x -> x) -> x -> x) -> Unfoldr (Int, a)
forall a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr ((forall x. ((Int, a) -> x -> x) -> x -> x) -> Unfoldr (Int, a))
-> (forall x. ((Int, a) -> x -> x) -> x -> x) -> Unfoldr (Int, a)
forall a b. (a -> b) -> a -> b
$ \(Int, a) -> x -> x
step x
state -> (Int -> a -> x -> x) -> x -> vector a -> x
forall (v :: * -> *) a b.
Vector v a =>
(Int -> a -> b -> b) -> b -> v a -> b
GenericVector.ifoldr (\Int
index a
a -> (Int, a) -> x -> x
step (Int
index, a
a)) x
state vector a
vector

-- |
-- Binary digits of a non-negative integral number.
binaryDigits :: (Integral a) => a -> Unfoldr a
binaryDigits :: forall a. Integral a => a -> Unfoldr a
binaryDigits = Unfoldr a -> Unfoldr a
forall a. Unfoldr a -> Unfoldr a
reverse (Unfoldr a -> Unfoldr a) -> (a -> Unfoldr a) -> a -> Unfoldr a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> Unfoldr a
forall a. Integral a => a -> Unfoldr a
reverseBinaryDigits

-- |
-- Binary digits of a non-negative integral number in reverse order.
reverseBinaryDigits :: (Integral a) => a -> Unfoldr a
reverseBinaryDigits :: forall a. Integral a => a -> Unfoldr a
reverseBinaryDigits = a -> a -> Unfoldr a
forall a. Integral a => a -> a -> Unfoldr a
reverseDigits a
2

-- |
-- Octal digits of a non-negative integral number.
octalDigits :: (Integral a) => a -> Unfoldr a
octalDigits :: forall a. Integral a => a -> Unfoldr a
octalDigits = Unfoldr a -> Unfoldr a
forall a. Unfoldr a -> Unfoldr a
reverse (Unfoldr a -> Unfoldr a) -> (a -> Unfoldr a) -> a -> Unfoldr a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> Unfoldr a
forall a. Integral a => a -> Unfoldr a
reverseOctalDigits

-- |
-- Octal digits of a non-negative integral number in reverse order.
reverseOctalDigits :: (Integral a) => a -> Unfoldr a
reverseOctalDigits :: forall a. Integral a => a -> Unfoldr a
reverseOctalDigits = a -> a -> Unfoldr a
forall a. Integral a => a -> a -> Unfoldr a
reverseDigits a
8

-- |
-- Decimal digits of a non-negative integral number.
decimalDigits :: (Integral a) => a -> Unfoldr a
decimalDigits :: forall a. Integral a => a -> Unfoldr a
decimalDigits = Unfoldr a -> Unfoldr a
forall a. Unfoldr a -> Unfoldr a
reverse (Unfoldr a -> Unfoldr a) -> (a -> Unfoldr a) -> a -> Unfoldr a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> Unfoldr a
forall a. Integral a => a -> Unfoldr a
reverseDecimalDigits

-- |
-- Decimal digits of a non-negative integral number in reverse order.
-- More efficient than 'decimalDigits'.
reverseDecimalDigits :: (Integral a) => a -> Unfoldr a
reverseDecimalDigits :: forall a. Integral a => a -> Unfoldr a
reverseDecimalDigits = a -> a -> Unfoldr a
forall a. Integral a => a -> a -> Unfoldr a
reverseDigits a
10

-- |
-- Hexadecimal digits of a non-negative number.
hexadecimalDigits :: (Integral a) => a -> Unfoldr a
hexadecimalDigits :: forall a. Integral a => a -> Unfoldr a
hexadecimalDigits = Unfoldr a -> Unfoldr a
forall a. Unfoldr a -> Unfoldr a
reverse (Unfoldr a -> Unfoldr a) -> (a -> Unfoldr a) -> a -> Unfoldr a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> Unfoldr a
forall a. Integral a => a -> Unfoldr a
reverseHexadecimalDigits

-- |
-- Hexadecimal digits of a non-negative number in reverse order.
reverseHexadecimalDigits :: (Integral a) => a -> Unfoldr a
reverseHexadecimalDigits :: forall a. Integral a => a -> Unfoldr a
reverseHexadecimalDigits = a -> a -> Unfoldr a
forall a. Integral a => a -> a -> Unfoldr a
reverseDigits a
16

-- |
-- Digits of a non-negative number in numeral system based on the specified radix.
-- The digits come in reverse order.
--
-- E.g., here's how an unfold of binary digits in proper order looks:
--
-- @
-- binaryDigits :: Integral a => a -> Unfoldr a
-- binaryDigits = 'reverse' . 'reverseDigits' 2
-- @
reverseDigits ::
  (Integral a) =>
  -- | Radix
  a ->
  -- | Number
  a ->
  Unfoldr a
reverseDigits :: forall a. Integral a => a -> a -> Unfoldr a
reverseDigits a
radix a
x = (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
forall a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr ((forall x. (a -> x -> x) -> x -> x) -> Unfoldr a)
-> (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
forall a b. (a -> b) -> a -> b
$ \a -> x -> x
step x
init ->
  let loop :: a -> x
loop a
x = case a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
divMod a
x a
radix of
        (a
next, a
digit) -> a -> x -> x
step a
digit (if a
next a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
0 then x
init else a -> x
loop a
next)
   in a -> x
loop a
x

-- |
-- Reverse the order.
--
-- Use with care, because it requires to allocate all elements.
reverse :: Unfoldr a -> Unfoldr a
reverse :: forall a. Unfoldr a -> Unfoldr a
reverse (Unfoldr forall x. (a -> x -> x) -> x -> x
unfoldr) = (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
forall a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr ((forall x. (a -> x -> x) -> x -> x) -> Unfoldr a)
-> (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
forall a b. (a -> b) -> a -> b
$ \a -> x -> x
step -> (a -> (x -> x) -> x -> x) -> (x -> x) -> x -> x
forall x. (a -> x -> x) -> x -> x
unfoldr (\a
a x -> x
f -> x -> x
f (x -> x) -> (x -> x) -> x -> x
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> x -> x
step a
a) x -> x
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id

zipWith :: (a -> b -> c) -> Unfoldr a -> Unfoldr b -> Unfoldr c
zipWith :: forall a b c. (a -> b -> c) -> Unfoldr a -> Unfoldr b -> Unfoldr c
zipWith a -> b -> c
f Unfoldr a
l Unfoldr b
r =
  (a -> b -> c) -> [a] -> [b] -> [c]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
Prelude.zipWith a -> b -> c
f (Unfoldr a -> [Item (Unfoldr a)]
forall l. IsList l => l -> [Item l]
toList Unfoldr a
l) (Unfoldr b -> [Item (Unfoldr b)]
forall l. IsList l => l -> [Item l]
toList Unfoldr b
r) [c] -> ([c] -> Unfoldr c) -> Unfoldr c
forall a b. a -> (a -> b) -> b
& [c] -> Unfoldr c
forall (foldable :: * -> *) a.
Foldable foldable =>
foldable a -> Unfoldr a
foldable

-- |
-- Lift into an unfold, which produces pairs with index.
zipWithIndex :: Unfoldr a -> Unfoldr (Int, a)
zipWithIndex :: forall a. Unfoldr a -> Unfoldr (Int, a)
zipWithIndex (Unfoldr forall x. (a -> x -> x) -> x -> x
unfoldr) = (forall x. ((Int, a) -> x -> x) -> x -> x) -> Unfoldr (Int, a)
forall a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr ((forall x. ((Int, a) -> x -> x) -> x -> x) -> Unfoldr (Int, a))
-> (forall x. ((Int, a) -> x -> x) -> x -> x) -> Unfoldr (Int, a)
forall a b. (a -> b) -> a -> b
$ \(Int, a) -> x -> x
indexedStep x
indexedState ->
  (a -> (Int -> x) -> Int -> x) -> (Int -> x) -> Int -> x
forall x. (a -> x -> x) -> x -> x
unfoldr
    (\a
a Int -> x
nextStateByIndex Int
index -> (Int, a) -> x -> x
indexedStep (Int
index, a
a) (Int -> x
nextStateByIndex (Int -> Int
forall a. Enum a => a -> a
succ Int
index)))
    (x -> Int -> x
forall a b. a -> b -> a
const x
indexedState)
    Int
0

-- |
-- Lift into an unfold, which produces pairs with right-associative index.
{-# DEPRECATED zipWithReverseIndex "This function builds up stack. Use 'zipWithIndex' instead." #-}
zipWithReverseIndex :: Unfoldr a -> Unfoldr (Int, a)
zipWithReverseIndex :: forall a. Unfoldr a -> Unfoldr (Int, a)
zipWithReverseIndex (Unfoldr forall x. (a -> x -> x) -> x -> x
unfoldr) = (forall x. ((Int, a) -> x -> x) -> x -> x) -> Unfoldr (Int, a)
forall a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr ((forall x. ((Int, a) -> x -> x) -> x -> x) -> Unfoldr (Int, a))
-> (forall x. ((Int, a) -> x -> x) -> x -> x) -> Unfoldr (Int, a)
forall a b. (a -> b) -> a -> b
$ \(Int, a) -> x -> x
step x
init ->
  (Int, x) -> x
forall a b. (a, b) -> b
snd
    ((Int, x) -> x) -> (Int, x) -> x
forall a b. (a -> b) -> a -> b
$ (a -> (Int, x) -> (Int, x)) -> (Int, x) -> (Int, x)
forall x. (a -> x -> x) -> x -> x
unfoldr
      (\a
a (Int
index, x
state) -> (Int -> Int
forall a. Enum a => a -> a
succ Int
index, (Int, a) -> x -> x
step (Int
index, a
a) x
state))
      (Int
0, x
init)

-- |
-- Indices of set bits.
setBitIndices :: (FiniteBits a) => a -> Unfoldr Int
setBitIndices :: forall a. FiniteBits a => a -> Unfoldr Int
setBitIndices a
a =
  let !size :: Int
size = a -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize a
a
   in (forall x. (Int -> x -> x) -> x -> x) -> Unfoldr Int
forall a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr ((forall x. (Int -> x -> x) -> x -> x) -> Unfoldr Int)
-> (forall x. (Int -> x -> x) -> x -> x) -> Unfoldr Int
forall a b. (a -> b) -> a -> b
$ \Int -> x -> x
step x
state ->
        let loop :: Int -> x
loop !Int
index =
              if Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
size
                then
                  if a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit a
a Int
index
                    then Int -> x -> x
step Int
index (Int -> x
loop (Int -> Int
forall a. Enum a => a -> a
succ Int
index))
                    else Int -> x
loop (Int -> Int
forall a. Enum a => a -> a
succ Int
index)
                else x
state
         in Int -> x
loop Int
0

-- |
-- Indices of unset bits.
unsetBitIndices :: (FiniteBits a) => a -> Unfoldr Int
unsetBitIndices :: forall a. FiniteBits a => a -> Unfoldr Int
unsetBitIndices a
a =
  let !size :: Int
size = a -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize a
a
   in (forall x. (Int -> x -> x) -> x -> x) -> Unfoldr Int
forall a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr ((forall x. (Int -> x -> x) -> x -> x) -> Unfoldr Int)
-> (forall x. (Int -> x -> x) -> x -> x) -> Unfoldr Int
forall a b. (a -> b) -> a -> b
$ \Int -> x -> x
step x
state ->
        let loop :: Int -> x
loop !Int
index =
              if Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
size
                then
                  if a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit a
a Int
index
                    then Int -> x
loop (Int -> Int
forall a. Enum a => a -> a
succ Int
index)
                    else Int -> x -> x
step Int
index (Int -> x
loop (Int -> Int
forall a. Enum a => a -> a
succ Int
index))
                else x
state
         in Int -> x
loop Int
0

take :: Int -> Unfoldr a -> Unfoldr a
take :: forall a. Int -> Unfoldr a -> Unfoldr a
take Int
amount (Unfoldr forall x. (a -> x -> x) -> x -> x
unfoldr) = (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
forall a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr ((forall x. (a -> x -> x) -> x -> x) -> Unfoldr a)
-> (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
forall a b. (a -> b) -> a -> b
$ \a -> x -> x
step x
init ->
  (a -> (Int -> x) -> Int -> x) -> (Int -> x) -> Int -> x
forall x. (a -> x -> x) -> x -> x
unfoldr
    ( \a
a Int -> x
nextState Int
index ->
        if Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
amount
          then a -> x -> x
step a
a (Int -> x
nextState (Int -> Int
forall a. Enum a => a -> a
succ Int
index))
          else x
init
    )
    (x -> Int -> x
forall a b. a -> b -> a
const x
init)
    Int
0

takeWhile :: (a -> Bool) -> Unfoldr a -> Unfoldr a
takeWhile :: forall a. (a -> Bool) -> Unfoldr a -> Unfoldr a
takeWhile a -> Bool
predicate (Unfoldr forall x. (a -> x -> x) -> x -> x
unfoldr) = (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
forall a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr ((forall x. (a -> x -> x) -> x -> x) -> Unfoldr a)
-> (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
forall a b. (a -> b) -> a -> b
$ \a -> x -> x
step x
init ->
  (a -> x -> x) -> x -> x
forall x. (a -> x -> x) -> x -> x
unfoldr
    ( \a
a x
nextState ->
        if a -> Bool
predicate a
a
          then a -> x -> x
step a
a x
nextState
          else x
init
    )
    x
init

cons :: a -> Unfoldr a -> Unfoldr a
cons :: forall a. a -> Unfoldr a -> Unfoldr a
cons a
a (Unfoldr forall x. (a -> x -> x) -> x -> x
unfoldr) = (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
forall a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr ((forall x. (a -> x -> x) -> x -> x) -> Unfoldr a)
-> (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
forall a b. (a -> b) -> a -> b
$ \a -> x -> x
step x
init -> a -> x -> x
step a
a ((a -> x -> x) -> x -> x
forall x. (a -> x -> x) -> x -> x
unfoldr a -> x -> x
step x
init)

snoc :: a -> Unfoldr a -> Unfoldr a
snoc :: forall a. a -> Unfoldr a -> Unfoldr a
snoc a
a (Unfoldr forall x. (a -> x -> x) -> x -> x
unfoldr) = (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
forall a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr ((forall x. (a -> x -> x) -> x -> x) -> Unfoldr a)
-> (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
forall a b. (a -> b) -> a -> b
$ \a -> x -> x
step x
init -> (a -> x -> x) -> x -> x
forall x. (a -> x -> x) -> x -> x
unfoldr a -> x -> x
step (a -> x -> x
step a
a x
init)

-- |
-- Insert a separator value between each element.
--
-- Behaves the same way as 'Data.List.intersperse'.
{-# INLINE intersperse #-}
intersperse :: a -> Unfoldr a -> Unfoldr a
intersperse :: forall a. a -> Unfoldr a -> Unfoldr a
intersperse a
sep (Unfoldr forall x. (a -> x -> x) -> x -> x
unfoldr) =
  (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
forall a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr ((forall x. (a -> x -> x) -> x -> x) -> Unfoldr a)
-> (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
forall a b. (a -> b) -> a -> b
$ \a -> x -> x
step x
init ->
    (a -> (Bool -> x) -> Bool -> x) -> (Bool -> x) -> Bool -> x
forall x. (a -> x -> x) -> x -> x
unfoldr
      ( \a
a Bool -> x
next Bool
first ->
          if Bool
first
            then a -> x -> x
step a
a (Bool -> x
next Bool
False)
            else a -> x -> x
step a
sep (a -> x -> x
step a
a (Bool -> x
next Bool
False))
      )
      (x -> Bool -> x
forall a b. a -> b -> a
const x
init)
      Bool
True

-- |
-- Reproduces the behaviour of 'Data.Text.unpack'.
--
-- Implementation is efficient and avoids allocation of an intermediate list.
textChars :: Text -> Unfoldr Char
textChars :: Text -> Unfoldr Char
textChars (TextInternal.Text Array
arr Int
off Int
len) =
  (forall x. (Char -> x -> x) -> x -> x) -> Unfoldr Char
forall a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr ((forall x. (Char -> x -> x) -> x -> x) -> Unfoldr Char)
-> (forall x. (Char -> x -> x) -> x -> x) -> Unfoldr Char
forall a b. (a -> b) -> a -> b
$ \Char -> x -> x
step x
term ->
    let loop :: Int -> x
loop !Int
offset =
          if Int
offset Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len
            then x
term
            else Array -> Int -> (Char -> Int -> x) -> x
forall a. Array -> Int -> (Char -> Int -> a) -> a
TextArrayUtil.iter Array
arr Int
offset ((Char -> Int -> x) -> x) -> (Char -> Int -> x) -> x
forall a b. (a -> b) -> a -> b
$ \Char
char Int
nextOffset ->
              Char -> x -> x
step Char
char (Int -> x
loop Int
nextOffset)
     in Int -> x
loop Int
off

-- |
-- Reproduces the behaviour of 'Data.Text.words'.
--
-- Implementation is efficient and avoids allocation of an intermediate list.
textWords :: Text -> Unfoldr Text
textWords :: Text -> Unfoldr Text
textWords (TextInternal.Text Array
arr Int
off Int
len) =
  (forall x. (Text -> x -> x) -> x -> x) -> Unfoldr Text
forall a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr ((forall x. (Text -> x -> x) -> x -> x) -> Unfoldr Text)
-> (forall x. (Text -> x -> x) -> x -> x) -> Unfoldr Text
forall a b. (a -> b) -> a -> b
$ \Text -> x -> x
step x
term ->
    let loop :: Int -> Int -> x
loop !Int
wordOffset !Int
offset =
          if Int
offset Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len
            then
              if Int
wordOffset Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
offset
                then x
term
                else Text -> x -> x
step (Int -> Int -> Text
chunk Int
wordOffset Int
offset) x
term
            else Array -> Int -> (Char -> Int -> x) -> x
forall a. Array -> Int -> (Char -> Int -> a) -> a
TextArrayUtil.iter Array
arr Int
offset ((Char -> Int -> x) -> x) -> (Char -> Int -> x) -> x
forall a b. (a -> b) -> a -> b
$ \Char
char Int
nextOffset ->
              if Char -> Bool
isSpace Char
char
                then
                  if Int
wordOffset Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
offset
                    then Int -> Int -> x
loop Int
nextOffset Int
nextOffset
                    else Text -> x -> x
step (Int -> Int -> Text
chunk Int
wordOffset Int
offset) (Int -> Int -> x
loop Int
nextOffset Int
nextOffset)
                else Int -> Int -> x
loop Int
wordOffset Int
nextOffset
     in Int -> Int -> x
loop Int
off Int
off
  where
    chunk :: Int -> Int -> Text
chunk Int
startOffset Int
afterEndOffset =
      Array -> Int -> Int -> Text
TextInternal.Text Array
arr Int
startOffset (Int
afterEndOffset Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
startOffset)

-- |
-- Transformer of chars,
-- replaces all space-like chars with space,
-- all newline-like chars with @\\n@,
-- and trims their duplicate sequences to single-char.
-- Oh yeah, it also trims whitespace from beginning and end.
trimWhitespace :: Unfoldr Char -> Unfoldr Char
trimWhitespace :: Unfoldr Char -> Unfoldr Char
trimWhitespace =
  \Unfoldr Char
foldable ->
    (forall x. (Char -> x -> x) -> x -> x) -> Unfoldr Char
forall a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr ((forall x. (Char -> x -> x) -> x -> x) -> Unfoldr Char)
-> (forall x. (Char -> x -> x) -> x -> x) -> Unfoldr Char
forall a b. (a -> b) -> a -> b
$ \Char -> x -> x
substep x
subterm ->
      (Char -> (Bool -> Bool -> Bool -> x) -> Bool -> Bool -> Bool -> x)
-> (Bool -> Bool -> Bool -> x)
-> Unfoldr Char
-> Bool
-> Bool
-> Bool
-> x
forall a b. (a -> b -> b) -> b -> Unfoldr a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((Char -> x -> x)
-> Char -> (Bool -> Bool -> Bool -> x) -> Bool -> Bool -> Bool -> x
forall {a}.
(Char -> a -> a)
-> Char -> (Bool -> Bool -> Bool -> a) -> Bool -> Bool -> Bool -> a
step Char -> x -> x
substep) (x -> Bool -> Bool -> Bool -> x
forall {p} {p} {p} {p}. p -> p -> p -> p -> p
finalize x
subterm) Unfoldr Char
foldable Bool
False Bool
False Bool
False
  where
    step :: (Char -> a -> a)
-> Char -> (Bool -> Bool -> Bool -> a) -> Bool -> Bool -> Bool -> a
step Char -> a -> a
substep Char
char Bool -> Bool -> Bool -> a
next Bool
notFirst Bool
spacePending Bool
newlinePending =
      if Char -> Bool
isSpace Char
char
        then
          if Char
char Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' Bool -> Bool -> Bool
|| Char
char Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\r'
            then Bool -> Bool -> Bool -> a
next Bool
notFirst Bool
False Bool
True
            else Bool -> Bool -> Bool -> a
next Bool
notFirst Bool
True Bool
newlinePending
        else
          let mapper :: a -> a
mapper =
                if Bool
notFirst
                  then
                    if Bool
newlinePending
                      then Char -> a -> a
substep Char
'\n'
                      else
                        if Bool
spacePending
                          then Char -> a -> a
substep Char
' '
                          else a -> a
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
                  else a -> a
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
           in a -> a
mapper (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ Char -> a -> a
substep Char
char (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Bool -> a
next Bool
True Bool
False Bool
False
    finalize :: p -> p -> p -> p -> p
finalize p
subterm p
notFirst p
spacePending p
newlinePending =
      p
subterm