src/Reflex/Workflow.hs · patch

on 4ce4f96 help sign in

patch/src/Reflex/Workflow.hs

38 lines 1.4 kB history raw

1{-# LANGUAGE RecursiveDo #-}

2{-# LANGUAGE ScopedTypeVariables #-}

3module Reflex.Workflow (

4 -- * Workflows

5 Workflow (..)

6 , workflow

7 , workflowView

8 , mapWorkflow

9 , mapWorkflowCheap

10 ) where

12import Control.Arrow ((***))

13import Control.Monad.Fix (MonadFix)

15import Reflex.Class

16import Reflex.Adjustable.Class

17import Reflex.Network

18import Reflex.NotReady.Class

19import Reflex.PostBuild.Class

21newtype Workflow t m a = Workflow { unWorkflow :: m (a, Event t (Workflow t m a)) }

23workflow :: forall t m a. (Reflex t, Adjustable t m, MonadFix m, MonadHold t m) => Workflow t m a -> m (Dynamic t a)

24workflow w0 = do

25 rec eResult <- networkHold (unWorkflow w0) $ fmap unWorkflow $ switch $ snd <$> current eResult

26 return $ fmap fst eResult

28workflowView :: 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)

29workflowView w0 = do

30 rec eResult <- networkView . fmap unWorkflow =<< holdDyn w0 eReplace

31 eReplace <- fmap switch $ hold never $ fmap snd eResult

32 return $ fmap fst eResult

34mapWorkflow :: (Reflex t, Functor m) => (a -> b) -> Workflow t m a -> Workflow t m b

35mapWorkflow f (Workflow x) = Workflow (fmap (f *** fmap (mapWorkflow f)) x)

37mapWorkflowCheap :: (Reflex t, Functor m) => (a -> b) -> Workflow t m a -> Workflow t m b

38mapWorkflowCheap f (Workflow x) = Workflow (fmap (f *** fmapCheap (mapWorkflowCheap f)) x)