module Darcs.Patch.Progress
    ( progressRL
    , progressFL
    , progressRLShowTags
    ) where

import Darcs.Prelude

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 :: a -> String -> Int -> a
startProgress a
x String
k Int
len = IO a -> a
forall a. IO a -> a
unsafePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ do String -> IO ()
beginTedious String
k
                                             String -> Int -> IO ()
tediousSize String
k Int
len
                                             a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x

-- | Evaluate an 'FL' list and report progress.
progressFL :: String -> FL a wX wY -> FL a wX wY
progressFL :: String -> FL a wX wY -> FL a wX wY
progressFL String
_ FL a wX wY
NilFL = FL a wX wY
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
progressFL String
k xxs :: FL a wX wY
xxs@(a wX wY
x :>: FL a wY wY
xs) = if Int
xxsLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
minlist
                                  then FL a wX wY
xxs
                                  else a wX wY -> String -> Int -> a wX wY
forall a. a -> String -> Int -> a
startProgress a wX wY
x String
k Int
xxsLen a wX wY -> FL a wY wY -> FL a wX wY
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL a wY wY -> FL a wY wY
forall (a :: * -> * -> *) wX wY. FL a wX wY -> FL a wX wY
pl FL a wY wY
xs
  where
    xxsLen :: Int
xxsLen = FL a wX wY -> Int
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> Int
lengthFL FL a wX wY
xxs

    pl :: FL a wX wY -> FL a wX wY
    pl :: FL a wX wY -> FL a wX wY
pl FL a wX wY
NilFL = FL a wX wY
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
    pl (a wX wY
y :>: FL a wY wY
NilFL) = IO (FL a wX wY) -> FL a wX wY
forall a. IO a -> a
unsafePerformIO (IO (FL a wX wY) -> FL a wX wY) -> IO (FL a wX wY) -> FL a wX wY
forall a b. (a -> b) -> a -> b
$ do String -> IO ()
endTedious String
k
                                            FL a wX wY -> IO (FL a wX wY)
forall (m :: * -> *) a. Monad m => a -> m a
return (a wX wY
y a wX wY -> FL a wY wY -> FL a wX wY
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL a wY wY
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL)
    pl (a wX wY
y :>: FL a wY wY
ys) = String -> a wX wY -> a wX wY
forall a. String -> a -> a
progress String
k a wX wY
y a wX wY -> FL a wY wY -> FL a wX wY
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL a wY wY -> FL a wY wY
forall (a :: * -> * -> *) wX wY. FL a wX wY -> FL a wX wY
pl FL a wY wY
ys

-- | Evaluate an 'RL' list and report progress.
progressRL :: String -> RL a wX wY -> RL a wX wY
progressRL :: String -> RL a wX wY -> RL a wX wY
progressRL String
_ RL a wX wY
NilRL = RL a wX wY
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL
progressRL String
k xxs :: RL a wX wY
xxs@(RL a wX wY
xs :<: a wY wY
x) =
    if Int
xxsLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
minlist
        then RL a wX wY
xxs
        else RL a wX wY -> RL a wX wY
forall (a :: * -> * -> *) wX wY. RL a wX wY -> RL a wX wY
pl RL a wX wY
xs RL a wX wY -> a wY wY -> RL a wX wY
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: a wY wY -> String -> Int -> a wY wY
forall a. a -> String -> Int -> a
startProgress a wY wY
x String
k Int
xxsLen
  where
    xxsLen :: Int
xxsLen = RL a wX wY -> Int
forall (a :: * -> * -> *) wX wZ. RL a wX wZ -> Int
lengthRL RL a wX wY
xxs
    pl :: RL a wX wY -> RL a wX wY
    pl :: RL a wX wY -> RL a wX wY
pl RL a wX wY
NilRL = RL a wX wY
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL
    pl (RL a wX wY
NilRL:<:a wY wY
y) = IO (RL a wY wY) -> RL a wY wY
forall a. IO a -> a
unsafePerformIO (IO (RL a wY wY) -> RL a wY wY) -> IO (RL a wY wY) -> RL a wY wY
forall a b. (a -> b) -> a -> b
$ do String -> IO ()
endTedious String
k
                                          RL a wY wY -> IO (RL a wY wY)
forall (m :: * -> *) a. Monad m => a -> m a
return (RL a wY wY
forall (a :: * -> * -> *) wX. RL a wX wX
NilRLRL a wY wY -> a wY wY -> RL a wY wY
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<:a wY wY
y)
    pl (RL a wX wY
ys:<:a wY wY
y) = RL a wX wY -> RL a wX wY
forall (a :: * -> * -> *) wX wY. RL a wX wY -> RL a wX wY
pl RL a wX wY
ys RL a wX wY -> a wY wY -> RL a wX wY
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: String -> a wY wY -> a wY wY
forall a. String -> a -> a
progress String
k a wY wY
y

-- | Evaluate an 'RL' list and report progress. In addition to printing
-- the number of patches we got, show the name of the last tag we got.
progressRLShowTags :: String -> RL (PatchInfoAnd rt p) wX wY
                   -> RL (PatchInfoAnd rt p) wX wY
progressRLShowTags :: String
-> RL (PatchInfoAnd rt p) wX wY -> RL (PatchInfoAnd rt p) wX wY
progressRLShowTags String
_ RL (PatchInfoAnd rt p) wX wY
NilRL = RL (PatchInfoAnd rt p) wX wY
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL
progressRLShowTags String
k xxs :: RL (PatchInfoAnd rt p) wX wY
xxs@(RL (PatchInfoAnd rt p) wX wY
xs :<: PatchInfoAnd rt p wY wY
x) =
    if Int
xxsLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
minlist
        then RL (PatchInfoAnd rt p) wX wY
xxs
        else RL (PatchInfoAnd rt p) wX wY -> RL (PatchInfoAnd rt p) wX wY
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
RL (PatchInfoAnd rt p) wX wY -> RL (PatchInfoAnd rt p) wX wY
pl RL (PatchInfoAnd rt p) wX wY
xs RL (PatchInfoAnd rt p) wX wY
-> PatchInfoAnd rt p wY wY -> RL (PatchInfoAnd rt p) wX wY
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: PatchInfoAnd rt p wY wY -> String -> Int -> PatchInfoAnd rt p wY wY
forall a. a -> String -> Int -> a
startProgress PatchInfoAnd rt p wY wY
x String
k Int
xxsLen
  where
    xxsLen :: Int
xxsLen = RL (PatchInfoAnd rt p) wX wY -> Int
forall (a :: * -> * -> *) wX wZ. RL a wX wZ -> Int
lengthRL RL (PatchInfoAnd rt p) wX wY
xxs

    pl :: RL (PatchInfoAnd rt p) wX wY -> RL (PatchInfoAnd rt p) wX wY
    pl :: RL (PatchInfoAnd rt p) wX wY -> RL (PatchInfoAnd rt p) wX wY
pl RL (PatchInfoAnd rt p) wX wY
NilRL = RL (PatchInfoAnd rt p) wX wY
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL
    pl (RL (PatchInfoAnd rt p) wX wY
NilRL :<: PatchInfoAnd rt p wY wY
y) = IO (RL (PatchInfoAnd rt p) wY wY) -> RL (PatchInfoAnd rt p) wY wY
forall a. IO a -> a
unsafePerformIO (IO (RL (PatchInfoAnd rt p) wY wY) -> RL (PatchInfoAnd rt p) wY wY)
-> IO (RL (PatchInfoAnd rt p) wY wY)
-> RL (PatchInfoAnd rt p) wY wY
forall a b. (a -> b) -> a -> b
$ do String -> IO ()
endTedious String
k
                                            RL (PatchInfoAnd rt p) wY wY -> IO (RL (PatchInfoAnd rt p) wY wY)
forall (m :: * -> *) a. Monad m => a -> m a
return (RL (PatchInfoAnd rt p) wY wY
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL RL (PatchInfoAnd rt p) wY wY
-> PatchInfoAnd rt p wY wY -> RL (PatchInfoAnd rt p) wY wY
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: PatchInfoAnd rt p wY wY
y)
    pl (RL (PatchInfoAnd rt p) wX wY
ys :<: PatchInfoAnd rt p wY wY
y) =
        if PatchInfo -> Bool
isTag PatchInfo
iy
            then RL (PatchInfoAnd rt p) wX wY -> RL (PatchInfoAnd rt p) wX wY
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
RL (PatchInfoAnd rt p) wX wY -> RL (PatchInfoAnd rt p) wX wY
pl RL (PatchInfoAnd rt p) wX wY
ys RL (PatchInfoAnd rt p) wX wY
-> PatchInfoAnd rt p wY wY -> RL (PatchInfoAnd rt p) wX wY
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: String
-> String -> PatchInfoAnd rt p wY wY -> PatchInfoAnd rt p wY wY
forall a. String -> String -> a -> a
finishedOne String
k (String
"back to "String -> String -> String
forall a. [a] -> [a] -> [a]
++ PatchInfo -> String
justName PatchInfo
iy) PatchInfoAnd rt p wY wY
y
            else RL (PatchInfoAnd rt p) wX wY -> RL (PatchInfoAnd rt p) wX wY
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
RL (PatchInfoAnd rt p) wX wY -> RL (PatchInfoAnd rt p) wX wY
pl RL (PatchInfoAnd rt p) wX wY
ys RL (PatchInfoAnd rt p) wX wY
-> PatchInfoAnd rt p wY wY -> RL (PatchInfoAnd rt p) wX wY
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: String -> PatchInfoAnd rt p wY wY -> PatchInfoAnd rt p wY wY
forall a. String -> a -> a
progressKeepLatest String
k PatchInfoAnd rt p wY wY
y
      where
        iy :: PatchInfo
iy = PatchInfoAnd rt p wY wY -> PatchInfo
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> PatchInfo
info PatchInfoAnd rt p wY wY
y