src/Reflex/Workflow.hs · patch

on bd3f014 help sign in

patch/src/Reflex/Workflow.hs

37 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.Network

17import Reflex.NotReady.Class

18import Reflex.PostBuild.Class

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

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

23workflow w0 = do

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

25 return $ fmap fst eResult

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

28workflowView w0 = do

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

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

31 return $ fmap fst eResult

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

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

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

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