1 {-# LANGUAGE CPP #-}
    2 
    3 #include "gadts.h"
    4 module Darcs.ProgressPatches (progressRL, progressFL, progressRLShowTags)
    5 where
    6 import Darcs.Ordered ( FL(..), RL(..), lengthRL, lengthFL )
    7 import Darcs.Hopefully (PatchInfoAnd,info)
    8 import System.IO.Unsafe ( unsafePerformIO )
    9 import Progress (minlist, beginTedious,
   10                  endTedious, progress, progressKeepLatest,
   11                  tediousSize, finishedOne)
   12 import Darcs.Patch.Info (just_name, is_tag)
   13 
   14 
   15 -- | Evaluate an 'FL' list and report progress.
   16 progressFL :: String -> FL a C(x y) -> FL a C(x y)
   17 progressFL _ NilFL = NilFL
   18 progressFL k (x:>:xs) = if l < minlist then x:>:xs
   19                                        else startit x :>: pl xs
   20     where l = lengthFL (x:>:xs)
   21           startit y = unsafePerformIO $ do beginTedious k
   22                                            tediousSize k l
   23                                            return y
   24           pl :: FL a C(x y) -> FL a C(x y)
   25           pl NilFL = NilFL
   26           pl (y:>:NilFL) = unsafePerformIO $ do endTedious k
   27                                                 return (y:>:NilFL)
   28           pl (y:>:ys) = progress k y :>: pl ys
   29 
   30 -- | Evaluate an 'RL' list and report progress.
   31 progressRL :: String -> RL a C(x y) -> RL a C(x y)
   32 progressRL _ NilRL = NilRL
   33 progressRL k (x:<:xs) = if l < minlist then x:<:xs
   34                                        else startit x :<: pl xs
   35     where l = lengthRL (x:<:xs)
   36           startit y = unsafePerformIO $ do beginTedious k
   37                                            tediousSize k l
   38                                            return y
   39           pl :: RL a C(x y) -> RL a C(x y)
   40           pl NilRL = NilRL
   41           pl (y:<:NilRL) = unsafePerformIO $ do endTedious k
   42                                                 return (y:<:NilRL)
   43           pl (y:<:ys) = progress k y :<: pl ys
   44 
   45 -- | Evaluate an 'RL' list and report progress. In addition to printing
   46 -- the number of patches we got, show the name of the last tag we got.
   47 progressRLShowTags :: String -> RL (PatchInfoAnd p) C(x y)
   48                    -> RL (PatchInfoAnd p) C(x y)
   49 progressRLShowTags _ NilRL = NilRL
   50 progressRLShowTags k (x:<:xs) = if l < minlist then x:<:xs
   51                                        else startit x :<: pl xs
   52     where l = lengthRL (x:<:xs)
   53           startit y = unsafePerformIO $ do beginTedious k
   54                                            tediousSize k l
   55                                            return y
   56           pl :: RL (PatchInfoAnd p) C(x y) -> RL (PatchInfoAnd p) C(x y)
   57           pl NilRL = NilRL
   58           pl (y:<:NilRL) = unsafePerformIO $ do endTedious k
   59                                                 return (y:<:NilRL)
   60           pl (y:<:ys) =
   61               if is_tag iy 
   62               then finishedOne k ("back to "++ just_name iy) y :<: pl ys
   63               else progressKeepLatest k y :<: pl ys
   64                   where
   65                     iy = info y