{-# 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 { forall t (m :: * -> *) a.
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 :: 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
w0 = do
  rec eResult <- networkHold (unWorkflow w0) $ fmap unWorkflow $ switch $ snd <$> current eResult
  return $ fmap fst 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 :: 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
w0 = do
  rec eResult <- networkView . fmap unWorkflow =<< holdDyn w0 eReplace
      eReplace <- fmap switch $ hold never $ fmap snd eResult
  return $ fmap fst 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 :: forall t (m :: * -> *) a b.
(Reflex t, Functor m) =>
(a -> b) -> Workflow t m a -> Workflow t m b
mapWorkflow a -> b
f (Workflow 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 a b. (a -> b) -> m a -> 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 b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
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 a b. (a -> b) -> Event t a -> Event t 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 :: forall t (m :: * -> *) a b.
(Reflex t, Functor m) =>
(a -> b) -> Workflow t m a -> Workflow t m b
mapWorkflowCheap a -> b
f (Workflow 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 a b. (a -> b) -> m a -> 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 b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
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)