module DeferredFolds.Defs.Unfoldr
where

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


deriving instance Functor Unfoldr

instance Applicative Unfoldr where
  pure :: 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)
  <*> :: 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 :: 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 k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id)
  {-# INLINE (<|>) #-}
  <|> :: 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 :: a -> Unfoldr a
return = a -> Unfoldr a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  {-# INLINE (>>=) #-}
  >>= :: 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 :: Unfoldr a
mzero = Unfoldr a
forall (f :: * -> *) a. Alternative f => f a
empty
  mplus :: Unfoldr a -> Unfoldr a -> Unfoldr a
mplus = 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 (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)

instance Monoid (Unfoldr a) where
  mempty :: Unfoldr a
mempty = 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 :: (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 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 :: (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 :: (b -> a -> b) -> b -> Unfoldr a -> b
foldl = (b -> a -> b) -> b -> Unfoldr a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
  {-# INLINE foldl' #-}
  foldl' :: (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 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 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 = [a] -> String
forall a. Show a => a -> String
show ([a] -> String) -> (Unfoldr a -> [a]) -> Unfoldr a -> String
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Unfoldr a -> [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 (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 :: Fold input output -> Unfoldr input -> output
fold (Fold x -> input -> x
step x
init x -> output
extract) = x -> output
extract (x -> output) -> (Unfoldr input -> x) -> Unfoldr input -> output
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (x -> input -> x) -> x -> Unfoldr input -> x
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' x -> input -> x
step x
init

{-| Apply a monadic Gonzalez fold -}
{-# INLINE foldM #-}
foldM :: Monad m => FoldM m input output -> Unfoldr input -> m output
foldM :: 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 (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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= x -> m x
next) x -> m x
forall (m :: * -> *) a. Monad m => a -> m a
return m x -> (x -> m output) -> m output
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= x -> m output
extract

{-| Construct from any foldable -}
{-# INLINE foldable #-}
foldable :: Foldable foldable => foldable a -> Unfoldr a
foldable :: foldable a -> Unfoldr a
foldable foldable a
foldable = (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 -> foldable a -> x
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> x -> x
step x
init foldable a
foldable)

{-| Filter the values given a predicate -}
{-# INLINE filter #-}
filter :: (a -> Bool) -> Unfoldr a -> Unfoldr a
filter :: (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 :: 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 :: 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 :: 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 :: 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 :: 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 :: 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 :: 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 :: 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 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 :: 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 (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 :: 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 :: 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 :: 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 :: 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 :: 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 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 :: 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 :: 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 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 :: 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 :: 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 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 :: 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 :: 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 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 :: 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 => a {-^ Radix -} -> a {-^ Number -} -> Unfoldr a
reverseDigits :: 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 :: 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 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 k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id

{-|
Lift into an unfold, which produces pairs with index.
-}
zipWithIndex :: Unfoldr a -> Unfoldr (Int, a)
zipWithIndex :: 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 :: 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 :: 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 :: 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 :: 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 :: (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 :: 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 :: 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 :: 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