-- | Progress Bar API
module Language.Fixpoint.Utils.Progress (
      withProgress
    , progressInit
    , progressTick
    , progressClose
    ) where

import           Control.Monad                    (when)
import           System.IO.Unsafe                 (unsafePerformIO)
import           System.Console.CmdArgs.Verbosity (isNormal, getVerbosity, Verbosity(..))
import           Data.IORef
import           System.Console.AsciiProgress
-- import           Language.Fixpoint.Misc (traceShow)

{-# NOINLINE pbRef #-}
pbRef :: IORef (Maybe ProgressBar)
pbRef :: IORef (Maybe ProgressBar)
pbRef = forall a. IO a -> a
unsafePerformIO (forall a. a -> IO (IORef a)
newIORef forall a. Maybe a
Nothing)

withProgress :: Int -> IO a -> IO a
withProgress :: forall a. Int -> IO a -> IO a
withProgress Int
n IO a
act = do
  Bool
showBar <- (Verbosity
Quiet forall a. Eq a => a -> a -> Bool
/=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Verbosity
getVerbosity
  if Bool
showBar
    then forall (m :: * -> *) a. (MonadIO m, MonadMask m) => m a -> m a
displayConsoleRegions forall a b. (a -> b) -> a -> b
$ do
      -- putStrLn $ "withProgress: " ++ show n
      Int -> IO ()
progressInit Int
n
      a
r <- IO a
act
      IO ()
progressClose
      forall (m :: * -> *) a. Monad m => a -> m a
return a
r
    else IO a
act

progressInit :: Int -> IO ()
progressInit :: Int -> IO ()
progressInit Int
n = do
  Bool
normal <- IO Bool
isNormal
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
normal forall a b. (a -> b) -> a -> b
$ do
    ProgressBar
pr <- Int -> IO ProgressBar
mkPB Int
n
    forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe ProgressBar)
pbRef (forall a. a -> Maybe a
Just ProgressBar
pr)

mkPB   :: Int -> IO ProgressBar
mkPB :: Int -> IO ProgressBar
mkPB Int
n = Options -> IO ProgressBar
newProgressBar forall a. Default a => a
def
  { pgWidth :: Int
pgWidth       = Int
80
  , pgTotal :: Integer
pgTotal       = {- traceShow "MAKE-PROGRESS" -} forall a. Integral a => a -> Integer
toInteger Int
n
  , pgFormat :: String
pgFormat      = String
"Working :percent [:bar]"
  , pgPendingChar :: Char
pgPendingChar = Char
'.'
  , pgOnCompletion :: Maybe String
pgOnCompletion = forall a. Maybe a
Nothing
  }

progressTick :: IO ()
progressTick :: IO ()
progressTick    = Maybe ProgressBar -> IO ()
go forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. IORef a -> IO a
readIORef IORef (Maybe ProgressBar)
pbRef
  where
   go :: Maybe ProgressBar -> IO ()
go (Just ProgressBar
pr) = ProgressBar -> IO ()
incTick ProgressBar
pr
   go Maybe ProgressBar
_         = forall (m :: * -> *) a. Monad m => a -> m a
return ()

incTick :: ProgressBar -> IO ()
incTick :: ProgressBar -> IO ()
incTick ProgressBar
pb = do
  Stats
st <- ProgressBar -> IO Stats
getProgressStats ProgressBar
pb
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Stats -> Bool
incomplete Stats
st) (ProgressBar -> IO ()
tick ProgressBar
pb)
    -- then tick pb -- putStrLn (show (stPercent st, stTotal st, stCompleted st)) >> (tick pb)
    -- else return ()

incomplete :: Stats -> Bool
incomplete :: Stats -> Bool
incomplete Stats
st = {- traceShow "INCOMPLETE" -} Stats -> Integer
stRemaining Stats
st forall a. Ord a => a -> a -> Bool
> Integer
0
-- incomplete st = stPercent st < 100


progressClose :: IO ()
progressClose :: IO ()
progressClose = Maybe ProgressBar -> IO ()
go forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. IORef a -> IO a
readIORef IORef (Maybe ProgressBar)
pbRef
  where
    go :: Maybe ProgressBar -> IO ()
go (Just ProgressBar
p) = ProgressBar -> IO ()
complete ProgressBar
p
    go Maybe ProgressBar
_        = forall (m :: * -> *) a. Monad m => a -> m a
return ()