{-# 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 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
(<*>) = 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 a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr (forall a b. a -> b -> a
const 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 a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr (\a -> x -> x
step x
init -> forall x. (a -> x -> x) -> x -> x
left a -> x -> x
step (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 = 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 a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr forall a b. (a -> b) -> a -> b
$ \b -> x -> x
step -> forall x. (a -> x -> x) -> x -> x
left 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 -> forall x. (b -> x -> x) -> x -> x
right b -> x -> x
step

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

instance Semigroup (Unfoldr a) where
  <> :: 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 = forall (f :: * -> *) a. Alternative f => f a
empty
  mappend :: Unfoldr a -> Unfoldr a -> Unfoldr a
mappend = 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) = forall x. (a -> x -> x) -> x -> x
unfoldr (forall a. Monoid a => a -> a -> a
mappend 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) 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) = 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 = 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) = forall x. (a -> x -> x) -> x -> x
unfoldr a -> (b -> b) -> b -> b
rightStep 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 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) =
    forall x. (a -> x -> x) -> x -> x
unfoldr (\a
a f (Unfoldr b)
next -> forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. a -> Unfoldr a -> Unfoldr a
cons (a -> f b
f a
a) f (Unfoldr b)
next) (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty)

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

instance (Show a) => Show (Unfoldr a) where
  show :: Unfoldr a -> String
show = forall a. Show a => a -> String
show forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 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 = forall (foldable :: * -> *) a.
Foldable foldable =>
foldable a -> Unfoldr a
foldable [Item (Unfoldr a)]
list
  toList :: Unfoldr a -> [Item (Unfoldr a)]
toList = 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) =
  forall x. (input -> x -> x) -> x -> x
run (\input
input x -> output
next x
state -> x -> output
next 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= x -> m x
next) forall (m :: * -> *) a. Monad m => a -> m a
return 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 a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr (\elem -> x -> x
step x
init -> 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 elem container.
(forall x. (elem -> x -> x) -> x -> container -> x)
-> container -> Unfoldr elem
foldrAndContainer 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 elem container.
(forall x. (elem -> x -> x) -> x -> container -> x)
-> container -> Unfoldr elem
foldrAndContainer forall b. (Int -> b -> b) -> b -> IntSet -> b
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 a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr (\a -> x -> x
step -> 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 a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr 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 (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 a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr forall a b. (a -> b) -> a -> b
$ \a -> x -> x
step x
init ->
    let loop :: a -> x
loop a
int =
          if a
int forall a. Ord a => a -> a -> Bool
<= a
to
            then a -> x -> x
step a
int (a -> x
loop (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 = 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 = 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 a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr (\(key, value) -> x -> x
step x
init -> 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 a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr (\(Int, value) -> x -> x
step x
init -> 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 a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr (\key -> x -> x
step x
init -> 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 a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr (\(key, value) -> x -> x
step x
init -> 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 = forall (foldable :: * -> *) a.
Foldable foldable =>
foldable a -> Unfoldr a
foldable (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 = forall (foldable :: * -> *) a.
Foldable foldable =>
foldable a -> Unfoldr a
foldable forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b c. (a -> b -> c) -> b -> a -> c
flip 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 a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr (\Word8 -> x -> x
step x
init -> 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#) = forall prim. Prim prim => PrimArray prim -> Unfoldr prim
primArray (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 a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr forall a b. (a -> b) -> a -> b
$ \prim -> x -> x
f x
z -> 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 a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr forall a b. (a -> b) -> a -> b
$ \(Int, prim) -> x -> x
step x
state ->
  let !size :: Int
size = forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray prim
pa
      loop :: Int -> x
loop Int
index =
        if Int
index forall a. Ord a => a -> a -> Bool
< Int
size
          then (Int, prim) -> x -> x
step (Int
index, forall a. Prim a => PrimArray a -> Int -> a
indexPrimArray PrimArray prim
pa Int
index) (Int -> x
loop (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 a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr forall a b. (a -> b) -> a -> b
$ \a -> x -> x
step x
state -> 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 a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr forall a b. (a -> b) -> a -> b
$ \(Int, a) -> x -> x
step x
state -> 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 = forall a. Unfoldr a -> Unfoldr a
reverse forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 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 = 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 = forall a. Unfoldr a -> Unfoldr a
reverse forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 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 = 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 = forall a. Unfoldr a -> Unfoldr a
reverse forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 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 = 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 = forall a. Unfoldr a -> Unfoldr a
reverse forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 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 = 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 a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr forall a b. (a -> b) -> a -> b
$ \a -> x -> x
step x
init ->
  let loop :: a -> x
loop a
x = case 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 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 a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr forall a b. (a -> b) -> a -> b
$ \a -> x -> x
step -> forall x. (a -> x -> x) -> x -> x
unfoldr (\a
a x -> x
f -> x -> x
f 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) 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 =
  forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
Prelude.zipWith a -> b -> c
f (forall l. IsList l => l -> [Item l]
toList Unfoldr a
l) (forall l. IsList l => l -> [Item l]
toList Unfoldr b
r) forall a b. a -> (a -> b) -> b
& 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 a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr forall a b. (a -> b) -> a -> b
$ \(Int, a) -> x -> x
indexedStep x
indexedState ->
  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 (forall a. Enum a => a -> a
succ Int
index)))
    (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 a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr forall a b. (a -> b) -> a -> b
$ \(Int, a) -> x -> x
step x
init ->
  forall a b. (a, b) -> b
snd
    forall a b. (a -> b) -> a -> b
$ forall x. (a -> x -> x) -> x -> x
unfoldr
      (\a
a (Int
index, x
state) -> (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 = forall b. FiniteBits b => b -> Int
finiteBitSize a
a
   in forall a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr forall a b. (a -> b) -> a -> b
$ \Int -> x -> x
step x
state ->
        let loop :: Int -> x
loop !Int
index =
              if Int
index forall a. Ord a => a -> a -> Bool
< Int
size
                then
                  if forall a. Bits a => a -> Int -> Bool
testBit a
a Int
index
                    then Int -> x -> x
step Int
index (Int -> x
loop (forall a. Enum a => a -> a
succ Int
index))
                    else Int -> x
loop (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 = forall b. FiniteBits b => b -> Int
finiteBitSize a
a
   in forall a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr forall a b. (a -> b) -> a -> b
$ \Int -> x -> x
step x
state ->
        let loop :: Int -> x
loop !Int
index =
              if Int
index forall a. Ord a => a -> a -> Bool
< Int
size
                then
                  if forall a. Bits a => a -> Int -> Bool
testBit a
a Int
index
                    then Int -> x
loop (forall a. Enum a => a -> a
succ Int
index)
                    else Int -> x -> x
step Int
index (Int -> x
loop (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 a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr forall a b. (a -> b) -> a -> b
$ \a -> x -> x
step x
init ->
  forall x. (a -> x -> x) -> x -> x
unfoldr
    ( \a
a Int -> x
nextState Int
index ->
        if Int
index forall a. Ord a => a -> a -> Bool
< Int
amount
          then a -> x -> x
step a
a (Int -> x
nextState (forall a. Enum a => a -> a
succ Int
index))
          else x
init
    )
    (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 a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr forall a b. (a -> b) -> a -> b
$ \a -> x -> x
step x
init ->
  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 a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr forall a b. (a -> b) -> a -> b
$ \a -> x -> x
step x
init -> a -> x -> x
step a
a (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 a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr forall a b. (a -> b) -> a -> b
$ \a -> x -> x
step x
init -> 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 a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr forall a b. (a -> b) -> a -> b
$ \a -> x -> x
step x
init ->
    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))
      )
      (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 a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr forall a b. (a -> b) -> a -> b
$ \Char -> x -> x
step x
term ->
    let loop :: Int -> x
loop !Int
offset =
          if Int
offset forall a. Ord a => a -> a -> Bool
>= Int
len
            then x
term
            else forall a. Array -> Int -> (Char -> Int -> a) -> a
TextArrayUtil.iter Array
arr Int
offset 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 a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr 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 forall a. Ord a => a -> a -> Bool
>= Int
len
            then
              if Int
wordOffset 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 forall a. Array -> Int -> (Char -> Int -> a) -> a
TextArrayUtil.iter Array
arr Int
offset forall a b. (a -> b) -> a -> b
$ \Char
char Int
nextOffset ->
              if Char -> Bool
isSpace Char
char
                then
                  if Int
wordOffset 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 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 a. (forall x. (a -> x -> x) -> x -> x) -> Unfoldr a
Unfoldr forall a b. (a -> b) -> a -> b
$ \Char -> x -> x
substep x
subterm ->
      forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall {a}.
(Char -> a -> a)
-> Char -> (Bool -> Bool -> Bool -> a) -> Bool -> Bool -> Bool -> a
step Char -> x -> x
substep) (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 forall a. Eq a => a -> a -> Bool
== Char
'\n' Bool -> Bool -> Bool
|| Char
char 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 forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
                  else forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
           in a -> a
mapper forall a b. (a -> b) -> a -> b
$ Char -> a -> a
substep Char
char 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