    -- | Provide a Buck/Bazel style UI.
    module Development.Shake.Internal.CompactUI(
        compactUI
        ) where

    import Development.Shake.Internal.CmdOption
    import Development.Shake.Internal.Options
    import Development.Shake.Internal.Progress

    import System.Time.Extra
    import General.Extra
    import Control.Exception
    import General.Thread
    import General.EscCodes
    import Data.IORef.Extra
    import Control.Monad.Extra

    data S = S
        {S -> [String]
    sOutput :: [String] -- ^ Messages that haven't yet been printed, in reverse.
        ,S -> String
    sProgress :: String -- ^ Last progress message.
        ,S -> [Maybe (String, String, Seconds)]
    sTraces :: [Maybe (String, String, Seconds)] -- ^ the traced items, in the order we display them
        ,S -> Int
    sUnwind :: Int -- ^ Number of lines we used last time around
        }

    emptyS :: S
    emptyS = [String] -> String -> [Maybe (String, String, Seconds)] -> Int -> S
    S [] String
    "Starting..." [] Int
    0

    addOutput :: p -> String -> S -> S
    addOutput p
    pri String
    msg S
    s = S
    s{sOutput = msg : sOutput s}
    addProgress :: String -> S -> S
    addProgress String
    x S
    s = S
    s{sProgress = x}

    addTrace :: String -> String -> Bool -> Seconds -> S -> S
    addTrace String
    key String
    msg Bool
    start Seconds
    time S
    s
        | Bool
    start = S
    s{sTraces = insert (key,msg,time) $ sTraces s}
        | Bool
    otherwise = S
    s{sTraces = remove (\(String
    a,String
    b,Seconds
    _) -> String
    a String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    key Bool -> Bool -> Bool
    && String
    b String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    msg) $ sTraces s}
        where
            insert :: t -> [Maybe t] -> [Maybe t]
    insert t
    v (Maybe t
    Nothing:[Maybe t]
    xs) = t -> Maybe t
    forall a. a -> Maybe a
    Just t
    vMaybe t -> [Maybe t] -> [Maybe t]
    forall a. a -> [a] -> [a]
    :[Maybe t]
    xs
            insert t
    v (Maybe t
    x:[Maybe t]
    xs) = Maybe t
    x Maybe t -> [Maybe t] -> [Maybe t]
    forall a. a -> [a] -> [a]
    : t -> [Maybe t] -> [Maybe t]
    insert t
    v [Maybe t]
    xs
            insert t
    v [] = [t -> Maybe t
    forall a. a -> Maybe a
    Just t
    v]

            remove :: (a -> Bool) -> [Maybe a] -> [Maybe a]
    remove a -> Bool
    f (Just a
    x:[Maybe a]
    xs) | a -> Bool
    f a
    x = Maybe a
    forall a. Maybe a
    NothingMaybe a -> [Maybe a] -> [Maybe a]
    forall a. a -> [a] -> [a]
    :[Maybe a]
    xs
            remove a -> Bool
    f (Maybe a
    x:[Maybe a]
    xs) = Maybe a
    x Maybe a -> [Maybe a] -> [Maybe a]
    forall a. a -> [a] -> [a]
    : (a -> Bool) -> [Maybe a] -> [Maybe a]
    remove a -> Bool
    f [Maybe a]
    xs
            remove a -> Bool
    f [] = []

    display :: Seconds -> S -> (S, String)
    display :: Seconds -> S -> (S, String)
    display Seconds
    time S
    s = (S
    s{sOutput=[], sUnwind=length post}, Int -> String
    escCursorUp (S -> Int
    sUnwind S
    s) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [String] -> String
    unlines ((String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> String
    pad ([String] -> [String]) -> [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ [String]
    pre [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String]
    post))
        where
            pre :: [String]
    pre = S -> [String]
    sOutput S
    s
            post :: [String]
    post = String
    "" String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : (Color -> String
    escForeground Color
    Green String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "Status: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ S -> String
    sProgress S
    s String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    escNormal) String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : (Maybe (String, String, Seconds) -> String)
    -> [Maybe (String, String, Seconds)] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map Maybe (String, String, Seconds) -> String
    f (S -> [Maybe (String, String, Seconds)]
    sTraces S
    s)

            pad :: String -> String
    pad String
    x = String
    x String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    escClearLine
            f :: Maybe (String, String, Seconds) -> String
    f Maybe (String, String, Seconds)
    Nothing = String
    " *"
            f (Just (String
    k,String
    m,Seconds
    t)) = String
    " * " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    k String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " (" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Seconds -> String -> String
    g (Seconds
    time Seconds -> Seconds -> Seconds
    forall a. Num a => a -> a -> a
    - Seconds
    t) String
    m String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ")"

            g :: Seconds -> String -> String
    g Seconds
    i String
    m | Seconds -> String
    showDurationSecs Seconds
    i String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "0s" = String
    m
                  | Seconds
    i Seconds -> Seconds -> Bool
    forall a. Ord a => a -> a -> Bool
    < Seconds
    10 = String
    s
                  | Bool
    otherwise = Color -> String
    escForeground (if Seconds
    i Seconds -> Seconds -> Bool
    forall a. Ord a => a -> a -> Bool
    > Seconds
    20 then Color
    Red else Color
    Yellow) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    s String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    escNormal
                where s :: String
    s = String
    m String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Seconds -> String
    showDurationSecs Seconds
    i

    -- | Run a compact UI, with the ShakeOptions modifier, combined with
    compactUI :: ShakeOptions -> IO (ShakeOptions, IO ())
    compactUI :: ShakeOptions -> IO (ShakeOptions, IO ())
    compactUI ShakeOptions
    opts = do
        IO Bool -> IO () -> IO ()
    forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
    unlessM IO Bool
    checkEscCodes (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
            String -> IO ()
    putStrLn String
    "Your terminal does not appear to support escape codes, --compact mode may not work"
        ref <- S -> IO (IORef S)
    forall a. a -> IO (IORef a)
    newIORef S
    emptyS
        let tweak = IORef S -> (S -> S) -> IO ()
    forall a. IORef a -> (a -> a) -> IO ()
    atomicModifyIORef_ IORef S
    ref
        time <- offsetTime
        opts <- pure $ opts
            {shakeTrace = \String
    a String
    b Bool
    c -> do t <- IO Seconds
    time; tweak (addTrace a b c t)
            ,shakeOutput = \Verbosity
    a String
    b -> (S -> S) -> IO ()
    tweak (Verbosity -> String -> S -> S
    forall {p}. p -> String -> S -> S
    addOutput Verbosity
    a String
    b)
            ,shakeProgress = \IO Progress
    x -> IO ((), ()) -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO ((), ()) -> IO ()) -> IO ((), ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Seconds -> (String -> IO ()) -> IO Progress -> IO ()
    progressDisplay Seconds
    1 ((S -> S) -> IO ()
    tweak ((S -> S) -> IO ()) -> (String -> S -> S) -> String -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> S -> S
    addProgress) IO Progress
    x IO () -> IO () -> IO ((), ())
    forall a b. IO a -> IO b -> IO (a, b)
    `withThreadsBoth` ShakeOptions -> IO Progress -> IO ()
    shakeProgress ShakeOptions
    opts IO Progress
    x
            ,shakeCommandOptions = [EchoStdout False, EchoStderr False] ++ shakeCommandOptions opts
            ,shakeVerbosity = Error
            }
        let tick = do t <- IO Seconds
    time; mask_ $ putStr =<< atomicModifyIORef ref (display t)
        pure (opts, forever (tick >> sleep 0.4) `finally` tick)