#include "gadts.h"
module Darcs.ProgressPatches (progressRL, progressFL, progressRLShowTags)
where
import Darcs.Witnesses.Ordered ( FL(..), RL(..), lengthRL, lengthFL )
import Darcs.Hopefully (PatchInfoAnd,info)
import System.IO.Unsafe ( unsafePerformIO )
import Progress (minlist, beginTedious,
endTedious, progress, progressKeepLatest,
tediousSize, finishedOne)
import Darcs.Patch.Info (just_name, is_tag)
progressFL :: String -> FL a C(x y) -> FL a C(x y)
progressFL _ NilFL = NilFL
progressFL k (x:>:xs) = if l < minlist then x:>:xs
else startit x :>: pl xs
where l = lengthFL (x:>:xs)
startit y = unsafePerformIO $ do beginTedious k
tediousSize k l
return y
pl :: FL a C(x y) -> FL a C(x y)
pl NilFL = NilFL
pl (y:>:NilFL) = unsafePerformIO $ do endTedious k
return (y:>:NilFL)
pl (y:>:ys) = progress k y :>: pl ys
progressRL :: String -> RL a C(x y) -> RL a C(x y)
progressRL _ NilRL = NilRL
progressRL k (x:<:xs) = if l < minlist then x:<:xs
else startit x :<: pl xs
where l = lengthRL (x:<:xs)
startit y = unsafePerformIO $ do beginTedious k
tediousSize k l
return y
pl :: RL a C(x y) -> RL a C(x y)
pl NilRL = NilRL
pl (y:<:NilRL) = unsafePerformIO $ do endTedious k
return (y:<:NilRL)
pl (y:<:ys) = progress k y :<: pl ys
progressRLShowTags :: String -> RL (PatchInfoAnd p) C(x y)
-> RL (PatchInfoAnd p) C(x y)
progressRLShowTags _ NilRL = NilRL
progressRLShowTags k (x:<:xs) = if l < minlist then x:<:xs
else startit x :<: pl xs
where l = lengthRL (x:<:xs)
startit y = unsafePerformIO $ do beginTedious k
tediousSize k l
return y
pl :: RL (PatchInfoAnd p) C(x y) -> RL (PatchInfoAnd p) C(x y)
pl NilRL = NilRL
pl (y:<:NilRL) = unsafePerformIO $ do endTedious k
return (y:<:NilRL)
pl (y:<:ys) =
if is_tag iy
then finishedOne k ("back to "++ just_name iy) y :<: pl ys
else progressKeepLatest k y :<: pl ys
where
iy = info y