{-# LANGUAGE RecursiveDo #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- |
-- Module:
--   Reflex.Workflow
-- Description:
--   Provides a convenient way to describe a series of interrelated widgets that
--   can send data to, invoke, and replace one another. Useful for modeling user interface
--   "workflows."
module Reflex.Workflow (
    Workflow (..)
  , workflow
  , workflowView
  , mapWorkflow
  , mapWorkflowCheap
  ) where

import Control.Arrow ((***))
import Control.Monad.Fix (MonadFix)

import Reflex.Class
import Reflex.Adjustable.Class
import Reflex.Network
import Reflex.NotReady.Class
import Reflex.PostBuild.Class

-- | A widget in a workflow
-- When the 'Event' returned by a 'Workflow' fires, the current 'Workflow' is replaced by the one inside the firing 'Event'. A series of 'Workflow's must share the same return type.
newtype Workflow t m a = Workflow { Workflow t m a -> m (a, Event t (Workflow t m a))
unWorkflow :: m (a, Event t (Workflow t m a)) }

-- | Runs a 'Workflow' and returns the 'Dynamic' result of the 'Workflow' (i.e., a 'Dynamic' of the value produced by the current 'Workflow' node, and whose update 'Event' fires whenever one 'Workflow' is replaced by another).
workflow :: forall t m a. (Reflex t, Adjustable t m, MonadFix m, MonadHold t m) => Workflow t m a -> m (Dynamic t a)
workflow :: Workflow t m a -> m (Dynamic t a)
workflow w0 :: Workflow t m a
w0 = do
  rec Dynamic t (a, Event t (Workflow t m a))
eResult <- m (a, Event t (Workflow t m a))
-> Event t (m (a, Event t (Workflow t m a)))
-> m (Dynamic t (a, Event t (Workflow t m a)))
forall t (m :: * -> *) a.
(Adjustable t m, MonadHold t m) =>
m a -> Event t (m a) -> m (Dynamic t a)
networkHold (Workflow t m a -> m (a, Event t (Workflow t m a))
forall t (m :: * -> *) a.
Workflow t m a -> m (a, Event t (Workflow t m a))
unWorkflow Workflow t m a
w0) (Event t (m (a, Event t (Workflow t m a)))
 -> m (Dynamic t (a, Event t (Workflow t m a))))
-> Event t (m (a, Event t (Workflow t m a)))
-> m (Dynamic t (a, Event t (Workflow t m a)))
forall a b. (a -> b) -> a -> b
$ (Workflow t m a -> m (a, Event t (Workflow t m a)))
-> Event t (Workflow t m a)
-> Event t (m (a, Event t (Workflow t m a)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Workflow t m a -> m (a, Event t (Workflow t m a))
forall t (m :: * -> *) a.
Workflow t m a -> m (a, Event t (Workflow t m a))
unWorkflow (Event t (Workflow t m a)
 -> Event t (m (a, Event t (Workflow t m a))))
-> Event t (Workflow t m a)
-> Event t (m (a, Event t (Workflow t m a)))
forall a b. (a -> b) -> a -> b
$ Behavior t (Event t (Workflow t m a)) -> Event t (Workflow t m a)
forall k (t :: k) a.
Reflex t =>
Behavior t (Event t a) -> Event t a
switch (Behavior t (Event t (Workflow t m a)) -> Event t (Workflow t m a))
-> Behavior t (Event t (Workflow t m a))
-> Event t (Workflow t m a)
forall a b. (a -> b) -> a -> b
$ (a, Event t (Workflow t m a)) -> Event t (Workflow t m a)
forall a b. (a, b) -> b
snd ((a, Event t (Workflow t m a)) -> Event t (Workflow t m a))
-> Behavior t (a, Event t (Workflow t m a))
-> Behavior t (Event t (Workflow t m a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t (a, Event t (Workflow t m a))
-> Behavior t (a, Event t (Workflow t m a))
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t (a, Event t (Workflow t m a))
eResult
  Dynamic t a -> m (Dynamic t a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Dynamic t a -> m (Dynamic t a)) -> Dynamic t a -> m (Dynamic t a)
forall a b. (a -> b) -> a -> b
$ ((a, Event t (Workflow t m a)) -> a)
-> Dynamic t (a, Event t (Workflow t m a)) -> Dynamic t a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, Event t (Workflow t m a)) -> a
forall a b. (a, b) -> a
fst Dynamic t (a, Event t (Workflow t m a))
eResult

-- | Similar to 'workflow', but outputs an 'Event' that fires at post-build time and whenever the current 'Workflow' is replaced by the next 'Workflow'.
workflowView :: forall t m a. (Reflex t, NotReady t m, Adjustable t m, MonadFix m, MonadHold t m, PostBuild t m) => Workflow t m a -> m (Event t a)
workflowView :: Workflow t m a -> m (Event t a)
workflowView w0 :: Workflow t m a
w0 = do
  rec Event t (a, Event t (Workflow t m a))
eResult <- Dynamic t (m (a, Event t (Workflow t m a)))
-> m (Event t (a, Event t (Workflow t m a)))
forall t (m :: * -> *) a.
(NotReady t m, Adjustable t m, PostBuild t m) =>
Dynamic t (m a) -> m (Event t a)
networkView (Dynamic t (m (a, Event t (Workflow t m a)))
 -> m (Event t (a, Event t (Workflow t m a))))
-> (Dynamic t (Workflow t m a)
    -> Dynamic t (m (a, Event t (Workflow t m a))))
-> Dynamic t (Workflow t m a)
-> m (Event t (a, Event t (Workflow t m a)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Workflow t m a -> m (a, Event t (Workflow t m a)))
-> Dynamic t (Workflow t m a)
-> Dynamic t (m (a, Event t (Workflow t m a)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Workflow t m a -> m (a, Event t (Workflow t m a))
forall t (m :: * -> *) a.
Workflow t m a -> m (a, Event t (Workflow t m a))
unWorkflow (Dynamic t (Workflow t m a)
 -> m (Event t (a, Event t (Workflow t m a))))
-> m (Dynamic t (Workflow t m a))
-> m (Event t (a, Event t (Workflow t m a)))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Workflow t m a
-> Event t (Workflow t m a) -> m (Dynamic t (Workflow t m a))
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn Workflow t m a
w0 Event t (Workflow t m a)
eReplace
      Event t (Workflow t m a)
eReplace <- (Behavior t (Event t (Workflow t m a)) -> Event t (Workflow t m a))
-> m (Behavior t (Event t (Workflow t m a)))
-> m (Event t (Workflow t m a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Behavior t (Event t (Workflow t m a)) -> Event t (Workflow t m a)
forall k (t :: k) a.
Reflex t =>
Behavior t (Event t a) -> Event t a
switch (m (Behavior t (Event t (Workflow t m a)))
 -> m (Event t (Workflow t m a)))
-> m (Behavior t (Event t (Workflow t m a)))
-> m (Event t (Workflow t m a))
forall a b. (a -> b) -> a -> b
$ Event t (Workflow t m a)
-> Event t (Event t (Workflow t m a))
-> m (Behavior t (Event t (Workflow t m a)))
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Behavior t a)
hold Event t (Workflow t m a)
forall k (t :: k) a. Reflex t => Event t a
never (Event t (Event t (Workflow t m a))
 -> m (Behavior t (Event t (Workflow t m a))))
-> Event t (Event t (Workflow t m a))
-> m (Behavior t (Event t (Workflow t m a)))
forall a b. (a -> b) -> a -> b
$ ((a, Event t (Workflow t m a)) -> Event t (Workflow t m a))
-> Event t (a, Event t (Workflow t m a))
-> Event t (Event t (Workflow t m a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, Event t (Workflow t m a)) -> Event t (Workflow t m a)
forall a b. (a, b) -> b
snd Event t (a, Event t (Workflow t m a))
eResult
  Event t a -> m (Event t a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Event t a -> m (Event t a)) -> Event t a -> m (Event t a)
forall a b. (a -> b) -> a -> b
$ ((a, Event t (Workflow t m a)) -> a)
-> Event t (a, Event t (Workflow t m a)) -> Event t a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, Event t (Workflow t m a)) -> a
forall a b. (a, b) -> a
fst Event t (a, Event t (Workflow t m a))
eResult

-- | Map a function over a 'Workflow', possibly changing the return type.
mapWorkflow :: (Reflex t, Functor m) => (a -> b) -> Workflow t m a -> Workflow t m b
mapWorkflow :: (a -> b) -> Workflow t m a -> Workflow t m b
mapWorkflow f :: a -> b
f (Workflow x :: m (a, Event t (Workflow t m a))
x) = m (b, Event t (Workflow t m b)) -> Workflow t m b
forall t (m :: * -> *) a.
m (a, Event t (Workflow t m a)) -> Workflow t m a
Workflow (((a, Event t (Workflow t m a)) -> (b, Event t (Workflow t m b)))
-> m (a, Event t (Workflow t m a))
-> m (b, Event t (Workflow t m b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b
f (a -> b)
-> (Event t (Workflow t m a) -> Event t (Workflow t m b))
-> (a, Event t (Workflow t m a))
-> (b, Event t (Workflow t m b))
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** (Workflow t m a -> Workflow t m b)
-> Event t (Workflow t m a) -> Event t (Workflow t m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Workflow t m a -> Workflow t m b
forall t (m :: * -> *) a b.
(Reflex t, Functor m) =>
(a -> b) -> Workflow t m a -> Workflow t m b
mapWorkflow a -> b
f)) m (a, Event t (Workflow t m a))
x)

-- | Map a "cheap" function over a 'Workflow'. Refer to the documentation for 'pushCheap' for more information and performance considerations.
mapWorkflowCheap :: (Reflex t, Functor m) => (a -> b) -> Workflow t m a -> Workflow t m b
mapWorkflowCheap :: (a -> b) -> Workflow t m a -> Workflow t m b
mapWorkflowCheap f :: a -> b
f (Workflow x :: m (a, Event t (Workflow t m a))
x) = m (b, Event t (Workflow t m b)) -> Workflow t m b
forall t (m :: * -> *) a.
m (a, Event t (Workflow t m a)) -> Workflow t m a
Workflow (((a, Event t (Workflow t m a)) -> (b, Event t (Workflow t m b)))
-> m (a, Event t (Workflow t m a))
-> m (b, Event t (Workflow t m b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b
f (a -> b)
-> (Event t (Workflow t m a) -> Event t (Workflow t m b))
-> (a, Event t (Workflow t m a))
-> (b, Event t (Workflow t m b))
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** (Workflow t m a -> Workflow t m b)
-> Event t (Workflow t m a) -> Event t (Workflow t m b)
forall k (t :: k) a b.
Reflex t =>
(a -> b) -> Event t a -> Event t b
fmapCheap ((a -> b) -> Workflow t m a -> Workflow t m b
forall t (m :: * -> *) a b.
(Reflex t, Functor m) =>
(a -> b) -> Workflow t m a -> Workflow t m b
mapWorkflowCheap a -> b
f)) m (a, Event t (Workflow t m a))
x)