-- | 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 = IO (IORef (Maybe ProgressBar)) -> IORef (Maybe ProgressBar)
forall a. IO a -> a
unsafePerformIO (Maybe ProgressBar -> IO (IORef (Maybe ProgressBar))
forall a. a -> IO (IORef a)
newIORef Maybe ProgressBar
forall a. Maybe a
Nothing)

withProgress :: Int -> IO a -> IO a
withProgress :: Int -> IO a -> IO a
withProgress Int
n IO a
act = do
  Bool
showBar <- (Verbosity -> Verbosity -> Bool
forall a. Eq a => a -> a -> Bool
(/=) Verbosity
Quiet) (Verbosity -> Bool) -> IO Verbosity -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Verbosity
getVerbosity
  case Bool
showBar of
    Bool
False -> IO a
act
    Bool
True  -> IO a -> IO a
forall (m :: * -> *) a. (MonadIO m, MonadMask m) => m a -> m a
displayConsoleRegions (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ do
      -- putStrLn $ "withProgress: " ++ show n
      Int -> IO ()
progressInit Int
n
      a
r <- IO a
act
      IO ()
progressClose
      a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r
  
progressInit :: Int -> IO ()
progressInit :: Int -> IO ()
progressInit Int
n = do
  Bool
normal <- IO Bool
isNormal 
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
normal (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    ProgressBar
pr <- Int -> IO ProgressBar
mkPB Int
n
    IORef (Maybe ProgressBar) -> Maybe ProgressBar -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe ProgressBar)
pbRef (ProgressBar -> Maybe ProgressBar
forall a. a -> Maybe a
Just ProgressBar
pr)

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

progressTick :: IO ()
progressTick :: IO ()
progressTick    = Maybe ProgressBar -> IO ()
go (Maybe ProgressBar -> IO ()) -> IO (Maybe ProgressBar) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef (Maybe ProgressBar) -> IO (Maybe ProgressBar)
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
_         = () -> IO ()
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 
  Bool -> IO () -> IO ()
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) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 
-- incomplete st = stPercent st < 100


progressClose :: IO ()
progressClose :: IO ()
progressClose = Maybe ProgressBar -> IO ()
go (Maybe ProgressBar -> IO ()) -> IO (Maybe ProgressBar) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef (Maybe ProgressBar) -> IO (Maybe ProgressBar)
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
_        = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()