Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

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