module DeferredFolds.Defs.Unfoldl
where

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


deriving instance Functor Unfoldl

instance Applicative Unfoldl where
  pure :: a -> Unfoldl a
pure a
x =
    (forall x. (x -> a -> x) -> x -> x) -> Unfoldl a
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)
  <*> :: Unfoldl (a -> b) -> Unfoldl a -> Unfoldl 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 :: Unfoldl a
empty =
    (forall x. (x -> a -> x) -> x -> x) -> Unfoldl a
forall a. (forall x. (x -> a -> x) -> x -> x) -> Unfoldl a
Unfoldl ((x -> x) -> (x -> a -> 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 (<|>) #-}
  <|> :: 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 x. (x -> a -> x) -> x -> x) -> Unfoldl a
forall a. (forall x. (x -> a -> x) -> x -> x) -> Unfoldl a
Unfoldl (\ x -> a -> x
step x
init -> (x -> a -> x) -> x -> x
forall x. (x -> a -> x) -> x -> x
right x -> a -> x
step ((x -> a -> x) -> x -> x
forall x. (x -> a -> x) -> x -> x
left x -> a -> x
step x
init))

instance Monad Unfoldl where
  return :: a -> Unfoldl a
return = a -> Unfoldl a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  >>= :: Unfoldl a -> (a -> Unfoldl b) -> Unfoldl b
(>>=) (Unfoldl forall x. (x -> a -> x) -> x -> x
left) a -> Unfoldl b
rightK =
    (forall x. (x -> b -> x) -> x -> x) -> Unfoldl b
forall a. (forall x. (x -> a -> x) -> x -> x) -> Unfoldl a
Unfoldl ((forall x. (x -> b -> x) -> x -> x) -> Unfoldl b)
-> (forall x. (x -> b -> x) -> x -> x) -> Unfoldl b
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 ->
            (x -> b -> x) -> x -> x
forall x. (x -> b -> x) -> x -> x
right x -> b -> x
step x
output
      in (x -> a -> x) -> x -> x
forall x. (x -> a -> x) -> x -> x
left x -> a -> x
newStep x
init

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

instance Semigroup (Unfoldl a) where
  <> :: Unfoldl a -> Unfoldl a -> Unfoldl a
(<>) = 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 = Unfoldl a
forall (f :: * -> *) a. Alternative f => f a
empty
  mappend :: Unfoldl a -> Unfoldl a -> Unfoldl a
mappend = Unfoldl a -> Unfoldl a -> Unfoldl a
forall a. Semigroup a => a -> a -> a
(<>)

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

instance Show a => Show (Unfoldl a) where
  show :: Unfoldl a -> String
show = [a] -> String
forall a. Show a => a -> String
show ([a] -> String) -> (Unfoldl a -> [a]) -> Unfoldl a -> String
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Unfoldl a -> [a]
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 = [a] -> Unfoldl a
forall (foldable :: * -> *) a.
Foldable foldable =>
foldable a -> Unfoldl a
foldable [a]
[Item (Unfoldl a)]
list
  toList :: Unfoldl a -> [Item (Unfoldl a)]
toList = (a -> [a] -> [a]) -> [a] -> Unfoldl 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 -> Unfoldl input -> output
fold :: 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 ((x -> input -> x) -> x -> x
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 :: UnfoldlM Identity input -> Unfoldl input
unfoldlM (UnfoldlM forall x. (x -> input -> Identity x) -> x -> Identity x
runFoldM) = (forall x. (x -> input -> x) -> x -> x) -> Unfoldl input
forall a. (forall x. (x -> a -> x) -> x -> x) -> Unfoldl a
Unfoldl (\ x -> input -> x
step x
init -> Identity x -> x
forall a. Identity a -> a
runIdentity ((x -> input -> Identity x) -> x -> Identity x
forall x. (x -> input -> Identity x) -> x -> Identity x
runFoldM (\ x
a input
b -> x -> Identity x
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 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 x. (x -> b -> x) -> x -> x) -> Unfoldl b
forall a. (forall x. (x -> a -> x) -> x -> x) -> Unfoldl a
Unfoldl ((forall x. (x -> b -> x) -> x -> x) -> Unfoldl b)
-> (forall x. (x -> b -> x) -> x -> x) -> Unfoldl b
forall a b. (a -> b) -> a -> b
$ \ x -> b -> x
step x
init -> Fold a x -> Unfoldl a -> x
forall input output. Fold input output -> Unfoldl input -> output
fold (Fold b x -> Fold a x
forall x. Fold b x -> Fold a x
newFold ((x -> b -> x) -> x -> (x -> x) -> Fold b x
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold x -> b -> x
step x
init x -> x
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 :: foldable a -> Unfoldl a
foldable foldable a
foldable = (forall x. (x -> a -> x) -> x -> x) -> Unfoldl a
forall a. (forall x. (x -> a -> x) -> x -> x) -> Unfoldl a
Unfoldl (\ x -> a -> x
step x
init -> (x -> a -> x) -> x -> foldable a -> x
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 :: (a -> Bool) -> Unfoldl a -> Unfoldl a
filter a -> Bool
test (Unfoldl forall x. (x -> a -> x) -> x -> x
run) = (forall x. (x -> a -> x) -> x -> x) -> Unfoldl a
forall a. (forall x. (x -> a -> x) -> x -> x) -> Unfoldl a
Unfoldl (\ x -> a -> x
step -> (x -> a -> x) -> x -> x
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 x. (x -> Int -> x) -> x -> x) -> Unfoldl Int
forall a. (forall x. (x -> a -> x) -> x -> x) -> Unfoldl a
Unfoldl ((forall x. (x -> Int -> x) -> x -> x) -> Unfoldl Int)
-> (forall x. (x -> Int -> x) -> x -> x) -> Unfoldl Int
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
to
        then x -> Int -> x
loop (x -> Int -> x
step x
state Int
int) (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 :: Map key value -> Unfoldl (key, value)
mapAssocs Map key value
map =
  (forall x. (x -> (key, value) -> x) -> x -> x)
-> Unfoldl (key, value)
forall a. (forall x. (x -> a -> x) -> x -> x) -> Unfoldl a
Unfoldl (\ x -> (key, value) -> x
step x
init -> (x -> key -> value -> x) -> x -> Map key value -> x
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 :: IntMap value -> Unfoldl (Int, value)
intMapAssocs IntMap value
intMap =
  (forall x. (x -> (Int, value) -> x) -> x -> x)
-> Unfoldl (Int, value)
forall a. (forall x. (x -> a -> x) -> x -> x) -> Unfoldl a
Unfoldl (\ x -> (Int, value) -> x
step x
init -> (x -> Int -> value -> x) -> x -> IntMap value -> x
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 x. (x -> Word8 -> x) -> x -> x) -> Unfoldl Word8
forall a. (forall x. (x -> a -> x) -> x -> x) -> Unfoldl a
Unfoldl (\ x -> Word8 -> x
step x
init -> (x -> Word8 -> x) -> x -> ByteString -> x
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#) = PrimArray Word8 -> Unfoldl Word8
forall prim. Prim prim => PrimArray prim -> Unfoldl 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 -> Unfoldl prim
primArray :: PrimArray prim -> Unfoldl prim
primArray PrimArray prim
ba = (forall x. (x -> prim -> x) -> x -> x) -> Unfoldl prim
forall a. (forall x. (x -> a -> x) -> x -> x) -> Unfoldl a
Unfoldl ((forall x. (x -> prim -> x) -> x -> x) -> Unfoldl prim)
-> (forall x. (x -> prim -> x) -> x -> x) -> Unfoldl prim
forall a b. (a -> b) -> a -> b
$ \ x -> prim -> x
f x
z -> (x -> prim -> x) -> x -> PrimArray prim -> x
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 :: PrimArray prim -> Unfoldl (Int, prim)
primArrayWithIndices PrimArray prim
pa = (forall x. (x -> (Int, prim) -> x) -> x -> x)
-> Unfoldl (Int, prim)
forall a. (forall x. (x -> a -> x) -> x -> x) -> Unfoldl a
Unfoldl ((forall x. (x -> (Int, prim) -> x) -> x -> x)
 -> Unfoldl (Int, prim))
-> (forall x. (x -> (Int, prim) -> x) -> x -> x)
-> Unfoldl (Int, prim)
forall a b. (a -> b) -> a -> b
$ \ x -> (Int, prim) -> x
step x
state -> let
  !size :: Int
size = PrimArray prim -> Int
forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray prim
pa
  iterate :: Int -> x -> x
iterate Int
index !x
state = if Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
size
    then Int -> x -> x
iterate (Int -> Int
forall a. Enum a => a -> a
succ Int
index) (x -> (Int, prim) -> x
step x
state (Int
index, PrimArray prim -> Int -> prim
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