{-# OPTIONS_GHC -Wno-name-shadowing #-}
{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE LinearTypes #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE QualifiedDo #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | This module provides all functions that take input streams
-- but do not return output streams.
module Streaming.Internal.Consume
  ( -- * Consuming 'Stream's of elements
  -- ** IO Consumers
    stdoutLn
  , stdoutLn'
  , print
  , toHandle
  , writeFile
  -- ** Basic Pure Consumers
  , effects
  , erase
  , drained
  , mapM_
  -- ** Folds
  , fold
  , fold_
  , foldM
  , foldM_
  , all
  , all_
  , any
  , any_
  , sum
  , sum_
  , product
  , product_
  , head
  , head_
  , last
  , last_
  , elem
  , elem_
  , notElem
  , notElem_
  , length
  , length_
  , toList
  , toList_
  , mconcat
  , mconcat_
  , minimum
  , minimum_
  , maximum
  , maximum_
  , foldrM
  , foldrT
  ) where

import Streaming.Internal.Type
import Streaming.Internal.Process
import System.IO.Linear
import System.IO.Resource
import qualified Data.Bool.Linear as Linear
import Prelude.Linear ((&), ($), (.))
import Prelude (Show(..), FilePath, (&&), Bool(..), id, (||),
               Num(..), Maybe(..), Eq(..), Int, Ord(..))
import qualified Prelude as Prelude
import Data.Unrestricted.Linear
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.IO as Text
import Data.Functor.Identity
import qualified System.IO as System
import qualified Control.Functor.Linear as Control


-- #  IO Consumers
-------------------------------------------------------------------------------

-- Note: crashes on a broken output pipe
--
{-| Write 'String's to 'System.stdout' using 'Text.putStrLn'; terminates on a broken output pipe
    (The name and implementation are modelled on the @Pipes.Prelude@ @stdoutLn@).

\>\>\> withLinearIO $ Control.fmap move $ S.stdoutLn $ S.each $ words "one two three"
one
two
three
-}
stdoutLn :: Stream (Of Text) IO () %1-> IO ()
stdoutLn :: Stream (Of Text) IO () %1 -> IO ()
stdoutLn Stream (Of Text) IO ()
stream = Stream (Of Text) IO () %1 -> IO ()
forall r. Stream (Of Text) IO r %1 -> IO r
stdoutLn' Stream (Of Text) IO ()
stream
{-# INLINE stdoutLn #-}

-- | Like stdoutLn but with an arbitrary return value
stdoutLn' :: forall r. Stream (Of Text) IO r %1-> IO r
stdoutLn' :: forall r. Stream (Of Text) IO r %1 -> IO r
stdoutLn' Stream (Of Text) IO r
stream = Stream (Of Text) IO r %1 -> IO r
loop Stream (Of Text) IO r
stream where
  loop :: Stream (Of Text) IO r %1-> IO r
  loop :: Stream (Of Text) IO r %1 -> IO r
loop Stream (Of Text) IO r
stream = Stream (Of Text) IO r
stream Stream (Of Text) IO r
%1 -> (Stream (Of Text) IO r %1 -> IO r) %1 -> IO r
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
    Return r
r -> r %1 -> IO r
forall (m :: * -> *) a. Monad m => a %1 -> m a
Control.return r
r
    Effect IO (Stream (Of Text) IO r)
ms -> IO (Stream (Of Text) IO r)
ms IO (Stream (Of Text) IO r)
%1 -> (Stream (Of Text) IO r %1 -> IO r) %1 -> IO r
forall (m :: * -> *) a b.
Monad m =>
m a %1 -> (a %1 -> m b) %1 -> m b
Control.>>= Stream (Of Text) IO r %1 -> IO r
forall r. Stream (Of Text) IO r %1 -> IO r
stdoutLn'
    Step (Text
str :> Stream (Of Text) IO r
stream) -> Control.do
      IO () %1 -> IO ()
forall a. IO a %1 -> IO a
fromSystemIO (IO () %1 -> IO ()) %1 -> IO () %1 -> IO ()
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ Text -> IO ()
Text.putStrLn Text
str
      Stream (Of Text) IO r %1 -> IO r
forall r. Stream (Of Text) IO r %1 -> IO r
stdoutLn' Stream (Of Text) IO r
stream
{-# INLINABLE stdoutLn' #-}

{-| Print the elements of a stream as they arise.

-}
print :: Show a => Stream (Of a) IO r %1-> IO r
print :: forall a r. Show a => Stream (Of a) IO r %1 -> IO r
print = Stream (Of Text) IO r %1 -> IO r
forall r. Stream (Of Text) IO r %1 -> IO r
stdoutLn' (Stream (Of Text) IO r %1 -> IO r)
%1 -> (Stream (Of a) IO r %1 -> Stream (Of Text) IO r)
%1 -> Stream (Of a) IO r
%1 -> IO r
forall b c a. (b %1 -> c) %1 -> (a %1 -> b) %1 -> a %1 -> c
. (a -> Text) -> Stream (Of a) IO r %1 -> Stream (Of Text) IO r
forall (m :: * -> *) a b r.
Monad m =>
(a -> b) -> Stream (Of a) m r %1 -> Stream (Of b) m r
map (String -> Text
Text.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. a -> String
forall a. Show a => a -> String
Prelude.show)

-- | Write a stream to a handle and return the handle.
toHandle :: Handle %1-> Stream (Of Text) RIO r %1-> RIO (r, Handle)
toHandle :: forall r. Handle %1 -> Stream (Of Text) RIO r %1 -> RIO (r, Handle)
toHandle Handle
handle Stream (Of Text) RIO r
stream = Handle %1 -> Stream (Of Text) RIO r %1 -> RIO (r, Handle)
forall r. Handle %1 -> Stream (Of Text) RIO r %1 -> RIO (r, Handle)
loop Handle
handle Stream (Of Text) RIO r
stream where
  loop :: Handle %1-> Stream (Of Text) RIO r %1-> RIO (r, Handle)
  loop :: forall r. Handle %1 -> Stream (Of Text) RIO r %1 -> RIO (r, Handle)
loop Handle
handle Stream (Of Text) RIO r
stream = Stream (Of Text) RIO r
stream Stream (Of Text) RIO r
%1 -> (Stream (Of Text) RIO r %1 -> RIO (r, Handle))
%1 -> RIO (r, Handle)
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
    Return r
r -> (r, Handle) %1 -> RIO (r, Handle)
forall (m :: * -> *) a. Monad m => a %1 -> m a
Control.return (r
r, Handle
handle)
    Effect RIO (Stream (Of Text) RIO r)
ms -> RIO (Stream (Of Text) RIO r)
ms RIO (Stream (Of Text) RIO r)
%1 -> (Stream (Of Text) RIO r %1 -> RIO (r, Handle))
%1 -> RIO (r, Handle)
forall (m :: * -> *) a b.
Monad m =>
m a %1 -> (a %1 -> m b) %1 -> m b
Control.>>= Handle %1 -> Stream (Of Text) RIO r %1 -> RIO (r, Handle)
forall r. Handle %1 -> Stream (Of Text) RIO r %1 -> RIO (r, Handle)
toHandle Handle
handle
    Step (Text
text :> Stream (Of Text) RIO r
stream') -> Control.do
      Handle
handle' <- Handle %1 -> Text -> RIO Handle
hPutStrLn Handle
handle Text
text
      Handle %1 -> Stream (Of Text) RIO r %1 -> RIO (r, Handle)
forall r. Handle %1 -> Stream (Of Text) RIO r %1 -> RIO (r, Handle)
toHandle Handle
handle' Stream (Of Text) RIO r
stream'
{-# INLINABLE toHandle #-}

-- | Write a stream of text as lines as lines to a file
writeFile :: FilePath -> Stream (Of Text) RIO r %1-> RIO r
writeFile :: forall r. String -> Stream (Of Text) RIO r %1 -> RIO r
writeFile String
filepath Stream (Of Text) RIO r
stream = Control.do
  Handle
handle <- String -> IOMode -> RIO Handle
openFile String
filepath IOMode
System.WriteMode
  (r
r,Handle
handle') <- Handle %1 -> Stream (Of Text) RIO r %1 -> RIO (r, Handle)
forall r. Handle %1 -> Stream (Of Text) RIO r %1 -> RIO (r, Handle)
toHandle Handle
handle Stream (Of Text) RIO r
stream
  Handle %1 -> RIO ()
hClose Handle
handle'
  r %1 -> RIO r
forall (m :: * -> *) a. Monad m => a %1 -> m a
Control.return r
r


-- #  Basic Pure Consumers
-------------------------------------------------------------------------------

{- | Reduce a stream, performing its actions but ignoring its elements.

@
\>\>\> rest <- S.effects $ S.splitAt 2 $ each' [1..5]
\>\>\> S.print rest
3
4
5
@

    'effects' should be understood together with 'copy' and is subject to the rules

> S.effects . S.copy       = id
> hoist S.effects . S.copy = id

    The similar @effects@ and @copy@ operations in @Data.ByteString.Streaming@ obey the same rules.

-}
effects :: forall a m r. Control.Monad m => Stream (Of a) m r %1-> m r
effects :: forall a (m :: * -> *) r. Monad m => Stream (Of a) m r %1 -> m r
effects Stream (Of a) m r
stream = Stream (Of a) m r %1 -> m r
loop Stream (Of a) m r
stream where
  loop :: Stream (Of a) m r %1-> m r
  loop :: Stream (Of a) m r %1 -> m r
loop Stream (Of a) m r
stream = Stream (Of a) m r
stream Stream (Of a) m r %1 -> (Stream (Of a) m r %1 -> m r) %1 -> m r
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
    Return r
r -> r %1 -> m r
forall (m :: * -> *) a. Monad m => a %1 -> m a
Control.return r
r
    Effect m (Stream (Of a) m r)
ms -> m (Stream (Of a) m r)
ms m (Stream (Of a) m r) %1 -> (Stream (Of a) m r %1 -> m r) %1 -> m r
forall (m :: * -> *) a b.
Monad m =>
m a %1 -> (a %1 -> m b) %1 -> m b
Control.>>= Stream (Of a) m r %1 -> m r
forall a (m :: * -> *) r. Monad m => Stream (Of a) m r %1 -> m r
effects
    Step (a
_ :> Stream (Of a) m r
stream') -> Stream (Of a) m r %1 -> m r
forall a (m :: * -> *) r. Monad m => Stream (Of a) m r %1 -> m r
effects Stream (Of a) m r
stream'
{-# INLINABLE effects #-}

{- | Remove the elements from a stream of values, retaining the structure of layers.
-}
erase :: forall a m r. Control.Monad m => Stream (Of a) m r %1-> Stream Identity m r
erase :: forall a (m :: * -> *) r.
Monad m =>
Stream (Of a) m r %1 -> Stream Identity m r
erase Stream (Of a) m r
stream = Stream (Of a) m r %1 -> Stream Identity m r
loop Stream (Of a) m r
stream where
  loop :: Stream (Of a) m r %1-> Stream Identity m r
  loop :: Stream (Of a) m r %1 -> Stream Identity m r
loop Stream (Of a) m r
stream = Stream (Of a) m r
stream Stream (Of a) m r
%1 -> (Stream (Of a) m r %1 -> Stream Identity m r)
%1 -> Stream Identity m r
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
    Return r
r -> r %1 -> Stream Identity m r
forall r (f :: * -> *) (m :: * -> *). r -> Stream f m r
Return r
r
    Step (a
_ :> Stream (Of a) m r
stream') -> Identity (Stream Identity m r) %1 -> Stream Identity m r
forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (Identity (Stream Identity m r) %1 -> Stream Identity m r)
%1 -> Identity (Stream Identity m r) %1 -> Stream Identity m r
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ Stream Identity m r %1 -> Identity (Stream Identity m r)
forall a. a -> Identity a
Identity (Stream (Of a) m r %1 -> Stream Identity m r
forall a (m :: * -> *) r.
Monad m =>
Stream (Of a) m r %1 -> Stream Identity m r
erase Stream (Of a) m r
stream')
    Effect m (Stream (Of a) m r)
ms -> m (Stream Identity m r) %1 -> Stream Identity m r
forall (m :: * -> *) (f :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (m (Stream Identity m r) %1 -> Stream Identity m r)
%1 -> m (Stream Identity m r) %1 -> Stream Identity m r
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ m (Stream (Of a) m r)
ms m (Stream (Of a) m r)
%1 -> (Stream (Of a) m r %1 -> m (Stream Identity m r))
%1 -> m (Stream Identity m r)
forall (m :: * -> *) a b.
Monad m =>
m a %1 -> (a %1 -> m b) %1 -> m b
Control.>>= (Stream Identity m r %1 -> m (Stream Identity m r)
forall (m :: * -> *) a. Monad m => a %1 -> m a
Control.return (Stream Identity m r %1 -> m (Stream Identity m r))
%1 -> (Stream (Of a) m r %1 -> Stream Identity m r)
%1 -> Stream (Of a) m r
%1 -> m (Stream Identity m r)
forall b c a. (b %1 -> c) %1 -> (a %1 -> b) %1 -> a %1 -> c
. Stream (Of a) m r %1 -> Stream Identity m r
forall a (m :: * -> *) r.
Monad m =>
Stream (Of a) m r %1 -> Stream Identity m r
erase)
{-# INLINABLE erase #-}

{-| Where a transformer returns a stream, run the effects of the stream, keeping
   the return value. This is usually used at the type

> drained :: Control.Monad m => Stream (Of a) m (Stream (Of b) m r) -> Stream (Of a) m r
> drained = Control.join . Control.fmap (Control.lift . effects)

   Here, for example, we split a stream in two places and throw out the middle segment:

@
\>\>\> rest <- S.print $ S.drained $ S.splitAt 2 $ S.splitAt 5 $ each' [1..7]
1
2
\>\>\> S.print rest
6
7
@

-}
drained ::
  ( Control.Monad m
  , Control.Monad (t m)
  , Control.Functor (t m)
  , Control.MonadTrans t) =>
  t m (Stream (Of a) m r) %1-> t m r
drained :: forall (m :: * -> *) (t :: (* -> *) -> * -> *) a r.
(Monad m, Monad (t m), Functor (t m), MonadTrans t) =>
t m (Stream (Of a) m r) %1 -> t m r
drained = t m (t m r) %1 -> t m r
forall (m :: * -> *) a. Monad m => m (m a) %1 -> m a
Control.join (t m (t m r) %1 -> t m r)
%1 -> (t m (Stream (Of a) m r) %1 -> t m (t m r))
%1 -> t m (Stream (Of a) m r)
%1 -> t m r
forall b c a. (b %1 -> c) %1 -> (a %1 -> b) %1 -> a %1 -> c
. (Stream (Of a) m r %1 -> t m r)
%1 -> t m (Stream (Of a) m r) %1 -> t m (t m r)
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
Control.fmap (m r %1 -> t m r
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a %1 -> t m a
Control.lift (m r %1 -> t m r)
%1 -> (Stream (Of a) m r %1 -> m r)
%1 -> Stream (Of a) m r
%1 -> t m r
forall b c a. (b %1 -> c) %1 -> (a %1 -> b) %1 -> a %1 -> c
. Stream (Of a) m r %1 -> m r
forall a (m :: * -> *) r. Monad m => Stream (Of a) m r %1 -> m r
effects)
{-# INLINE drained #-}

{-| Reduce a stream to its return value with a monadic action.

@
\>\>\> S.mapM_ Prelude.print $ each' [1..3]
1
2
3
@

@
\>\>\> rest <- S.mapM_ Prelude.print $ S.splitAt 3 $ each' [1..10]
1
2
3
\>\>\> S.sum rest
49 :> ()
@

-}
mapM_ :: forall a m b r. (Consumable b, Control.Monad m) =>
  (a -> m b) -> Stream (Of a) m r %1-> m r
mapM_ :: forall a (m :: * -> *) b r.
(Consumable b, Monad m) =>
(a -> m b) -> Stream (Of a) m r %1 -> m r
mapM_  a -> m b
f Stream (Of a) m r
stream = Stream (Of a) m r %1 -> m r
loop Stream (Of a) m r
stream where
  loop :: Stream (Of a) m r %1-> m r
  loop :: Stream (Of a) m r %1 -> m r
loop Stream (Of a) m r
stream = Stream (Of a) m r
stream Stream (Of a) m r %1 -> (Stream (Of a) m r %1 -> m r) %1 -> m r
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
    Return r
r -> r %1 -> m r
forall (m :: * -> *) a. Monad m => a %1 -> m a
Control.return r
r
    Effect m (Stream (Of a) m r)
ms -> m (Stream (Of a) m r)
ms m (Stream (Of a) m r) %1 -> (Stream (Of a) m r %1 -> m r) %1 -> m r
forall (m :: * -> *) a b.
Monad m =>
m a %1 -> (a %1 -> m b) %1 -> m b
Control.>>= (a -> m b) -> Stream (Of a) m r %1 -> m r
forall a (m :: * -> *) b r.
(Consumable b, Monad m) =>
(a -> m b) -> Stream (Of a) m r %1 -> m r
mapM_ a -> m b
f
    Step (a
a :> Stream (Of a) m r
stream') -> Control.do
      b
b <- a -> m b
f a
a
      () %1 -> m ()
forall (m :: * -> *) a. Monad m => a %1 -> m a
Control.return (() %1 -> m ()) %1 -> () %1 -> m ()
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ b %1 -> ()
forall a. Consumable a => a %1 -> ()
consume b
b
      (a -> m b) -> Stream (Of a) m r %1 -> m r
forall a (m :: * -> *) b r.
(Consumable b, Monad m) =>
(a -> m b) -> Stream (Of a) m r %1 -> m r
mapM_ a -> m b
f Stream (Of a) m r
stream'
{-# INLINABLE mapM_ #-}


-- #  Folds
-------------------------------------------------------------------------------


{-| Strict fold of a 'Stream' of elements that preserves the return value.
   This does not short circuit and all effects are performed.
   The third parameter will often be 'id' where a fold is written by hand:

@
\>\>\> S.fold (+) 0 id $ each' [1..10]
55 :> ()
@

@
\>\>\> S.fold (*) 1 id $ S.fold (+) 0 id $ S.copy $ each' [1..10]
3628800 :> (55 :> ())
@

    It can be used to replace a standard Haskell type with one more suited to
    writing a strict accumulation function. It is also crucial to the
    Applicative instance for @Control.Foldl.Fold@  We can apply such a fold
    @purely@

> Control.Foldl.purely S.fold :: Control.Monad m => Fold a b -> Stream (Of a) m r %1-> m (Of b r)

    Thus, specializing a bit:

> L.purely S.fold L.sum :: Stream (Of Int) Int r %1-> m (Of Int r)
> mapped (L.purely S.fold L.sum) :: Stream (Stream (Of Int)) IO r %1-> Stream (Of Int) IO r

    Here we use the Applicative instance for @Control.Foldl.Fold@ to
    stream three-item segments of a stream together with their sums and products.

@
\>\>\> S.print $ mapped (L.purely S.fold (liftA3 (,,) L.list L.product L.sum)) $ chunksOf 3 $ each' [1..10]
([1,2,3],6,6)
([4,5,6],120,15)
([7,8,9],504,24)
([10],10,10)
@

-}
fold :: forall x a b m r. Control.Monad m =>
  (x -> a -> x) -> x -> (x -> b) -> Stream (Of a) m r %1-> m (Of b r)
fold :: forall x a b (m :: * -> *) r.
Monad m =>
(x -> a -> x)
-> x -> (x -> b) -> Stream (Of a) m r %1 -> m (Of b r)
fold x -> a -> x
f x
x x -> b
g Stream (Of a) m r
stream = Stream (Of a) m r %1 -> m (Of b r)
loop Stream (Of a) m r
stream where
  loop :: Stream (Of a) m r %1-> m (Of b r)
  loop :: Stream (Of a) m r %1 -> m (Of b r)
loop Stream (Of a) m r
stream = Stream (Of a) m r
stream Stream (Of a) m r
%1 -> (Stream (Of a) m r %1 -> m (Of b r)) %1 -> m (Of b r)
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
    Return r
r -> Of b r %1 -> m (Of b r)
forall (m :: * -> *) a. Monad m => a %1 -> m a
Control.return (Of b r %1 -> m (Of b r)) %1 -> Of b r %1 -> m (Of b r)
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ x -> b
g x
x b -> r %1 -> Of b r
forall a b. a -> b -> Of a b
:> r
r
    Effect m (Stream (Of a) m r)
ms -> m (Stream (Of a) m r)
ms m (Stream (Of a) m r)
%1 -> (Stream (Of a) m r %1 -> m (Of b r)) %1 -> m (Of b r)
forall (m :: * -> *) a b.
Monad m =>
m a %1 -> (a %1 -> m b) %1 -> m b
Control.>>= (x -> a -> x)
-> x -> (x -> b) -> Stream (Of a) m r %1 -> m (Of b r)
forall x a b (m :: * -> *) r.
Monad m =>
(x -> a -> x)
-> x -> (x -> b) -> Stream (Of a) m r %1 -> m (Of b r)
fold x -> a -> x
f x
x x -> b
g
    Step (a
a :> Stream (Of a) m r
stream') -> (x -> a -> x)
-> x -> (x -> b) -> Stream (Of a) m r %1 -> m (Of b r)
forall x a b (m :: * -> *) r.
Monad m =>
(x -> a -> x)
-> x -> (x -> b) -> Stream (Of a) m r %1 -> m (Of b r)
fold x -> a -> x
f (x -> a -> x
f x
x a
a) x -> b
g Stream (Of a) m r
stream'
{-# INLINABLE fold #-}

{-| Strict fold of a 'Stream' of elements, preserving only the result of the fold, not
    the return value of the stream. This does not short circuit and all effects
    are performed. The third parameter will often be 'id' where a fold
    is written by hand:

@
\>\>\> S.fold_ (+) 0 id $ each [1..10]
55
@

    It can be used to replace a standard Haskell type with one more suited to
    writing a strict accumulation function. It is also crucial to the
    Applicative instance for @Control.Foldl.Fold@

> Control.Foldl.purely fold :: Control.Monad m => Fold a b -> Stream (Of a) m () %1-> m b

-}
fold_ :: forall x a b m r. (Control.Monad m, Consumable r) =>
  (x -> a -> x) -> x -> (x -> b) -> Stream (Of a) m r %1-> m b
fold_ :: forall x a b (m :: * -> *) r.
(Monad m, Consumable r) =>
(x -> a -> x) -> x -> (x -> b) -> Stream (Of a) m r %1 -> m b
fold_ x -> a -> x
f x
x x -> b
g Stream (Of a) m r
stream = Stream (Of a) m r %1 -> m b
loop Stream (Of a) m r
stream where
  loop :: Stream (Of a) m r %1-> m b
  loop :: Stream (Of a) m r %1 -> m b
loop Stream (Of a) m r
stream = Stream (Of a) m r
stream Stream (Of a) m r %1 -> (Stream (Of a) m r %1 -> m b) %1 -> m b
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
    Return r
r -> r %1 -> m b %1 -> m b
forall a b. Consumable a => a %1 -> b %1 -> b
lseq r
r (m b %1 -> m b) %1 -> m b %1 -> m b
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ b %1 -> m b
forall (m :: * -> *) a. Monad m => a %1 -> m a
Control.return (b %1 -> m b) %1 -> b %1 -> m b
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ x -> b
g x
x
    Effect m (Stream (Of a) m r)
ms -> m (Stream (Of a) m r)
ms m (Stream (Of a) m r) %1 -> (Stream (Of a) m r %1 -> m b) %1 -> m b
forall (m :: * -> *) a b.
Monad m =>
m a %1 -> (a %1 -> m b) %1 -> m b
Control.>>= (x -> a -> x) -> x -> (x -> b) -> Stream (Of a) m r %1 -> m b
forall x a b (m :: * -> *) r.
(Monad m, Consumable r) =>
(x -> a -> x) -> x -> (x -> b) -> Stream (Of a) m r %1 -> m b
fold_ x -> a -> x
f x
x x -> b
g
    Step (a
a :> Stream (Of a) m r
stream') -> (x -> a -> x) -> x -> (x -> b) -> Stream (Of a) m r %1 -> m b
forall x a b (m :: * -> *) r.
(Monad m, Consumable r) =>
(x -> a -> x) -> x -> (x -> b) -> Stream (Of a) m r %1 -> m b
fold_ x -> a -> x
f (x -> a -> x
f x
x a
a) x -> b
g Stream (Of a) m r
stream'
{-# INLINABLE fold_ #-}

-- Note: We can't use 'Of' since the left component is unrestricted.
-- Remark: to use the (`m x`) in the folding function that is the first
-- argument, we must bind to it. Since `m` is a `Control.Monad`, we need
-- the folding function to consume `x` linearly.
--
{-| Strict, monadic fold of the elements of a @Stream (Of a)@

> Control.Foldl.impurely foldM :: Control.Monad m => FoldM a b -> Stream (Of a) m r %1-> m (b, r)

   Thus to accumulate the elements of a stream as a vector, together with a random
   element we might write:

@
\>\>\> L.impurely S.foldM (liftA2 (,) L.vectorM L.random) $ each' [1..10::Int] :: IO (Of (Vector Int, Maybe Int) ())
([1,2,3,4,5,6,7,8,9,10],Just 9) :> ()
@
-}
foldM :: forall x a m b r. Control.Monad m =>
  (x %1-> a -> m x) -> m x -> (x %1-> m b) -> Stream (Of a) m r %1-> m (b,r)
foldM :: forall x a (m :: * -> *) b r.
Monad m =>
(x %1 -> a -> m x)
-> m x -> (x %1 -> m b) -> Stream (Of a) m r %1 -> m (b, r)
foldM x %1 -> a -> m x
f m x
mx x %1 -> m b
g Stream (Of a) m r
stream = Stream (Of a) m r %1 -> m (b, r)
loop Stream (Of a) m r
stream where
  loop :: Stream (Of a) m r %1-> m (b,r)
  loop :: Stream (Of a) m r %1 -> m (b, r)
loop Stream (Of a) m r
stream = Stream (Of a) m r
stream Stream (Of a) m r
%1 -> (Stream (Of a) m r %1 -> m (b, r)) %1 -> m (b, r)
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
    Return r
r -> m x
mx m x %1 -> (x %1 -> m b) %1 -> m b
forall (m :: * -> *) a b.
Monad m =>
m a %1 -> (a %1 -> m b) %1 -> m b
Control.>>= x %1 -> m b
g m b %1 -> (b %1 -> m (b, r)) %1 -> m (b, r)
forall (m :: * -> *) a b.
Monad m =>
m a %1 -> (a %1 -> m b) %1 -> m b
Control.>>= (\b
b -> (b, r) %1 -> m (b, r)
forall (m :: * -> *) a. Monad m => a %1 -> m a
Control.return (b
b,r
r))
    Effect m (Stream (Of a) m r)
ms -> m (Stream (Of a) m r)
ms m (Stream (Of a) m r)
%1 -> (Stream (Of a) m r %1 -> m (b, r)) %1 -> m (b, r)
forall (m :: * -> *) a b.
Monad m =>
m a %1 -> (a %1 -> m b) %1 -> m b
Control.>>= (x %1 -> a -> m x)
-> m x -> (x %1 -> m b) -> Stream (Of a) m r %1 -> m (b, r)
forall x a (m :: * -> *) b r.
Monad m =>
(x %1 -> a -> m x)
-> m x -> (x %1 -> m b) -> Stream (Of a) m r %1 -> m (b, r)
foldM x %1 -> a -> m x
f m x
mx x %1 -> m b
g
    Step (a
a :> Stream (Of a) m r
stream') -> (x %1 -> a -> m x)
-> m x -> (x %1 -> m b) -> Stream (Of a) m r %1 -> m (b, r)
forall x a (m :: * -> *) b r.
Monad m =>
(x %1 -> a -> m x)
-> m x -> (x %1 -> m b) -> Stream (Of a) m r %1 -> m (b, r)
foldM x %1 -> a -> m x
f (m x
mx m x %1 -> (x %1 -> m x) %1 -> m x
forall (m :: * -> *) a b.
Monad m =>
m a %1 -> (a %1 -> m b) %1 -> m b
Control.>>= \x
x -> x %1 -> a -> m x
f x
x a
a) x %1 -> m b
g Stream (Of a) m r
stream'
{-# INLINABLE foldM #-}

{-| Strict, monadic fold of the elements of a @Stream (Of a)@

> Control.Foldl.impurely foldM_ :: Control.Monad m => FoldM a b -> Stream (Of a) m () %1-> m b
-}
foldM_ :: forall a m x b r. (Control.Monad m, Consumable r) =>
  (x %1-> a -> m x) -> m x -> (x %1-> m b) -> Stream (Of a) m r %1-> m b
foldM_ :: forall a (m :: * -> *) x b r.
(Monad m, Consumable r) =>
(x %1 -> a -> m x)
-> m x -> (x %1 -> m b) -> Stream (Of a) m r %1 -> m b
foldM_ x %1 -> a -> m x
f m x
mx x %1 -> m b
g Stream (Of a) m r
stream = Stream (Of a) m r %1 -> m b
loop Stream (Of a) m r
stream where
  loop :: Stream (Of a) m r %1-> m b
  loop :: Stream (Of a) m r %1 -> m b
loop Stream (Of a) m r
stream = Stream (Of a) m r
stream Stream (Of a) m r %1 -> (Stream (Of a) m r %1 -> m b) %1 -> m b
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
    Return r
r  -> r %1 -> m b %1 -> m b
forall a b. Consumable a => a %1 -> b %1 -> b
lseq r
r (m b %1 -> m b) %1 -> m b %1 -> m b
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ m x
mx m x %1 -> (x %1 -> m b) %1 -> m b
forall (m :: * -> *) a b.
Monad m =>
m a %1 -> (a %1 -> m b) %1 -> m b
Control.>>= x %1 -> m b
g
    Effect m (Stream (Of a) m r)
ms -> m (Stream (Of a) m r)
ms m (Stream (Of a) m r) %1 -> (Stream (Of a) m r %1 -> m b) %1 -> m b
forall (m :: * -> *) a b.
Monad m =>
m a %1 -> (a %1 -> m b) %1 -> m b
Control.>>= (x %1 -> a -> m x)
-> m x -> (x %1 -> m b) -> Stream (Of a) m r %1 -> m b
forall a (m :: * -> *) x b r.
(Monad m, Consumable r) =>
(x %1 -> a -> m x)
-> m x -> (x %1 -> m b) -> Stream (Of a) m r %1 -> m b
foldM_ x %1 -> a -> m x
f m x
mx x %1 -> m b
g
    Step (a
a :> Stream (Of a) m r
stream') -> (x %1 -> a -> m x)
-> m x -> (x %1 -> m b) -> Stream (Of a) m r %1 -> m b
forall a (m :: * -> *) x b r.
(Monad m, Consumable r) =>
(x %1 -> a -> m x)
-> m x -> (x %1 -> m b) -> Stream (Of a) m r %1 -> m b
foldM_ x %1 -> a -> m x
f (m x
mx m x %1 -> (x %1 -> m x) %1 -> m x
forall (m :: * -> *) a b.
Monad m =>
m a %1 -> (a %1 -> m b) %1 -> m b
Control.>>= \x
x -> x %1 -> a -> m x
f x
x a
a) x %1 -> m b
g Stream (Of a) m r
stream'
{-# INLINABLE foldM_ #-}

-- | Note: does not short circuit
all :: Control.Monad m => (a -> Bool) -> Stream (Of a) m r %1-> m (Of Bool r)
all :: forall (m :: * -> *) a r.
Monad m =>
(a -> Bool) -> Stream (Of a) m r %1 -> m (Of Bool r)
all a -> Bool
f Stream (Of a) m r
stream = (Bool -> Bool -> Bool)
-> Bool
-> (Bool -> Bool)
-> Stream (Of Bool) m r
%1 -> m (Of Bool r)
forall x a b (m :: * -> *) r.
Monad m =>
(x -> a -> x)
-> x -> (x -> b) -> Stream (Of a) m r %1 -> m (Of b r)
fold Bool -> Bool -> Bool
(&&) Bool
True Bool -> Bool
forall a. a -> a
id ((a -> Bool) -> Stream (Of a) m r %1 -> Stream (Of Bool) m r
forall (m :: * -> *) a b r.
Monad m =>
(a -> b) -> Stream (Of a) m r %1 -> Stream (Of b) m r
map a -> Bool
f Stream (Of a) m r
stream)
{-# INLINABLE all #-}

-- | Note: does not short circuit
all_ :: (Consumable r, Control.Monad m) => (a -> Bool) -> Stream (Of a) m r %1-> m Bool
all_ :: forall r (m :: * -> *) a.
(Consumable r, Monad m) =>
(a -> Bool) -> Stream (Of a) m r %1 -> m Bool
all_ a -> Bool
f Stream (Of a) m r
stream = (Bool -> Bool -> Bool)
-> Bool -> (Bool -> Bool) -> Stream (Of Bool) m r %1 -> m Bool
forall x a b (m :: * -> *) r.
(Monad m, Consumable r) =>
(x -> a -> x) -> x -> (x -> b) -> Stream (Of a) m r %1 -> m b
fold_ Bool -> Bool -> Bool
(&&) Bool
True Bool -> Bool
forall a. a -> a
id ((a -> Bool) -> Stream (Of a) m r %1 -> Stream (Of Bool) m r
forall (m :: * -> *) a b r.
Monad m =>
(a -> b) -> Stream (Of a) m r %1 -> Stream (Of b) m r
map a -> Bool
f Stream (Of a) m r
stream)
{-# INLINABLE all_ #-}

-- | Note: does not short circuit
any :: Control.Monad m => (a -> Bool) -> Stream (Of a) m r %1-> m (Of Bool r)
any :: forall (m :: * -> *) a r.
Monad m =>
(a -> Bool) -> Stream (Of a) m r %1 -> m (Of Bool r)
any a -> Bool
f Stream (Of a) m r
stream = (Bool -> Bool -> Bool)
-> Bool
-> (Bool -> Bool)
-> Stream (Of Bool) m r
%1 -> m (Of Bool r)
forall x a b (m :: * -> *) r.
Monad m =>
(x -> a -> x)
-> x -> (x -> b) -> Stream (Of a) m r %1 -> m (Of b r)
fold Bool -> Bool -> Bool
(||) Bool
False Bool -> Bool
forall a. a -> a
id ((a -> Bool) -> Stream (Of a) m r %1 -> Stream (Of Bool) m r
forall (m :: * -> *) a b r.
Monad m =>
(a -> b) -> Stream (Of a) m r %1 -> Stream (Of b) m r
map a -> Bool
f Stream (Of a) m r
stream)
{-# INLINABLE any #-}

-- | Note: does not short circuit
any_ :: (Consumable r, Control.Monad m) => (a -> Bool) -> Stream (Of a) m r %1-> m Bool
any_ :: forall r (m :: * -> *) a.
(Consumable r, Monad m) =>
(a -> Bool) -> Stream (Of a) m r %1 -> m Bool
any_ a -> Bool
f Stream (Of a) m r
stream = (Bool -> Bool -> Bool)
-> Bool -> (Bool -> Bool) -> Stream (Of Bool) m r %1 -> m Bool
forall x a b (m :: * -> *) r.
(Monad m, Consumable r) =>
(x -> a -> x) -> x -> (x -> b) -> Stream (Of a) m r %1 -> m b
fold_ Bool -> Bool -> Bool
(||) Bool
False Bool -> Bool
forall a. a -> a
id ((a -> Bool) -> Stream (Of a) m r %1 -> Stream (Of Bool) m r
forall (m :: * -> *) a b r.
Monad m =>
(a -> b) -> Stream (Of a) m r %1 -> Stream (Of b) m r
map a -> Bool
f Stream (Of a) m r
stream)
{-# INLINABLE any_ #-}

{-| Fold a 'Stream' of numbers into their sum with the return value

>  mapped S.sum :: Stream (Stream (Of Int)) m r %1-> Stream (Of Int) m r

@
\>\>\> S.sum $ each' [1..10]
55 :> ()
@

@
\>\>\> (n :> rest)  <- S.sum $ S.splitAt 3 $ each' [1..10]
\>\>\> System.IO.print n
6
\>\>\> (m :> rest') <- S.sum $ S.splitAt 3 rest
\>\>\> System.IO.print m
15
\>\>\> S.print rest'
7
8
9
10
@
-}
sum :: (Control.Monad m, Num a) => Stream (Of a) m r %1-> m (Of a r)
sum :: forall (m :: * -> *) a r.
(Monad m, Num a) =>
Stream (Of a) m r %1 -> m (Of a r)
sum Stream (Of a) m r
stream = (a -> a -> a)
-> a -> (a -> a) -> Stream (Of a) m r %1 -> m (Of a r)
forall x a b (m :: * -> *) r.
Monad m =>
(x -> a -> x)
-> x -> (x -> b) -> Stream (Of a) m r %1 -> m (Of b r)
fold a -> a -> a
forall a. Num a => a -> a -> a
(+) a
0 a -> a
forall a. a -> a
id Stream (Of a) m r
stream
{-# INLINE sum #-}

-- | Fold a 'Stream' of numbers into their sum
sum_ :: (Control.Monad m, Num a) => Stream (Of a) m () %1-> m a
sum_ :: forall (m :: * -> *) a.
(Monad m, Num a) =>
Stream (Of a) m () %1 -> m a
sum_ Stream (Of a) m ()
stream = (a -> a -> a) -> a -> (a -> a) -> Stream (Of a) m () %1 -> m a
forall x a b (m :: * -> *) r.
(Monad m, Consumable r) =>
(x -> a -> x) -> x -> (x -> b) -> Stream (Of a) m r %1 -> m b
fold_ a -> a -> a
forall a. Num a => a -> a -> a
(+) a
0 a -> a
forall a. a -> a
id Stream (Of a) m ()
stream
{-# INLINE sum_ #-}

{-| Fold a 'Stream' of numbers into their product with the return value

>  mapped product :: Stream (Stream (Of Int)) m r -> Stream (Of Int) m r
-}
product :: (Control.Monad m, Num a) => Stream (Of a) m r %1-> m (Of a r)
product :: forall (m :: * -> *) a r.
(Monad m, Num a) =>
Stream (Of a) m r %1 -> m (Of a r)
product Stream (Of a) m r
stream = (a -> a -> a)
-> a -> (a -> a) -> Stream (Of a) m r %1 -> m (Of a r)
forall x a b (m :: * -> *) r.
Monad m =>
(x -> a -> x)
-> x -> (x -> b) -> Stream (Of a) m r %1 -> m (Of b r)
fold a -> a -> a
forall a. Num a => a -> a -> a
(*) a
1 a -> a
forall a. a -> a
id Stream (Of a) m r
stream
{-# INLINE product #-}

-- | Fold a 'Stream' of numbers into their product
product_ :: (Control.Monad m, Num a) => Stream (Of a) m () %1-> m a
product_ :: forall (m :: * -> *) a.
(Monad m, Num a) =>
Stream (Of a) m () %1 -> m a
product_ Stream (Of a) m ()
stream = (a -> a -> a) -> a -> (a -> a) -> Stream (Of a) m () %1 -> m a
forall x a b (m :: * -> *) r.
(Monad m, Consumable r) =>
(x -> a -> x) -> x -> (x -> b) -> Stream (Of a) m r %1 -> m b
fold_ a -> a -> a
forall a. Num a => a -> a -> a
(*) a
1 a -> a
forall a. a -> a
id Stream (Of a) m ()
stream
{-# INLINE product_ #-}

-- | Note that 'head' exhausts the rest of the stream following the
-- first element, performing all monadic effects via 'effects'
head :: Control.Monad m => Stream (Of a) m r %1-> m (Of (Maybe a) r)
head :: forall (m :: * -> *) a r.
Monad m =>
Stream (Of a) m r %1 -> m (Of (Maybe a) r)
head Stream (Of a) m r
str = Stream (Of a) m r
str Stream (Of a) m r
%1 -> (Stream (Of a) m r %1 -> m (Of (Maybe a) r))
%1 -> m (Of (Maybe a) r)
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
  Return r
r -> Of (Maybe a) r %1 -> m (Of (Maybe a) r)
forall (m :: * -> *) a. Monad m => a %1 -> m a
Control.return (Maybe a
forall a. Maybe a
Nothing Maybe a -> r %1 -> Of (Maybe a) r
forall a b. a -> b -> Of a b
:> r
r)
  Effect m (Stream (Of a) m r)
m -> m (Stream (Of a) m r)
m m (Stream (Of a) m r)
%1 -> (Stream (Of a) m r %1 -> m (Of (Maybe a) r))
%1 -> m (Of (Maybe a) r)
forall (m :: * -> *) a b.
Monad m =>
m a %1 -> (a %1 -> m b) %1 -> m b
Control.>>= Stream (Of a) m r %1 -> m (Of (Maybe a) r)
forall (m :: * -> *) a r.
Monad m =>
Stream (Of a) m r %1 -> m (Of (Maybe a) r)
head
  Step (a
a :> Stream (Of a) m r
rest) ->
    Stream (Of a) m r %1 -> m r
forall a (m :: * -> *) r. Monad m => Stream (Of a) m r %1 -> m r
effects Stream (Of a) m r
rest m r %1 -> (r %1 -> m (Of (Maybe a) r)) %1 -> m (Of (Maybe a) r)
forall (m :: * -> *) a b.
Monad m =>
m a %1 -> (a %1 -> m b) %1 -> m b
Control.>>= \r
r -> Of (Maybe a) r %1 -> m (Of (Maybe a) r)
forall (m :: * -> *) a. Monad m => a %1 -> m a
Control.return (a -> Maybe a
forall a. a -> Maybe a
Just a
a Maybe a -> r %1 -> Of (Maybe a) r
forall a b. a -> b -> Of a b
:> r
r)
{-# INLINABLE head #-}

-- | Note that 'head' exhausts the rest of the stream following the
-- first element, performing all monadic effects via 'effects'
head_ :: (Consumable r, Control.Monad m) => Stream (Of a) m r %1-> m (Maybe a)
head_ :: forall r (m :: * -> *) a.
(Consumable r, Monad m) =>
Stream (Of a) m r %1 -> m (Maybe a)
head_ Stream (Of a) m r
str = Stream (Of a) m r
str Stream (Of a) m r
%1 -> (Stream (Of a) m r %1 -> m (Maybe a)) %1 -> m (Maybe a)
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
  Return r
r -> r %1 -> m (Maybe a) %1 -> m (Maybe a)
forall a b. Consumable a => a %1 -> b %1 -> b
lseq r
r (m (Maybe a) %1 -> m (Maybe a)) %1 -> m (Maybe a) %1 -> m (Maybe a)
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ Maybe a %1 -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a %1 -> m a
Control.return Maybe a
forall a. Maybe a
Nothing
  Effect m (Stream (Of a) m r)
m -> m (Stream (Of a) m r)
m m (Stream (Of a) m r)
%1 -> (Stream (Of a) m r %1 -> m (Maybe a)) %1 -> m (Maybe a)
forall (m :: * -> *) a b.
Monad m =>
m a %1 -> (a %1 -> m b) %1 -> m b
Control.>>= Stream (Of a) m r %1 -> m (Maybe a)
forall r (m :: * -> *) a.
(Consumable r, Monad m) =>
Stream (Of a) m r %1 -> m (Maybe a)
head_
  Step (a
a :> Stream (Of a) m r
rest) ->
    Stream (Of a) m r %1 -> m r
forall a (m :: * -> *) r. Monad m => Stream (Of a) m r %1 -> m r
effects Stream (Of a) m r
rest m r %1 -> (r %1 -> m (Maybe a)) %1 -> m (Maybe a)
forall (m :: * -> *) a b.
Monad m =>
m a %1 -> (a %1 -> m b) %1 -> m b
Control.>>= \r
r -> r %1 -> m (Maybe a) %1 -> m (Maybe a)
forall a b. Consumable a => a %1 -> b %1 -> b
lseq r
r (m (Maybe a) %1 -> m (Maybe a)) %1 -> m (Maybe a) %1 -> m (Maybe a)
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ Maybe a %1 -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a %1 -> m a
Control.return  (a -> Maybe a
forall a. a -> Maybe a
Just a
a)
{-# INLINABLE head_ #-}

last :: Control.Monad m => Stream (Of a) m r %1-> m (Of (Maybe a) r)
last :: forall (m :: * -> *) a r.
Monad m =>
Stream (Of a) m r %1 -> m (Of (Maybe a) r)
last = Maybe a -> Stream (Of a) m r %1 -> m (Of (Maybe a) r)
forall (m :: * -> *) a r.
Monad m =>
Maybe a -> Stream (Of a) m r %1 -> m (Of (Maybe a) r)
loop Maybe a
forall a. Maybe a
Nothing where
  loop :: Control.Monad m =>
    Maybe a -> Stream (Of a) m r %1-> m (Of (Maybe a) r)
  loop :: forall (m :: * -> *) a r.
Monad m =>
Maybe a -> Stream (Of a) m r %1 -> m (Of (Maybe a) r)
loop Maybe a
m Stream (Of a) m r
s = Stream (Of a) m r
s Stream (Of a) m r
%1 -> (Stream (Of a) m r %1 -> m (Of (Maybe a) r))
%1 -> m (Of (Maybe a) r)
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
    Return r
r  -> Of (Maybe a) r %1 -> m (Of (Maybe a) r)
forall (m :: * -> *) a. Monad m => a %1 -> m a
Control.return (Maybe a
m Maybe a -> r %1 -> Of (Maybe a) r
forall a b. a -> b -> Of a b
:> r
r)
    Effect m (Stream (Of a) m r)
m -> m (Stream (Of a) m r)
m m (Stream (Of a) m r)
%1 -> (Stream (Of a) m r %1 -> m (Of (Maybe a) r))
%1 -> m (Of (Maybe a) r)
forall (m :: * -> *) a b.
Monad m =>
m a %1 -> (a %1 -> m b) %1 -> m b
Control.>>= Stream (Of a) m r %1 -> m (Of (Maybe a) r)
forall (m :: * -> *) a r.
Monad m =>
Stream (Of a) m r %1 -> m (Of (Maybe a) r)
last
    Step (a
a :> Stream (Of a) m r
rest) -> Maybe a -> Stream (Of a) m r %1 -> m (Of (Maybe a) r)
forall (m :: * -> *) a r.
Monad m =>
Maybe a -> Stream (Of a) m r %1 -> m (Of (Maybe a) r)
loop (a -> Maybe a
forall a. a -> Maybe a
Just a
a) Stream (Of a) m r
rest
{-# INLINABLE last #-}

last_ :: (Consumable r, Control.Monad m) => Stream (Of a) m r %1-> m (Maybe a)
last_ :: forall r (m :: * -> *) a.
(Consumable r, Monad m) =>
Stream (Of a) m r %1 -> m (Maybe a)
last_ = Maybe a -> Stream (Of a) m r %1 -> m (Maybe a)
forall r (m :: * -> *) a.
(Consumable r, Monad m) =>
Maybe a -> Stream (Of a) m r %1 -> m (Maybe a)
loop Maybe a
forall a. Maybe a
Nothing where
  loop :: (Consumable r, Control.Monad m) =>
    Maybe a -> Stream (Of a) m r %1-> m (Maybe a)
  loop :: forall r (m :: * -> *) a.
(Consumable r, Monad m) =>
Maybe a -> Stream (Of a) m r %1 -> m (Maybe a)
loop Maybe a
m Stream (Of a) m r
s = Stream (Of a) m r
s Stream (Of a) m r
%1 -> (Stream (Of a) m r %1 -> m (Maybe a)) %1 -> m (Maybe a)
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
    Return r
r  -> r %1 -> m (Maybe a) %1 -> m (Maybe a)
forall a b. Consumable a => a %1 -> b %1 -> b
lseq r
r (m (Maybe a) %1 -> m (Maybe a)) %1 -> m (Maybe a) %1 -> m (Maybe a)
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ Maybe a %1 -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a %1 -> m a
Control.return Maybe a
m
    Effect m (Stream (Of a) m r)
m -> m (Stream (Of a) m r)
m m (Stream (Of a) m r)
%1 -> (Stream (Of a) m r %1 -> m (Maybe a)) %1 -> m (Maybe a)
forall (m :: * -> *) a b.
Monad m =>
m a %1 -> (a %1 -> m b) %1 -> m b
Control.>>= Stream (Of a) m r %1 -> m (Maybe a)
forall r (m :: * -> *) a.
(Consumable r, Monad m) =>
Stream (Of a) m r %1 -> m (Maybe a)
last_
    Step (a
a :> Stream (Of a) m r
rest) -> Maybe a -> Stream (Of a) m r %1 -> m (Maybe a)
forall r (m :: * -> *) a.
(Consumable r, Monad m) =>
Maybe a -> Stream (Of a) m r %1 -> m (Maybe a)
loop (a -> Maybe a
forall a. a -> Maybe a
Just a
a) Stream (Of a) m r
rest
{-# INLINABLE last_ #-}

elem :: forall a m r. (Control.Monad m, Eq a) =>
  a -> Stream (Of a) m r %1-> m (Of Bool r)
elem :: forall a (m :: * -> *) r.
(Monad m, Eq a) =>
a -> Stream (Of a) m r %1 -> m (Of Bool r)
elem a
a Stream (Of a) m r
stream = Stream (Of a) m r %1 -> m (Of Bool r)
loop Stream (Of a) m r
stream where
  loop :: Stream (Of a) m r %1-> m (Of Bool r)
  loop :: Stream (Of a) m r %1 -> m (Of Bool r)
loop Stream (Of a) m r
stream = Stream (Of a) m r
stream Stream (Of a) m r
%1 -> (Stream (Of a) m r %1 -> m (Of Bool r)) %1 -> m (Of Bool r)
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
    Return r
r -> Of Bool r %1 -> m (Of Bool r)
forall (m :: * -> *) a. Monad m => a %1 -> m a
Control.return (Of Bool r %1 -> m (Of Bool r)) %1 -> Of Bool r %1 -> m (Of Bool r)
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ Bool
False Bool -> r %1 -> Of Bool r
forall a b. a -> b -> Of a b
:> r
r
    Effect m (Stream (Of a) m r)
ms -> m (Stream (Of a) m r)
ms m (Stream (Of a) m r)
%1 -> (Stream (Of a) m r %1 -> m (Of Bool r)) %1 -> m (Of Bool r)
forall (m :: * -> *) a b.
Monad m =>
m a %1 -> (a %1 -> m b) %1 -> m b
Control.>>= a -> Stream (Of a) m r %1 -> m (Of Bool r)
forall a (m :: * -> *) r.
(Monad m, Eq a) =>
a -> Stream (Of a) m r %1 -> m (Of Bool r)
elem a
a
    Step (a
a' :> Stream (Of a) m r
stream') -> case a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a' of
      Bool
True -> Stream (Of a) m r %1 -> m r
forall a (m :: * -> *) r. Monad m => Stream (Of a) m r %1 -> m r
effects Stream (Of a) m r
stream' m r %1 -> (r %1 -> m (Of Bool r)) %1 -> m (Of Bool r)
forall (m :: * -> *) a b.
Monad m =>
m a %1 -> (a %1 -> m b) %1 -> m b
Control.>>= (\r
r -> Of Bool r %1 -> m (Of Bool r)
forall (m :: * -> *) a. Monad m => a %1 -> m a
Control.return (Of Bool r %1 -> m (Of Bool r)) %1 -> Of Bool r %1 -> m (Of Bool r)
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ Bool
True Bool -> r %1 -> Of Bool r
forall a b. a -> b -> Of a b
:> r
r)
      Bool
False -> a -> Stream (Of a) m r %1 -> m (Of Bool r)
forall a (m :: * -> *) r.
(Monad m, Eq a) =>
a -> Stream (Of a) m r %1 -> m (Of Bool r)
elem a
a Stream (Of a) m r
stream'
{-# INLINABLE elem #-}

elem_ :: forall a m r. (Consumable r, Control.Monad m, Eq a) =>
  a -> Stream (Of a) m r %1-> m Bool
elem_ :: forall a (m :: * -> *) r.
(Consumable r, Monad m, Eq a) =>
a -> Stream (Of a) m r %1 -> m Bool
elem_ a
a Stream (Of a) m r
stream = Stream (Of a) m r %1 -> m Bool
loop Stream (Of a) m r
stream where
  loop :: Stream (Of a) m r %1-> m Bool
  loop :: Stream (Of a) m r %1 -> m Bool
loop Stream (Of a) m r
stream = Stream (Of a) m r
stream Stream (Of a) m r
%1 -> (Stream (Of a) m r %1 -> m Bool) %1 -> m Bool
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
    Return r
r -> r %1 -> m Bool %1 -> m Bool
forall a b. Consumable a => a %1 -> b %1 -> b
lseq r
r (m Bool %1 -> m Bool) %1 -> m Bool %1 -> m Bool
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ Bool %1 -> m Bool
forall (m :: * -> *) a. Monad m => a %1 -> m a
Control.return Bool
False
    Effect m (Stream (Of a) m r)
ms -> m (Stream (Of a) m r)
ms m (Stream (Of a) m r)
%1 -> (Stream (Of a) m r %1 -> m Bool) %1 -> m Bool
forall (m :: * -> *) a b.
Monad m =>
m a %1 -> (a %1 -> m b) %1 -> m b
Control.>>= a -> Stream (Of a) m r %1 -> m Bool
forall a (m :: * -> *) r.
(Consumable r, Monad m, Eq a) =>
a -> Stream (Of a) m r %1 -> m Bool
elem_ a
a
    Step (a
a' :> Stream (Of a) m r
stream') -> case a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a' of
      Bool
True -> Stream (Of a) m r %1 -> m r
forall a (m :: * -> *) r. Monad m => Stream (Of a) m r %1 -> m r
effects Stream (Of a) m r
stream' m r %1 -> (r %1 -> m Bool) %1 -> m Bool
forall (m :: * -> *) a b.
Monad m =>
m a %1 -> (a %1 -> m b) %1 -> m b
Control.>>= \r
r -> r %1 -> m Bool %1 -> m Bool
forall a b. Consumable a => a %1 -> b %1 -> b
lseq r
r (m Bool %1 -> m Bool) %1 -> m Bool %1 -> m Bool
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ Bool %1 -> m Bool
forall (m :: * -> *) a. Monad m => a %1 -> m a
Control.return Bool
True
      Bool
False -> a -> Stream (Of a) m r %1 -> m Bool
forall a (m :: * -> *) r.
(Consumable r, Monad m, Eq a) =>
a -> Stream (Of a) m r %1 -> m Bool
elem_ a
a Stream (Of a) m r
stream'
{-# INLINABLE elem_ #-}

{-| Exhaust a stream deciding whether @a@ was an element.

-}
notElem :: (Control.Monad m, Eq a) => a -> Stream (Of a) m r %1-> m (Of Bool r)
notElem :: forall (m :: * -> *) a r.
(Monad m, Eq a) =>
a -> Stream (Of a) m r %1 -> m (Of Bool r)
notElem a
a Stream (Of a) m r
stream = (Of Bool r %1 -> Of Bool r) %1 -> m (Of Bool r) %1 -> m (Of Bool r)
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
Control.fmap Of Bool r %1 -> Of Bool r
forall r. Of Bool r %1 -> Of Bool r
negate (m (Of Bool r) %1 -> m (Of Bool r))
%1 -> m (Of Bool r) %1 -> m (Of Bool r)
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ a -> Stream (Of a) m r %1 -> m (Of Bool r)
forall a (m :: * -> *) r.
(Monad m, Eq a) =>
a -> Stream (Of a) m r %1 -> m (Of Bool r)
elem a
a Stream (Of a) m r
stream
  where
    negate :: Of Bool r %1-> Of Bool r
    negate :: forall r. Of Bool r %1 -> Of Bool r
negate (Bool
b :> r
r) = Bool -> Bool
Prelude.not Bool
b Bool -> r %1 -> Of Bool r
forall a b. a -> b -> Of a b
:> r
r
{-# INLINE notElem #-}

notElem_ :: (Consumable r, Control.Monad m, Eq a) => a -> Stream (Of a) m r %1-> m Bool
notElem_ :: forall r (m :: * -> *) a.
(Consumable r, Monad m, Eq a) =>
a -> Stream (Of a) m r %1 -> m Bool
notElem_ a
a Stream (Of a) m r
stream = (Bool %1 -> Bool) %1 -> m Bool %1 -> m Bool
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
Control.fmap Bool %1 -> Bool
Linear.not (m Bool %1 -> m Bool) %1 -> m Bool %1 -> m Bool
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ a -> Stream (Of a) m r %1 -> m Bool
forall a (m :: * -> *) r.
(Consumable r, Monad m, Eq a) =>
a -> Stream (Of a) m r %1 -> m Bool
elem_ a
a Stream (Of a) m r
stream
{-# INLINE notElem_ #-}

{-| Run a stream, keeping its length and its return value.

@
\>\>\> S.print $ mapped S.length $ chunksOf 3 $ S.each' [1..10]
3
3
3
1
@

-}
length :: Control.Monad m => Stream (Of a) m r %1-> m (Of Int r)
length :: forall (m :: * -> *) a r.
Monad m =>
Stream (Of a) m r %1 -> m (Of Int r)
length = (Int -> a -> Int)
-> Int -> (Int -> Int) -> Stream (Of a) m r %1 -> m (Of Int r)
forall x a b (m :: * -> *) r.
Monad m =>
(x -> a -> x)
-> x -> (x -> b) -> Stream (Of a) m r %1 -> m (Of b r)
fold (\Int
n a
_ -> Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
0 Int -> Int
forall a. a -> a
id
{-# INLINE length #-}


{-| Run a stream, remembering only its length:

@
\>\>\> runIdentity $ S.length_ (S.each [1..10] :: Stream (Of Int) Identity ())
10
@
-}
length_ :: (Consumable r, Control.Monad m) => Stream (Of a) m r %1-> m Int
length_ :: forall r (m :: * -> *) a.
(Consumable r, Monad m) =>
Stream (Of a) m r %1 -> m Int
length_ = (Int -> a -> Int)
-> Int -> (Int -> Int) -> Stream (Of a) m r %1 -> m Int
forall x a b (m :: * -> *) r.
(Monad m, Consumable r) =>
(x -> a -> x) -> x -> (x -> b) -> Stream (Of a) m r %1 -> m b
fold_ (\Int
n a
_ -> Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
0 Int -> Int
forall a. a -> a
id
{-# INLINE length_ #-}

{-| Convert an effectful 'Stream' into a list alongside the return value

>  mapped toList :: Stream (Stream (Of a) m) m r %1-> Stream (Of [a]) m r

    Like 'toList_', 'toList' breaks streaming; unlike 'toList_' it /preserves the return value/
    and thus is frequently useful with e.g. 'mapped'

@
\>\>\> S.print $ mapped S.toList $ chunksOf 3 $ each' [1..9]
[1,2,3]
[4,5,6]
[7,8,9]
@

@
\>\>\> S.print $ mapped S.toList $ chunksOf 2 $ S.replicateM 4 getLine
s<Enter>
t<Enter>
["s","t"]
u<Enter>
v<Enter>
["u","v"]
@
-}
toList :: Control.Monad m => Stream (Of a) m r %1-> m (Of [a] r)
toList :: forall (m :: * -> *) a r.
Monad m =>
Stream (Of a) m r %1 -> m (Of [a] r)
toList = (([a] -> [a]) -> a -> [a] -> [a])
-> ([a] -> [a])
-> (([a] -> [a]) -> [a])
-> Stream (Of a) m r
%1 -> m (Of [a] r)
forall x a b (m :: * -> *) r.
Monad m =>
(x -> a -> x)
-> x -> (x -> b) -> Stream (Of a) m r %1 -> m (Of b r)
fold (\[a] -> [a]
diff a
a [a]
ls -> [a] -> [a]
diff (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ls)) [a] -> [a]
forall a. a -> a
id (\[a] -> [a]
diff -> [a] -> [a]
diff [])
{-# INLINE toList #-}

{-| Convert an effectful @Stream (Of a)@ into a list of @as@

    Note: Needless to say, this function does not stream properly.
    It is basically the same as Prelude 'mapM' which, like 'replicateM',
    'sequence' and similar operations on traversable containers
    is a leading cause of space leaks.

-}
toList_ :: Control.Monad m => Stream (Of a) m () %1-> m [a]
toList_ :: forall (m :: * -> *) a. Monad m => Stream (Of a) m () %1 -> m [a]
toList_ = (([a] -> [a]) -> a -> [a] -> [a])
-> ([a] -> [a])
-> (([a] -> [a]) -> [a])
-> Stream (Of a) m ()
%1 -> m [a]
forall x a b (m :: * -> *) r.
(Monad m, Consumable r) =>
(x -> a -> x) -> x -> (x -> b) -> Stream (Of a) m r %1 -> m b
fold_ (\[a] -> [a]
diff a
a [a]
ls -> [a] -> [a]
diff (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ls)) [a] -> [a]
forall a. a -> a
id (\[a] -> [a]
diff -> [a] -> [a]
diff [])
{-# INLINE toList_ #-}

{-| Fold streamed items into their monoidal sum
 -}
mconcat :: (Control.Monad m, Prelude.Monoid w) => Stream (Of w) m r %1-> m (Of w r)
mconcat :: forall (m :: * -> *) w r.
(Monad m, Monoid w) =>
Stream (Of w) m r %1 -> m (Of w r)
mconcat = (w -> w -> w)
-> w -> (w -> w) -> Stream (Of w) m r %1 -> m (Of w r)
forall x a b (m :: * -> *) r.
Monad m =>
(x -> a -> x)
-> x -> (x -> b) -> Stream (Of a) m r %1 -> m (Of b r)
fold w -> w -> w
forall a. Semigroup a => a -> a -> a
(Prelude.<>) w
forall a. Monoid a => a
Prelude.mempty w -> w
forall a. a -> a
id
{-# INLINE mconcat #-}

mconcat_ :: (Consumable r, Control.Monad m, Prelude.Monoid w) =>
  Stream (Of w) m r %1-> m w
mconcat_ :: forall r (m :: * -> *) w.
(Consumable r, Monad m, Monoid w) =>
Stream (Of w) m r %1 -> m w
mconcat_ = (w -> w -> w) -> w -> (w -> w) -> Stream (Of w) m r %1 -> m w
forall x a b (m :: * -> *) r.
(Monad m, Consumable r) =>
(x -> a -> x) -> x -> (x -> b) -> Stream (Of a) m r %1 -> m b
fold_ w -> w -> w
forall a. Semigroup a => a -> a -> a
(Prelude.<>) w
forall a. Monoid a => a
Prelude.mempty w -> w
forall a. a -> a
id
{-# INLINE mconcat_ #-}

minimum :: (Control.Monad m, Ord a) => Stream (Of a) m r %1-> m (Of (Maybe a) r)
minimum :: forall (m :: * -> *) a r.
(Monad m, Ord a) =>
Stream (Of a) m r %1 -> m (Of (Maybe a) r)
minimum = (Maybe a -> Maybe a -> Maybe a)
-> Maybe a
-> (Maybe a -> Maybe a)
-> Stream (Of (Maybe a)) m r
%1 -> m (Of (Maybe a) r)
forall x a b (m :: * -> *) r.
Monad m =>
(x -> a -> x)
-> x -> (x -> b) -> Stream (Of a) m r %1 -> m (Of b r)
fold Maybe a -> Maybe a -> Maybe a
forall a. Ord a => Maybe a -> Maybe a -> Maybe a
getMin Maybe a
forall a. Maybe a
Nothing Maybe a -> Maybe a
forall a. a -> a
id (Stream (Of (Maybe a)) m r %1 -> m (Of (Maybe a) r))
%1 -> (Stream (Of a) m r %1 -> Stream (Of (Maybe a)) m r)
%1 -> Stream (Of a) m r
%1 -> m (Of (Maybe a) r)
forall b c a. (b %1 -> c) %1 -> (a %1 -> b) %1 -> a %1 -> c
. (a -> Maybe a) -> Stream (Of a) m r %1 -> Stream (Of (Maybe a)) m r
forall (m :: * -> *) a b r.
Monad m =>
(a -> b) -> Stream (Of a) m r %1 -> Stream (Of b) m r
map a -> Maybe a
forall a. a -> Maybe a
Just
{-# INLINE minimum #-}

minimum_ :: (Consumable r, Control.Monad m, Ord a) =>
  Stream (Of a) m r %1-> m (Maybe a)
minimum_ :: forall r (m :: * -> *) a.
(Consumable r, Monad m, Ord a) =>
Stream (Of a) m r %1 -> m (Maybe a)
minimum_ = (Maybe a -> Maybe a -> Maybe a)
-> Maybe a
-> (Maybe a -> Maybe a)
-> Stream (Of (Maybe a)) m r
%1 -> m (Maybe a)
forall x a b (m :: * -> *) r.
(Monad m, Consumable r) =>
(x -> a -> x) -> x -> (x -> b) -> Stream (Of a) m r %1 -> m b
fold_ Maybe a -> Maybe a -> Maybe a
forall a. Ord a => Maybe a -> Maybe a -> Maybe a
getMin Maybe a
forall a. Maybe a
Nothing Maybe a -> Maybe a
forall a. a -> a
id (Stream (Of (Maybe a)) m r %1 -> m (Maybe a))
%1 -> (Stream (Of a) m r %1 -> Stream (Of (Maybe a)) m r)
%1 -> Stream (Of a) m r
%1 -> m (Maybe a)
forall b c a. (b %1 -> c) %1 -> (a %1 -> b) %1 -> a %1 -> c
. (a -> Maybe a) -> Stream (Of a) m r %1 -> Stream (Of (Maybe a)) m r
forall (m :: * -> *) a b r.
Monad m =>
(a -> b) -> Stream (Of a) m r %1 -> Stream (Of b) m r
map a -> Maybe a
forall a. a -> Maybe a
Just
{-# INLINE minimum_ #-}

maximum :: (Control.Monad m, Ord a) => Stream (Of a) m r %1-> m (Of (Maybe a) r)
maximum :: forall (m :: * -> *) a r.
(Monad m, Ord a) =>
Stream (Of a) m r %1 -> m (Of (Maybe a) r)
maximum = (Maybe a -> Maybe a -> Maybe a)
-> Maybe a
-> (Maybe a -> Maybe a)
-> Stream (Of (Maybe a)) m r
%1 -> m (Of (Maybe a) r)
forall x a b (m :: * -> *) r.
Monad m =>
(x -> a -> x)
-> x -> (x -> b) -> Stream (Of a) m r %1 -> m (Of b r)
fold Maybe a -> Maybe a -> Maybe a
forall a. Ord a => Maybe a -> Maybe a -> Maybe a
getMax Maybe a
forall a. Maybe a
Nothing Maybe a -> Maybe a
forall a. a -> a
id (Stream (Of (Maybe a)) m r %1 -> m (Of (Maybe a) r))
%1 -> (Stream (Of a) m r %1 -> Stream (Of (Maybe a)) m r)
%1 -> Stream (Of a) m r
%1 -> m (Of (Maybe a) r)
forall b c a. (b %1 -> c) %1 -> (a %1 -> b) %1 -> a %1 -> c
. (a -> Maybe a) -> Stream (Of a) m r %1 -> Stream (Of (Maybe a)) m r
forall (m :: * -> *) a b r.
Monad m =>
(a -> b) -> Stream (Of a) m r %1 -> Stream (Of b) m r
map a -> Maybe a
forall a. a -> Maybe a
Just
{-# INLINE maximum #-}

maximum_ :: (Consumable r, Control.Monad m, Ord a) =>
  Stream (Of a) m r %1-> m (Maybe a)
maximum_ :: forall r (m :: * -> *) a.
(Consumable r, Monad m, Ord a) =>
Stream (Of a) m r %1 -> m (Maybe a)
maximum_ = (Maybe a -> Maybe a -> Maybe a)
-> Maybe a
-> (Maybe a -> Maybe a)
-> Stream (Of (Maybe a)) m r
%1 -> m (Maybe a)
forall x a b (m :: * -> *) r.
(Monad m, Consumable r) =>
(x -> a -> x) -> x -> (x -> b) -> Stream (Of a) m r %1 -> m b
fold_ Maybe a -> Maybe a -> Maybe a
forall a. Ord a => Maybe a -> Maybe a -> Maybe a
getMax Maybe a
forall a. Maybe a
Nothing Maybe a -> Maybe a
forall a. a -> a
id (Stream (Of (Maybe a)) m r %1 -> m (Maybe a))
%1 -> (Stream (Of a) m r %1 -> Stream (Of (Maybe a)) m r)
%1 -> Stream (Of a) m r
%1 -> m (Maybe a)
forall b c a. (b %1 -> c) %1 -> (a %1 -> b) %1 -> a %1 -> c
. (a -> Maybe a) -> Stream (Of a) m r %1 -> Stream (Of (Maybe a)) m r
forall (m :: * -> *) a b r.
Monad m =>
(a -> b) -> Stream (Of a) m r %1 -> Stream (Of b) m r
map a -> Maybe a
forall a. a -> Maybe a
Just
{-# INLINE maximum_ #-}

getMin :: Ord a => Maybe a -> Maybe a -> Maybe a
getMin :: forall a. Ord a => Maybe a -> Maybe a -> Maybe a
getMin = (a -> a -> a) -> Maybe a -> Maybe a -> Maybe a
forall a. Ord a => (a -> a -> a) -> Maybe a -> Maybe a -> Maybe a
mCompare a -> a -> a
forall a. Ord a => a -> a -> a
Prelude.min

getMax :: Ord a => Maybe a -> Maybe a -> Maybe a
getMax :: forall a. Ord a => Maybe a -> Maybe a -> Maybe a
getMax = (a -> a -> a) -> Maybe a -> Maybe a -> Maybe a
forall a. Ord a => (a -> a -> a) -> Maybe a -> Maybe a -> Maybe a
mCompare a -> a -> a
forall a. Ord a => a -> a -> a
Prelude.max

mCompare :: Ord a => (a -> a -> a) -> Maybe a -> Maybe a -> Maybe a
mCompare :: forall a. Ord a => (a -> a -> a) -> Maybe a -> Maybe a -> Maybe a
mCompare a -> a -> a
_ Maybe a
Nothing Maybe a
Nothing = Maybe a
forall a. Maybe a
Nothing
mCompare a -> a -> a
_ (Just a
a) Maybe a
Nothing = a -> Maybe a
forall a. a -> Maybe a
Just a
a
mCompare a -> a -> a
_ Maybe a
Nothing (Just a
a) = a -> Maybe a
forall a. a -> Maybe a
Just a
a
mCompare a -> a -> a
comp (Just a
x) (Just a
y) = a %1 -> Maybe a
forall a. a -> Maybe a
Just (a %1 -> Maybe a) %1 -> a %1 -> Maybe a
forall a b. (a %1 -> b) %1 -> a %1 -> b
$ a -> a -> a
comp a
x a
y

{-| A natural right fold for consuming a stream of elements.
    See also the more general 'iterT' in the 'Streaming' module and the
    still more general 'destroy'
-}
foldrM :: forall a m r. Control.Monad m
       => (a -> m r %1-> m r) -> Stream (Of a) m r %1-> m r
foldrM :: forall a (m :: * -> *) r.
Monad m =>
(a -> m r %1 -> m r) -> Stream (Of a) m r %1 -> m r
foldrM a -> m r %1 -> m r
step Stream (Of a) m r
stream = Stream (Of a) m r %1 -> m r
loop Stream (Of a) m r
stream where
  loop :: Stream (Of a) m r %1-> m r
  loop :: Stream (Of a) m r %1 -> m r
loop Stream (Of a) m r
stream = Stream (Of a) m r
stream Stream (Of a) m r %1 -> (Stream (Of a) m r %1 -> m r) %1 -> m r
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
    Return r
r -> r %1 -> m r
forall (m :: * -> *) a. Monad m => a %1 -> m a
Control.return r
r
    Effect m (Stream (Of a) m r)
m -> m (Stream (Of a) m r)
m m (Stream (Of a) m r) %1 -> (Stream (Of a) m r %1 -> m r) %1 -> m r
forall (m :: * -> *) a b.
Monad m =>
m a %1 -> (a %1 -> m b) %1 -> m b
Control.>>= (a -> m r %1 -> m r) -> Stream (Of a) m r %1 -> m r
forall a (m :: * -> *) r.
Monad m =>
(a -> m r %1 -> m r) -> Stream (Of a) m r %1 -> m r
foldrM a -> m r %1 -> m r
step
    Step (a
a :> Stream (Of a) m r
as) -> a -> m r %1 -> m r
step a
a ((a -> m r %1 -> m r) -> Stream (Of a) m r %1 -> m r
forall a (m :: * -> *) r.
Monad m =>
(a -> m r %1 -> m r) -> Stream (Of a) m r %1 -> m r
foldrM a -> m r %1 -> m r
step Stream (Of a) m r
as)
{-# INLINABLE foldrM #-}

{-| A natural right fold for consuming a stream of elements.
    See also the more general 'iterTM' in the 'Streaming' module
    and the still more general 'destroy'

> foldrT (\a p -> Streaming.yield a >> p) = id

-}
foldrT :: forall a t m r.
  (Control.Monad m, Control.MonadTrans t, Control.Monad (t m)) =>
  (a -> t m r %1-> t m r) -> Stream (Of a) m r %1-> t m r
foldrT :: forall a (t :: (* -> *) -> * -> *) (m :: * -> *) r.
(Monad m, MonadTrans t, Monad (t m)) =>
(a -> t m r %1 -> t m r) -> Stream (Of a) m r %1 -> t m r
foldrT a -> t m r %1 -> t m r
step Stream (Of a) m r
stream = Stream (Of a) m r %1 -> t m r
loop Stream (Of a) m r
stream where
  loop :: Stream (Of a) m r %1-> t m r
  loop :: Stream (Of a) m r %1 -> t m r
loop Stream (Of a) m r
stream = Stream (Of a) m r
stream Stream (Of a) m r %1 -> (Stream (Of a) m r %1 -> t m r) %1 -> t m r
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
    Return r
r -> r %1 -> t m r
forall (m :: * -> *) a. Monad m => a %1 -> m a
Control.return r
r
    Effect m (Stream (Of a) m r)
ms -> (m (Stream (Of a) m r) %1 -> t m (Stream (Of a) m r)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a %1 -> t m a
Control.lift m (Stream (Of a) m r)
ms) t m (Stream (Of a) m r)
%1 -> (Stream (Of a) m r %1 -> t m r) %1 -> t m r
forall (m :: * -> *) a b.
Monad m =>
m a %1 -> (a %1 -> m b) %1 -> m b
Control.>>= (a -> t m r %1 -> t m r) -> Stream (Of a) m r %1 -> t m r
forall a (t :: (* -> *) -> * -> *) (m :: * -> *) r.
(Monad m, MonadTrans t, Monad (t m)) =>
(a -> t m r %1 -> t m r) -> Stream (Of a) m r %1 -> t m r
foldrT a -> t m r %1 -> t m r
step
    Step (a
a :> Stream (Of a) m r
as) -> a -> t m r %1 -> t m r
step a
a ((a -> t m r %1 -> t m r) -> Stream (Of a) m r %1 -> t m r
forall a (t :: (* -> *) -> * -> *) (m :: * -> *) r.
(Monad m, MonadTrans t, Monad (t m)) =>
(a -> t m r %1 -> t m r) -> Stream (Of a) m r %1 -> t m r
foldrT a -> t m r %1 -> t m r
step Stream (Of a) m r
as)
{-# INLINABLE foldrT #-}