-- | Facilities for generating and otherwise handling pretty-based progress bars.
module Futhark.Util.ProgressBar
  ( progressBar,
    ProgressBar (..),
    progressSpinner,
  )
where

import Data.Text qualified as T

-- | Information about a progress bar to render.  The "progress space"
-- spans from 0 and up to the `progressBarBound`, but can be
-- visualised in any number of steps.
data ProgressBar = ProgressBar
  { -- | Number of steps in the visualisation.
    ProgressBar -> Int
progressBarSteps :: Int,
    -- | The logical upper bound.
    ProgressBar -> Double
progressBarBound :: Double,
    -- | The current position in the progress bar, relative to the
    -- upper bound.
    ProgressBar -> Double
progressBarElapsed :: Double
  }

-- | Render the progress bar.
progressBar :: ProgressBar -> T.Text
progressBar :: ProgressBar -> Text
progressBar (ProgressBar Int
steps Double
bound Double
elapsed) =
  Text
"|" forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
cell [Int
1 .. Int
steps]) forall a. Semigroup a => a -> a -> a
<> Text
"| "
  where
    step_size :: Double
    step_size :: Double
step_size = Double
bound forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
steps
    chars :: Text
chars = Text
" ▏▎▍▍▌▋▊▉█"
    num_chars :: Int
num_chars = Text -> Int
T.length Text
chars
    char :: Int -> Char
char Int
i
      | Int
i forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
i forall a. Ord a => a -> a -> Bool
< Int
num_chars = Text -> Int -> Char
T.index Text
chars Int
i
      | Bool
otherwise = Char
' '

    cell :: Int -> Char
    cell :: Int -> Char
cell Int
i
      | Double
i' forall a. Num a => a -> a -> a
* Double
step_size forall a. Ord a => a -> a -> Bool
<= Double
elapsed = Int -> Char
char Int
9
      | Bool
otherwise =
          Int -> Char
char (forall a b. (RealFrac a, Integral b) => a -> b
floor (((Double
elapsed forall a. Num a => a -> a -> a
- (Double
i' forall a. Num a => a -> a -> a
- Double
1) forall a. Num a => a -> a -> a
* Double
step_size) forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
num_chars) forall a. Fractional a => a -> a -> a
/ Double
step_size))
      where
        i' :: Double
i' = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i

-- | Render a spinner - a kind of progress bar where there is no upper
-- bound because we don't know how long it'll take.  You certainly
-- know these from THE INTERNET.  The non-negative integer is how many
-- "steps" have been taken.  The spinner looks best if this is
-- incremented by one for every call.
progressSpinner :: Int -> T.Text
progressSpinner :: Int -> Text
progressSpinner Int
spin_idx =
  Char -> Text
T.singleton forall a b. (a -> b) -> a -> b
$ Text -> Int -> Char
T.index Text
spin_load (Int
spin_idx forall a. Integral a => a -> a -> a
`rem` Int
n)
  where
    spin_load :: Text
spin_load = Text
"⠋⠙⠹⠸⠼⠴⠦⠧⠇⠏"
    n :: Int
n = Text -> Int
T.length Text
spin_load