Permalink
Browse files

Add pure Progress type

handy for pure computations that take a long time
  • Loading branch information...
1 parent 54d11c6 commit cd6361fa1b0a1ece48f27a4f083eb87679fc6694 @dcoutts dcoutts committed Sep 2, 2008
Showing with 62 additions and 0 deletions.
  1. +62 −0 Progress.hs
View
@@ -0,0 +1,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 'Progres' 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 (x: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

0 comments on commit cd6361f

Please sign in to comment.