Skip to content
Newer
Older
100644 62 lines (54 sloc) 1.8 KB
cd6361f @dcoutts Add pure Progress type
dcoutts authored
1 -----------------------------------------------------------------------------
2 -- |
3 -- Module : Progress
4 -- Copyright : (c) Duncan Coutts 2008
5 -- License : BSD-like
6 --
7 -- Portability : portable
8 --
9 -- Common types for dependency resolution.
10 -----------------------------------------------------------------------------
11 module Progress (
12 Progress(..),
13 fold, unfold, fromList,
14 ) where
15
16 import Prelude hiding (fail)
17
18 -- | A type to represent the unfolding of an expensive long running
19 -- calculation that may fail. We may get intermediate steps before the final
20 -- retult which may be used to indicate progress and\/or logging messages.
21 --
22 data Progress step fail done = Step step (Progress step fail done)
23 | Fail fail
24 | Done done
25
6f51b5f @kolmodin fix typo
kolmodin authored
26 -- | Consume a 'Progress' calculation. Much like 'foldr' for lists but with
cd6361f @dcoutts Add pure Progress type
dcoutts authored
27 -- two base cases, one for a final result and one for failure.
28 --
29 -- Eg to convert into a simple 'Either' result use:
30 --
31 -- > foldProgress (flip const) Left Right
32 --
33 fold :: (step -> a -> a) -> (fail -> a) -> (done -> a)
34 -> Progress step fail done -> a
35 fold step fail done = go
36 where
37 go (Step s p) = step s (go p)
38 go (Fail f) = fail f
39 go (Done r) = done r
40
41 unfold :: (s -> Either (Either fail done) (step, s))
42 -> s -> Progress step fail done
43 unfold f = go
44 where
45 go s = case f s of
46 Left (Left fail) -> Fail fail
47 Left (Right done) -> Done done
48 Right (step, s') -> Step step (go s')
49
50 fromList :: [a] -> Progress () b [a]
51 fromList xs0 = unfold next xs0
52 where
53 next [] = Left (Right xs0)
7a763b7 Some small -Wall fixups
Ivan.Miljenovic@gmail.com authored
54 next (_:xs) = Right ((), xs)
cd6361f @dcoutts Add pure Progress type
dcoutts authored
55
56 instance Functor (Progress step fail) where
57 fmap f = fold Step Fail (Done . f)
58
59 instance Monad (Progress step fail) where
60 return a = Done a
61 p >>= f = fold Step Fail f p
Something went wrong with that request. Please try again.