module Darcs.Patch.Progress
( progressRL
, progressFL
, progressRLShowTags
) where
import System.IO.Unsafe ( unsafePerformIO )
import Darcs.Patch.Info ( justName, isTag )
import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, info )
import Darcs.Patch.Witnesses.Ordered ( FL(..), RL(..), lengthRL, lengthFL )
import Darcs.Util.Progress ( minlist, beginTedious, endTedious, progress,
progressKeepLatest, tediousSize, finishedOne )
startProgress :: a -> String -> Int -> a
startProgress x k len = unsafePerformIO $ do beginTedious k
tediousSize k len
return x
progressFL :: String -> FL a wX wY -> FL a wX wY
progressFL _ NilFL = NilFL
progressFL k xxs@(x :>: xs) = if xxsLen < minlist
then xxs
else startProgress x k xxsLen :>: pl xs
where
xxsLen = lengthFL xxs
pl :: FL a wX wY -> FL a wX wY
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 wX wY -> RL a wX wY
progressRL _ NilRL = NilRL
progressRL k xxs@(x :<: xs) =
if xxsLen < minlist
then xxs
else startProgress x k xxsLen :<: pl xs
where
xxsLen = lengthRL xxs
pl :: RL a wX wY -> RL a wX wY
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) wX wY
-> RL (PatchInfoAnd p) wX wY
progressRLShowTags _ NilRL = NilRL
progressRLShowTags k xxs@(x :<: xs) =
if xxsLen < minlist
then xxs
else startProgress x k xxsLen :<: pl xs
where
xxsLen = lengthRL xxs
pl :: RL (PatchInfoAnd p) wX wY -> RL (PatchInfoAnd p) wX wY
pl NilRL = NilRL
pl (y :<: NilRL) = unsafePerformIO $ do endTedious k
return (y :<: NilRL)
pl (y :<: ys) =
if isTag iy
then finishedOne k ("back to "++ justName iy) y :<: pl ys
else progressKeepLatest k y :<: pl ys
where
iy = info y