{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
#ifndef MIN_VERSION_base
#define MIN_VERSION_base(x,y,z) 0
#endif
module Data.Machine.Runner
    ( foldrT
    , foldlT
    , foldMapT
    , foldT
    , runT1

    -- Re-exports
    , runT
    , runT_ ) where

import Data.Machine.Type
import Control.Monad (liftM)
#if !MIN_VERSION_base (4,8,0)
import Data.Monoid (Monoid (..))
#endif

-- | Right fold over a stream. This will be lazy if the underlying
-- monad is.
--
-- @runT = foldrT (:) []@
foldrT :: Monad m => (o -> b -> b) -> b -> MachineT m k o -> m b
foldrT :: (o -> b -> b) -> b -> MachineT m k o -> m b
foldrT o -> b -> b
c b
n = MachineT m k o -> m b
forall (m :: * -> *) (k :: * -> *).
Monad m =>
MachineT m k o -> m b
go
    where
      go :: MachineT m k o -> m b
go MachineT m k o
m = do
        Step k o (MachineT m k o)
step <- MachineT m k o -> m (Step k o (MachineT m k o))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT MachineT m k o
m
        case Step k o (MachineT m k o)
step of
          Step k o (MachineT m k o)
Stop -> b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
n
          Yield o
o MachineT m k o
m' -> o -> b -> b
c o
o (b -> b) -> m b -> m b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` MachineT m k o -> m b
go MachineT m k o
m'
          Await t -> MachineT m k o
_ k t
_ MachineT m k o
m' -> MachineT m k o -> m b
go MachineT m k o
m'

-- | Strict left fold over a stream.
foldlT :: Monad m => (b -> o -> b) -> b -> MachineT m k o -> m b
foldlT :: (b -> o -> b) -> b -> MachineT m k o -> m b
foldlT b -> o -> b
f = b -> MachineT m k o -> m b
forall (m :: * -> *) (k :: * -> *).
Monad m =>
b -> MachineT m k o -> m b
go
    where
      go :: b -> MachineT m k o -> m b
go !b
b MachineT m k o
m = do
        Step k o (MachineT m k o)
step <- MachineT m k o -> m (Step k o (MachineT m k o))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT MachineT m k o
m
        case Step k o (MachineT m k o)
step of
          Step k o (MachineT m k o)
Stop -> b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
b
          Yield o
o MachineT m k o
m' -> b -> MachineT m k o -> m b
go (b -> o -> b
f b
b o
o) MachineT m k o
m'
          Await t -> MachineT m k o
_ k t
_ MachineT m k o
m' -> b -> MachineT m k o -> m b
go b
b MachineT m k o
m'

-- | Strict fold over a stream. Items are accumulated on the right:
--
-- @... ((f o1 <> f o2) <> f o3) ...@
--
-- Where this is expensive, use the dual monoid instead.
foldMapT :: (Monad m, Monoid r) => (o -> r) -> MachineT m k o -> m r
foldMapT :: (o -> r) -> MachineT m k o -> m r
foldMapT o -> r
f = (r -> o -> r) -> r -> MachineT m k o -> m r
forall (m :: * -> *) b o (k :: * -> *).
Monad m =>
(b -> o -> b) -> b -> MachineT m k o -> m b
foldlT (\r
b o
o -> r -> r -> r
forall a. Monoid a => a -> a -> a
mappend r
b (o -> r
f o
o)) r
forall a. Monoid a => a
mempty

-- | Strict fold over a monoid stream. Items are accumulated on the
-- right:
--
-- @... ((o1 <> o2) <> o3) ...@
--
-- Where this is expensive, use the dual monoid instead.
--
-- @foldT = foldMapT id@
foldT :: (Monad m, Monoid o) => MachineT m k o -> m o
foldT :: MachineT m k o -> m o
foldT = (o -> o -> o) -> o -> MachineT m k o -> m o
forall (m :: * -> *) b o (k :: * -> *).
Monad m =>
(b -> o -> b) -> b -> MachineT m k o -> m b
foldlT o -> o -> o
forall a. Monoid a => a -> a -> a
mappend o
forall a. Monoid a => a
mempty

-- | Run a machine with no input until it yields for the first time,
-- then stop it. This is intended primarily for use with accumulating
-- machines, such as the ones produced by 'fold' or 'fold1'
--
-- @runT1 m = getFirst <$> foldMapT (First . Just) (m ~> taking 1)@
runT1 :: Monad m => MachineT m k o -> m (Maybe o)
runT1 :: MachineT m k o -> m (Maybe o)
runT1 MachineT m k o
m = do
  Step k o (MachineT m k o)
step <- MachineT m k o -> m (Step k o (MachineT m k o))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT MachineT m k o
m
  case Step k o (MachineT m k o)
step of
    Step k o (MachineT m k o)
Stop -> Maybe o -> m (Maybe o)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe o
forall a. Maybe a
Nothing
    Yield o
o MachineT m k o
_ -> Maybe o -> m (Maybe o)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe o -> m (Maybe o)) -> Maybe o -> m (Maybe o)
forall a b. (a -> b) -> a -> b
$ o -> Maybe o
forall a. a -> Maybe a
Just o
o
    Await t -> MachineT m k o
_ k t
_ MachineT m k o
m' -> MachineT m k o -> m (Maybe o)
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
MachineT m k o -> m (Maybe o)
runT1 MachineT m k o
m'