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

module DeferredFolds.Defs.Unfoldl where

import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Short.Internal as ShortByteString
import qualified Data.IntMap.Strict as D
import qualified Data.Map.Strict as C
import DeferredFolds.Prelude hiding (fold)
import qualified DeferredFolds.Prelude as A
import DeferredFolds.Types

deriving instance Functor Unfoldl

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

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

instance Monad Unfoldl where
  return :: forall a. a -> Unfoldl a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
  >>= :: forall a b. Unfoldl a -> (a -> Unfoldl b) -> Unfoldl b
(>>=) (Unfoldl forall x. (x -> a -> x) -> x -> x
left) a -> Unfoldl b
rightK =
    forall a. (forall x. (x -> a -> x) -> x -> x) -> Unfoldl a
Unfoldl forall a b. (a -> b) -> a -> b
$ \x -> b -> x
step x
init ->
      let newStep :: x -> a -> x
newStep x
output a
x =
            case a -> Unfoldl b
rightK a
x of
              Unfoldl forall x. (x -> b -> x) -> x -> x
right ->
                forall x. (x -> b -> x) -> x -> x
right x -> b -> x
step x
output
       in forall x. (x -> a -> x) -> x -> x
left x -> a -> x
newStep x
init

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

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

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

instance Foldable Unfoldl where
  {-# INLINE foldMap #-}
  foldMap :: forall m a. Monoid m => (a -> m) -> Unfoldl a -> m
foldMap a -> m
inputMonoid = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' m -> a -> m
step forall a. Monoid a => a
mempty
    where
      step :: m -> a -> m
step m
monoid a
input = forall a. Monoid a => a -> a -> a
mappend m
monoid (a -> m
inputMonoid a
input)
  foldl :: forall b a. (b -> a -> b) -> b -> Unfoldl 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 -> Unfoldl a -> b
foldl' b -> a -> b
step b
init (Unfoldl forall x. (x -> a -> x) -> x -> x
run) = forall x. (x -> a -> x) -> x -> x
run b -> a -> b
step b
init

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

instance (Show a) => Show (Unfoldl a) where
  show :: Unfoldl 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 (Unfoldl a) where
  type Item (Unfoldl a) = a
  fromList :: [Item (Unfoldl a)] -> Unfoldl a
fromList [Item (Unfoldl a)]
list = forall (foldable :: * -> *) a.
Foldable foldable =>
foldable a -> Unfoldl a
foldable [Item (Unfoldl a)]
list
  toList :: Unfoldl a -> [Item (Unfoldl 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 -> Unfoldl input -> output
fold :: forall input output. Fold input output -> Unfoldl input -> output
fold (Fold x -> input -> x
step x
init x -> output
extract) (Unfoldl forall x. (x -> input -> x) -> x -> x
run) = x -> output
extract (forall x. (x -> input -> x) -> x -> x
run x -> input -> x
step x
init)

-- | Unlift a monadic unfold
{-# INLINE unfoldlM #-}
unfoldlM :: UnfoldlM Identity input -> Unfoldl input
unfoldlM :: forall input. UnfoldlM Identity input -> Unfoldl input
unfoldlM (UnfoldlM forall x. (x -> input -> Identity x) -> x -> Identity x
runFoldM) = forall a. (forall x. (x -> a -> x) -> x -> x) -> Unfoldl a
Unfoldl (\x -> input -> x
step x
init -> forall a. Identity a -> a
runIdentity (forall x. (x -> input -> Identity x) -> x -> Identity x
runFoldM (\x
a input
b -> forall (m :: * -> *) a. Monad m => a -> m a
return (x -> input -> x
step x
a input
b)) x
init))

-- | Lift a fold input mapping function into a mapping of unfolds
{-# INLINE mapFoldInput #-}
mapFoldInput :: (forall x. Fold b x -> Fold a x) -> Unfoldl a -> Unfoldl b
mapFoldInput :: forall b a.
(forall x. Fold b x -> Fold a x) -> Unfoldl a -> Unfoldl b
mapFoldInput forall x. Fold b x -> Fold a x
newFold Unfoldl a
unfold = forall a. (forall x. (x -> a -> x) -> x -> x) -> Unfoldl a
Unfoldl forall a b. (a -> b) -> a -> b
$ \x -> b -> x
step x
init -> forall input output. Fold input output -> Unfoldl input -> output
fold (forall x. Fold b x -> Fold a x
newFold (forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold x -> b -> x
step x
init forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id)) Unfoldl a
unfold

-- | Construct from any foldable
{-# INLINE foldable #-}
foldable :: (Foldable foldable) => foldable a -> Unfoldl a
foldable :: forall (foldable :: * -> *) a.
Foldable foldable =>
foldable a -> Unfoldl a
foldable foldable a
foldable = forall a. (forall x. (x -> a -> x) -> x -> x) -> Unfoldl a
Unfoldl (\x -> a -> x
step x
init -> forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
A.foldl' x -> a -> x
step x
init foldable a
foldable)

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

-- | Ints in the specified inclusive range
{-# INLINE intsInRange #-}
intsInRange :: Int -> Int -> Unfoldl Int
intsInRange :: Int -> Int -> Unfoldl Int
intsInRange Int
from Int
to =
  forall a. (forall x. (x -> a -> x) -> x -> x) -> Unfoldl a
Unfoldl forall a b. (a -> b) -> a -> b
$ \x -> Int -> x
step x
init ->
    let loop :: x -> Int -> x
loop !x
state Int
int =
          if Int
int forall a. Ord a => a -> a -> Bool
<= Int
to
            then x -> Int -> x
loop (x -> Int -> x
step x
state Int
int) (forall a. Enum a => a -> a
succ Int
int)
            else x
state
     in x -> Int -> x
loop x
init Int
from

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

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

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

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

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

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