{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE FlexibleInstances #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Machine.Source
-- Copyright   :  (C) 2012 Edward Kmett
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  provisional
-- Portability :  Rank-2 Types
--
----------------------------------------------------------------------------
module Data.Machine.Source
  (
  -- * Sources
    Source, SourceT
  , source
  , repeated
  , cycled
  , cap
  , plug
  , iterated
  , replicated
  , enumerateFromTo
  , unfold
  , unfoldT
  ) where

import Control.Monad.Trans
import Data.Foldable
import Data.Machine.Plan
import Data.Machine.Type
import Data.Machine.Process
import Prelude (Enum, Int, Maybe, Monad, ($), (>>=), return)

-- $setup
-- >>> import Data.Machine

-------------------------------------------------------------------------------
-- Source
-------------------------------------------------------------------------------

-- | A 'Source' never reads from its inputs.
type Source b = forall k. Machine k b

-- | A 'SourceT' never reads from its inputs, but may have monadic side-effects.
type SourceT m b = forall k. MachineT m k b

-- | Repeat the same value, over and over.
--
-- This can be constructed from a plan with
-- @
-- repeated :: o -> Source o
-- repeated = repeatedly . yield
-- @
--
-- Examples:
--
-- >>> run $ taking 5 <~ repeated 1
-- [1,1,1,1,1]
--
repeated :: o -> Source o
repeated :: o -> Source o
repeated o
o =
    MachineT m k o
forall (k :: * -> *). MachineT m k o
loop
  where
    loop :: MachineT m k o
loop = Step k o (MachineT m k o) -> MachineT m k o
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased (o -> MachineT m k o -> Step k o (MachineT m k o)
forall (k :: * -> *) o r. o -> r -> Step k o r
Yield o
o MachineT m k o
loop)

-- | Loop through a 'Foldable' container over and over.
--
-- This can be constructed from a plan with
-- @
-- cycled :: Foldable f => f b -> Source b
-- cycled = repeatedly (traverse_ yield xs)
-- @
--
-- Examples:
--
-- >>> run $ taking 5 <~ cycled [1,2]
-- [1,2,1,2,1]
--
cycled :: Foldable f => f b -> Source b
cycled :: f b -> Source b
cycled f b
xs = (b -> MachineT m k b -> MachineT m k b)
-> MachineT m k b -> f b -> MachineT m k b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr b -> MachineT m k b -> MachineT m k b
forall (m :: * -> *) o (k :: * -> *).
Monad m =>
o -> MachineT m k o -> MachineT m k o
go (f b -> Source b
forall (f :: * -> *) b. Foldable f => f b -> Source b
cycled f b
xs) f b
xs
  where
    go :: o -> MachineT m k o -> MachineT m k o
go o
x MachineT m k o
m = Step k o (MachineT m k o) -> MachineT m k o
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased (Step k o (MachineT m k o) -> MachineT m k o)
-> Step k o (MachineT m k o) -> MachineT m k o
forall a b. (a -> b) -> a -> b
$ o -> MachineT m k o -> Step k o (MachineT m k o)
forall (k :: * -> *) o r. o -> r -> Step k o r
Yield o
x MachineT m k o
m

-- | Generate a 'Source' from any 'Foldable' container.
--
-- This can be constructed from a plan with
-- @
-- source :: Foldable f => f b -> Source b
-- source = construct (traverse_ yield xs)
-- @
--
-- Examples:
--
-- >>> run $ source [1,2]
-- [1,2]
--
source :: Foldable f => f b -> Source b
source :: f b -> Source b
source f b
f = (b -> MachineT m k b -> MachineT m k b)
-> MachineT m k b -> f b -> MachineT m k b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr b -> MachineT m k b -> MachineT m k b
forall (m :: * -> *) o (k :: * -> *).
Monad m =>
o -> MachineT m k o -> MachineT m k o
go MachineT m k b
forall (k :: * -> *) b. Machine k b
stopped f b
f
  where
    go :: o -> MachineT m k o -> MachineT m k o
go o
x MachineT m k o
m = Step k o (MachineT m k o) -> MachineT m k o
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased (Step k o (MachineT m k o) -> MachineT m k o)
-> Step k o (MachineT m k o) -> MachineT m k o
forall a b. (a -> b) -> a -> b
$ o -> MachineT m k o -> Step k o (MachineT m k o)
forall (k :: * -> *) o r. o -> r -> Step k o r
Yield o
x MachineT m k o
m

-- |
-- You can transform a 'Source' with a 'Process'.
--
-- Alternately you can view this as capping the 'Source' end of a 'Process',
-- yielding a new 'Source'.
--
-- @'cap' l r = l '<~' r@
--
cap :: Process a b -> Source a -> Source b
cap :: Process a b -> Source a -> Source b
cap Process a b
l Source a
r = MachineT m (Is a) b
Process a b
l MachineT m (Is a) b -> MachineT m k a -> MachineT m k b
forall (m :: * -> *) b c (k :: * -> *).
Monad m =>
ProcessT m b c -> MachineT m k b -> MachineT m k c
<~ MachineT m k a
Source a
r

-- |
-- You can transform any 'MachineT' into a 'SourceT', blocking its input.
--
-- This is used by capT, and capWye, and allows an efficient way to plug
-- together machines of different input languages.
--
plug :: Monad m => MachineT m k o -> SourceT m o
plug :: MachineT m k o -> SourceT m o
plug (MachineT m (Step k o (MachineT m k o))
m) = m (Step k o (MachineT m k o)) -> MachineT m k o
forall (m :: * -> *) (k :: * -> *) o.
m (Step k o (MachineT m k o)) -> MachineT m k o
MachineT (m (Step k o (MachineT m k o)) -> MachineT m k o)
-> m (Step k o (MachineT m k o)) -> MachineT m k o
forall a b. (a -> b) -> a -> b
$ m (Step k o (MachineT m k o))
m m (Step k o (MachineT m k o))
-> (Step k o (MachineT m k o) -> m (Step k o (MachineT m k o)))
-> m (Step k o (MachineT m k o))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Step k o (MachineT m k o)
x -> case Step k o (MachineT m k o)
x of
  Yield o
o MachineT m k o
k     -> Step k o (MachineT m k o) -> m (Step k o (MachineT m k o))
forall (m :: * -> *) a. Monad m => a -> m a
return (o -> MachineT m k o -> Step k o (MachineT m k o)
forall (k :: * -> *) o r. o -> r -> Step k o r
Yield o
o (MachineT m k o -> SourceT m o
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
MachineT m k o -> SourceT m o
plug MachineT m k o
k))
  Step k o (MachineT m k o)
Stop          -> Step k o (MachineT m k o) -> m (Step k o (MachineT m k o))
forall (m :: * -> *) a. Monad m => a -> m a
return Step k o (MachineT m k o)
forall (k :: * -> *) o r. Step k o r
Stop
  Await t -> MachineT m k o
_ k t
_ MachineT m k o
h   -> 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 (Step k o (MachineT m k o)))
-> MachineT m k o -> m (Step k o (MachineT m k o))
forall a b. (a -> b) -> a -> b
$ MachineT m k o -> SourceT m o
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
MachineT m k o -> SourceT m o
plug MachineT m k o
h

-- | 'iterated' @f x@ returns an infinite source of repeated applications
-- of @f@ to @x@
iterated :: (a -> a) -> a -> Source a
iterated :: (a -> a) -> a -> Source a
iterated a -> a
f a
x = PlanT k a m Any -> MachineT m k a
forall (m :: * -> *) (k :: * -> *) o a.
Monad m =>
PlanT k o m a -> MachineT m k o
construct (a -> PlanT k a m Any
forall (k :: * -> *) (m :: * -> *) b. a -> PlanT k a m b
go a
x) where
  go :: a -> PlanT k a m b
go a
a = do
    a -> Plan k a ()
forall o (k :: * -> *). o -> Plan k o ()
yield a
a
    a -> PlanT k a m b
go (a -> a
f a
a)

-- | 'replicated' @n x@ is a source of @x@ emitted @n@ time(s)
replicated :: Int -> a -> Source a
replicated :: Int -> a -> Source a
replicated Int
n a
x = a -> Source a
forall o. o -> Source o
repeated a
x MachineT m k a -> ProcessT m a a -> MachineT m k a
forall (m :: * -> *) (k :: * -> *) b c.
Monad m =>
MachineT m k b -> ProcessT m b c -> MachineT m k c
~> Int -> Process a a
forall a. Int -> Process a a
taking Int
n

-- | Enumerate from a value to a final value, inclusive, via 'succ'
--
-- Examples:
--
-- >>> run $ enumerateFromTo 1 3
-- [1,2,3]
--
enumerateFromTo :: Enum a => a -> a -> Source a
enumerateFromTo :: a -> a -> Source a
enumerateFromTo a
start a
end = [a] -> Source a
forall (f :: * -> *) b. Foldable f => f b -> Source b
source [ a
start .. a
end ]

-- | 'unfold' @k seed@ The function takes the element and returns Nothing if it
--   is done producing values or returns Just (a,r), in which case, @a@ is
--   'yield'ed and @r@ is used as the next element in a recursive call.
unfold :: (r -> Maybe (a, r)) -> r -> Source a
unfold :: (r -> Maybe (a, r)) -> r -> Source a
unfold r -> Maybe (a, r)
k r
seed = PlanT k a m () -> MachineT m k a
forall (m :: * -> *) (k :: * -> *) o a.
Monad m =>
PlanT k o m a -> MachineT m k o
construct (r -> PlanT k a m ()
forall (k :: * -> *) (m :: * -> *). r -> PlanT k a m ()
go r
seed)
  where
    go :: r -> PlanT k a m ()
go r
r = Maybe (a, r) -> ((a, r) -> PlanT k a m ()) -> PlanT k a m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (r -> Maybe (a, r)
k r
r) (((a, r) -> PlanT k a m ()) -> PlanT k a m ())
-> ((a, r) -> PlanT k a m ()) -> PlanT k a m ()
forall a b. (a -> b) -> a -> b
$ \(a
a, r
r') -> do
      a -> Plan k a ()
forall o (k :: * -> *). o -> Plan k o ()
yield a
a
      r -> PlanT k a m ()
go r
r'

-- | Effectful 'unfold' variant.
unfoldT :: Monad m => (r -> m (Maybe (a, r))) -> r -> SourceT m a
unfoldT :: (r -> m (Maybe (a, r))) -> r -> SourceT m a
unfoldT r -> m (Maybe (a, r))
k r
seed = PlanT k a m () -> MachineT m k a
forall (m :: * -> *) (k :: * -> *) o a.
Monad m =>
PlanT k o m a -> MachineT m k o
construct (r -> PlanT k a m ()
forall (k :: * -> *). r -> PlanT k a m ()
go r
seed)
  where
    go :: r -> PlanT k a m ()
go r
r = do
      Maybe (a, r)
opt <- m (Maybe (a, r)) -> PlanT k a m (Maybe (a, r))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe (a, r)) -> PlanT k a m (Maybe (a, r)))
-> m (Maybe (a, r)) -> PlanT k a m (Maybe (a, r))
forall a b. (a -> b) -> a -> b
$ r -> m (Maybe (a, r))
k r
r
      Maybe (a, r) -> ((a, r) -> PlanT k a m ()) -> PlanT k a m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe (a, r)
opt (((a, r) -> PlanT k a m ()) -> PlanT k a m ())
-> ((a, r) -> PlanT k a m ()) -> PlanT k a m ()
forall a b. (a -> b) -> a -> b
$ \(a
a, r
r') -> do
        a -> Plan k a ()
forall o (k :: * -> *). o -> Plan k o ()
yield a
a
        r -> PlanT k a m ()
go r
r'