-
Notifications
You must be signed in to change notification settings - Fork 21
/
Progress.hs
62 lines (55 loc) · 1.84 KB
/
Progress.hs
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
-----------------------------------------------------------------------------
-- |
-- Module : Progress
-- Copyright : (c) Duncan Coutts 2008
-- License : BSD-like
--
-- Maintainer : duncan@haskell.org
-- Portability : portable
--
-- Common types for dependency resolution.
-----------------------------------------------------------------------------
module Progress (
Progress(..),
fold, unfold, fromList,
) where
import Prelude hiding (fail)
-- | A type to represent the unfolding of an expensive long running
-- calculation that may fail. We may get intermediate steps before the final
-- retult which may be used to indicate progress and\/or logging messages.
--
data Progress step fail done = Step step (Progress step fail done)
| Fail fail
| Done done
-- | Consume a 'Progress' calculation. Much like 'foldr' for lists but with
-- two base cases, one for a final result and one for failure.
--
-- Eg to convert into a simple 'Either' result use:
--
-- > foldProgress (flip const) Left Right
--
fold :: (step -> a -> a) -> (fail -> a) -> (done -> a)
-> Progress step fail done -> a
fold step fail done = go
where
go (Step s p) = step s (go p)
go (Fail f) = fail f
go (Done r) = done r
unfold :: (s -> Either (Either fail done) (step, s))
-> s -> Progress step fail done
unfold f = go
where
go s = case f s of
Left (Left fail) -> Fail fail
Left (Right done) -> Done done
Right (step, s') -> Step step (go s')
fromList :: [a] -> Progress () b [a]
fromList xs0 = unfold next xs0
where
next [] = Left (Right xs0)
next (_:xs) = Right ((), xs)
instance Functor (Progress step fail) where
fmap f = fold Step Fail (Done . f)
instance Monad (Progress step fail) where
return a = Done a
p >>= f = fold Step Fail f p