-- Copyright 2014 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

-- | Display time elapsed between Timer log msgs.
module LogView.ShowTimers where
import Control.Monad
import qualified Data.Text as Text
import qualified Data.Time as Time
import qualified System.Environment as Environment
import qualified Text.Printf as Printf
import qualified Text.Read as Read

import qualified Util.CallStack as CallStack
import qualified Util.Log as Log
import qualified LogView.Tail as Tail


minimumDiff :: Double
minimumDiff :: Double
minimumDiff = Double
0.0

main :: IO ()
main :: IO ()
main = do
    [String]
args <- IO [String]
Environment.getArgs
    case [String]
args of
        [String
threshold, String
fn] | Just Double
threshold <- forall a. Read a => String -> Maybe a
Read.readMaybe String
threshold -> do
            Handle
hdl <- String -> Maybe Integer -> IO Handle
Tail.open String
fn forall a. Maybe a
Nothing
            Double -> Handle -> Maybe UTCTime -> IO ()
loop Double
threshold Handle
hdl forall a. Maybe a
Nothing
        [String]
_ -> forall a. HasCallStack => String -> a
error String
"usage: show_timers threshold filename"

loop :: Double -> Tail.Handle -> Maybe Time.UTCTime -> IO ()
loop :: Double -> Handle -> Maybe UTCTime -> IO ()
loop Double
threshold = forall {b}. Handle -> Maybe UTCTime -> IO b
go
    where
    go :: Handle -> Maybe UTCTime -> IO b
go Handle
hdl Maybe UTCTime
last_date = do
        (Msg
msg, Handle
hdl) <- Handle -> IO (Msg, Handle)
Tail.tail Handle
hdl
        case Msg -> Priority
Log.msg_priority Msg
msg of
            Priority
Log.Timer -> do
                let date :: UTCTime
date = Msg -> UTCTime
Log.msg_date Msg
msg
                let diff :: Double
diff = forall a b. (Real a, Fractional b) => a -> b
realToFrac forall a b. (a -> b) -> a -> b
$
                        forall b a. b -> (a -> b) -> Maybe a -> b
maybe NominalDiffTime
0 (UTCTime -> UTCTime -> NominalDiffTime
Time.diffUTCTime UTCTime
date) Maybe UTCTime
last_date
                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Double
diff forall a. Ord a => a -> a -> Bool
>= Double
minimumDiff) forall a b. (a -> b) -> a -> b
$ do
                    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Double
diff forall a. Ord a => a -> a -> Bool
>= Double
threshold) forall a b. (a -> b) -> a -> b
$
                        String -> IO ()
putStr String
vt100_red
                    forall r. PrintfType r => String -> r
Printf.printf String
"%.03f %s %s" Double
diff
                        (Text -> String
Text.unpack
                            (Caller -> Text
CallStack.showCaller (Msg -> Caller
Log.msg_caller Msg
msg)))
                        (Text -> String
Text.unpack (Msg -> Text
Log.msg_text Msg
msg))
                    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Double
diff forall a. Ord a => a -> a -> Bool
>= Double
threshold) forall a b. (a -> b) -> a -> b
$
                        String -> IO ()
putStr String
vt100_normal
                    Char -> IO ()
putChar Char
'\n'
                Handle -> Maybe UTCTime -> IO b
go Handle
hdl (forall a. a -> Maybe a
Just UTCTime
date)
            Priority
_ -> Handle -> Maybe UTCTime -> IO b
go Handle
hdl Maybe UTCTime
last_date

-- | These codes should probably come from termcap, but I can't be bothered.
vt100_red :: String
vt100_red :: String
vt100_red = String
"\ESC[31m"

vt100_normal :: String
vt100_normal :: String
vt100_normal = String
"\ESC[m\ESC[m"