blob: ec121baa0ca1e3fe262817bc9c42c36abf029ff7 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
|
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeSynonymInstances #-}
-- | Defines a class for types which can be used as workflows.
--
-- In general, you should not need this functionality unless you are defining
-- your own flow types (perhaps to use a state transformer or similar), in
-- which case this allows you to work using the standard combinators in
-- Funflow and then define the mapping to 'Base.Flow'
--
-- For an example of use, see the module @Control.Funflow.Checkpoints@, which
-- defines a checkpointed flow.
module Control.Funflow.Class where
import Control.Arrow
import Control.Arrow.AppArrow
import Control.Arrow.Free
import qualified Control.Funflow.Base as Base
import Control.Funflow.ContentHashable
import qualified Control.Funflow.ContentStore as CS
import Control.Funflow.External
import Data.Default (def)
import Path
class (Arrow arr, ArrowError ex arr) => ArrowFlow eff ex arr | arr -> eff ex where
-- | Create a flow from a pure function.
step' :: Base.Properties a b -> (a -> b) -> arr a b
-- | Create a flow from an IO action.
stepIO' :: Base.Properties a b -> (a -> IO b) -> arr a b
-- | Create an external task in the flow.
external :: (a -> ExternalTask) -> arr a CS.Item
-- | Create an external task with additional properties
external' :: Base.ExternalProperties a -> (a -> ExternalTask) -> arr a CS.Item
-- | Create a flow from a user-defined effect.
wrap' :: Base.Properties a b -> eff a b -> arr a b
-- | Create a flow which will write its incoming data to the store.
putInStore :: ContentHashable IO a => (Path Abs Dir -> a -> IO ()) -> arr a CS.Item
-- | Create a flow which will read data from the given store item.
getFromStore :: (Path Abs t -> IO a) -> arr (CS.Content t) a
-- | Perform some internal manipulation of the content store.
internalManipulateStore :: (CS.ContentStore -> a -> IO b) -> arr a b
instance ArrowFlow eff ex (Base.Flow eff ex) where
step' props = effect . Base.Step props
stepIO' props = effect . Base.StepIO props
external = effect . Base.External def
external' p td = effect $ Base.External p td
wrap' p eff = effect $ Base.Wrapped p eff
putInStore = effect . Base.PutInStore
getFromStore = effect . Base.GetFromStore
internalManipulateStore = effect . Base.InternalManipulateStore
-- | Create a flow from a pure function.
-- This is a variant on 'step'' which uses the default properties.
step :: ArrowFlow eff ex arr => (a -> b) -> arr a b
step = step' def
-- | Create a flow from an IO action.
-- This is a variant on 'stepIO'' which uses the default properties.
stepIO :: ArrowFlow eff ex arr => (a -> IO b) -> arr a b
stepIO = stepIO' def
wrap :: ArrowFlow eff ex arr => eff a b -> arr a b
wrap = wrap' def
instance ( Applicative app
, ArrowError ex (AppArrow app (arr eff ex))
, ArrowFlow eff ex (arr eff ex) )
=> ArrowFlow eff ex (AppArrow app (arr eff ex)) where
step' props f = appArrow $ step' props f
stepIO' props f = appArrow $ stepIO' props f
external f = appArrow $ external f
external' props f = appArrow $ external' props f
wrap' props eff = appArrow $ wrap' props eff
putInStore f = appArrow $ putInStore f
getFromStore f = appArrow $ getFromStore f
internalManipulateStore f = appArrow $ internalManipulateStore f
|
