on develop help sign in
reflex/src/Reflex/Workflow.hs
50 lines 2.5 kB history raw
1{-# LANGUAGE RecursiveDo #-}
2{-# LANGUAGE ScopedTypeVariables #-}
3-- |
4-- Module:
5-- Reflex.Workflow
6-- Description:
7-- Provides a convenient way to describe a series of interrelated widgets that
8-- can send data to, invoke, and replace one another. Useful for modeling user interface
9-- "workflows."
10module Reflex.Workflow (
11 Workflow (..)
12 , workflow
13 , workflowView
14 , mapWorkflow
15 , mapWorkflowCheap
16 ) where
18import Control.Arrow ((***))
19import Control.Monad.Fix (MonadFix)
21import Reflex.Class
22import Reflex.Adjustable.Class
23import Reflex.Network
24import Reflex.NotReady.Class
25import Reflex.PostBuild.Class
27-- | A widget in a workflow
28-- 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.
29newtype Workflow t m a = Workflow { unWorkflow :: m (a, Event t (Workflow t m a)) }
31-- | 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).
32workflow :: forall t m a. (Reflex t, Adjustable t m, MonadFix m, MonadHold t m) => Workflow t m a -> m (Dynamic t a)
33workflow w0 = do
34 rec eResult <- networkHold (unWorkflow w0) $ fmap unWorkflow $ switch $ snd <$> current eResult
35 return $ fmap fst eResult
37-- | Similar to 'workflow', but outputs an 'Event' that fires at post-build time and whenever the current 'Workflow' is replaced by the next 'Workflow'.
38workflowView :: 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)
39workflowView w0 = do
40 rec eResult <- networkView . fmap unWorkflow =<< holdDyn w0 eReplace
41 eReplace <- fmap switch $ hold never $ fmap snd eResult
42 return $ fmap fst eResult
44-- | Map a function over a 'Workflow', possibly changing the return type.
45mapWorkflow :: (Reflex t, Functor m) => (a -> b) -> Workflow t m a -> Workflow t m b
46mapWorkflow f (Workflow x) = Workflow (fmap (f *** fmap (mapWorkflow f)) x)
48-- | Map a "cheap" function over a 'Workflow'. Refer to the documentation for 'pushCheap' for more information and performance considerations.
49mapWorkflowCheap :: (Reflex t, Functor m) => (a -> b) -> Workflow t m a -> Workflow t m b
50mapWorkflowCheap f (Workflow x) = Workflow (fmap (f *** fmapCheap (mapWorkflowCheap f)) x)