--------------------------------------------------------------------------------

module Codeforces.App.Watcher where

import           Codeforces.App.Format
import           Codeforces.App.Table
import           Codeforces.Error
import           Codeforces.Logging

import           Control.Concurrent
import           Control.Exception              ( bracket )
import           Control.Monad.Extra            ( forM_ )
import           Control.Monad.Trans.Class
import           Control.Monad.Trans.State

import           Data.Maybe                     ( catMaybes )
import qualified Data.Text                     as T
import qualified Data.Text.IO                  as T
import           Data.Time

import           System.Console.ANSI
import           System.IO

--------------------------------------------------------------------------------

-- | Values used for watching output.
data WatchState = WatchState
    { WatchState -> Table
wsTable      :: Table
    , WatchState -> Maybe UTCTime
wsUpdateTime :: Maybe UTCTime
    }

initWatchState :: WatchState
initWatchState :: WatchState
initWatchState = Table -> Maybe UTCTime -> WatchState
WatchState [] Maybe UTCTime
forall a. Maybe a
Nothing

--------------------------------------------------------------------------------

-- | 'handleWatch' @shouldWatch m@ runs computation @m@ once if @shouldWatch@ is
-- false, otherwise 'watchTable' watches it.
--
-- In the latter case, it clears the terminal and sets up terminal behaviour for
-- watching data.
--
handleWatch :: Bool -> IO (Either CodeforcesError Table) -> IO ()
handleWatch :: Bool -> IO (Either CodeforcesError Table) -> IO ()
handleWatch Bool
False IO (Either CodeforcesError Table)
m =
    IO (Either CodeforcesError Table)
m IO (Either CodeforcesError Table)
-> (Either CodeforcesError Table -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CodeforcesError -> IO ())
-> (Table -> IO ()) -> Either CodeforcesError Table -> IO ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> IO ()
putStrLn (String -> IO ())
-> (CodeforcesError -> String) -> CodeforcesError -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorLog -> String
elErrorMsg (ErrorLog -> String)
-> (CodeforcesError -> ErrorLog) -> CodeforcesError -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeforcesError -> ErrorLog
showE) ((Text -> IO ()) -> Table -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Text -> IO ()
T.putStrLn)
handleWatch Bool
True IO (Either CodeforcesError Table)
m = IO () -> IO ()
forall a. IO a -> IO a
withDisabledStdin (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    IO ()
resetScreen
    StateT WatchState IO () -> WatchState -> IO ()
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (Int -> IO (Either CodeforcesError Table) -> StateT WatchState IO ()
watchTable Int
2 IO (Either CodeforcesError Table)
m) WatchState
initWatchState

-- | 'watchTable' @delaySecs m@ runs computation @m@ every @delaySecs@ amount of
-- seconds. The terminal output from @m@ is changed if the next run of @m@
-- yields a different result.
watchTable
    :: Int                                  -- ^ Delay, in seconds.
    -> IO (Either CodeforcesError Table)    -- ^ Fetches an updated table.
    -> StateT WatchState IO ()              -- ^ Data from previous iteration.
watchTable :: Int -> IO (Either CodeforcesError Table) -> StateT WatchState IO ()
watchTable Int
delaySecs IO (Either CodeforcesError Table)
m = do
    WatchState
oldState <- StateT WatchState IO WatchState
forall (m :: * -> *) s. Monad m => StateT s m s
get
    UTCTime
now      <- IO UTCTime -> StateT WatchState IO UTCTime
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift IO UTCTime
getCurrentTime

    Table
output   <- IO (Either CodeforcesError Table)
-> StateT WatchState IO (Either CodeforcesError Table)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift IO (Either CodeforcesError Table)
m StateT WatchState IO (Either CodeforcesError Table)
-> (Either CodeforcesError Table -> StateT WatchState IO Table)
-> StateT WatchState IO Table
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Left CodeforcesError
e -> do
            -- Include error message but table data remains the same
            let oldTable :: Table
oldTable   = WatchState -> Table
wsTable WatchState
oldState
                lastUpdate :: Maybe UTCTime
lastUpdate = WatchState -> Maybe UTCTime
wsUpdateTime WatchState
oldState
            Table -> StateT WatchState IO Table
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Table -> StateT WatchState IO Table)
-> Table -> StateT WatchState IO Table
forall a b. (a -> b) -> a -> b
$ Table -> Maybe CodeforcesError -> UTCTime -> Maybe UTCTime -> Table
addInfo Table
oldTable (CodeforcesError -> Maybe CodeforcesError
forall a. a -> Maybe a
Just CodeforcesError
e) UTCTime
now Maybe UTCTime
lastUpdate

        Right Table
newTable -> do
            let currUpdate :: Maybe UTCTime
currUpdate = UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
now
            WatchState -> StateT WatchState IO ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (WatchState -> StateT WatchState IO ())
-> WatchState -> StateT WatchState IO ()
forall a b. (a -> b) -> a -> b
$ Table -> Maybe UTCTime -> WatchState
WatchState Table
newTable Maybe UTCTime
currUpdate
            Table -> StateT WatchState IO Table
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Table -> StateT WatchState IO Table)
-> Table -> StateT WatchState IO Table
forall a b. (a -> b) -> a -> b
$ Table -> Maybe CodeforcesError -> UTCTime -> Maybe UTCTime -> Table
addInfo Table
newTable Maybe CodeforcesError
forall a. Maybe a
Nothing UTCTime
now Maybe UTCTime
currUpdate

    IO () -> StateT WatchState IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> StateT WatchState IO ())
-> IO () -> StateT WatchState IO ()
forall a b. (a -> b) -> a -> b
$ do
        Maybe Int
currTermH <- ((Int, Int) -> Int) -> Maybe (Int, Int) -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, Int) -> Int
forall a b. (a, b) -> a
fst (Maybe (Int, Int) -> Maybe Int)
-> IO (Maybe (Int, Int)) -> IO (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe (Int, Int))
getTerminalSize
        let output' :: Table
output' = Table -> Maybe Int -> Table
truncateTable Table
output (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
1 (Int -> Int) -> Maybe Int -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
currTermH)

        Int -> Int -> IO ()
setCursorPosition Int
0 Int
0
        Table -> (Text -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Table
output' ((Text -> IO ()) -> IO ()) -> (Text -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Text
r -> IO ()
clearLine IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> IO ()
T.putStrLn Text
r

        Int -> IO ()
threadDelay (Int
delaySecs Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000000)

    Int -> IO (Either CodeforcesError Table) -> StateT WatchState IO ()
watchTable Int
delaySecs IO (Either CodeforcesError Table)
m

--------------------------------------------------------------------------------

-- | Takes a table with a potential error message and last successful update
-- time, and returns the table with extra rows for various messages.
--
-- When tables are displayed in watch mode, these extra rows are placed before
-- the table:
--  * The first displays a message for how to exit watch mode.
--  * The second row displays errors if there are any and the last update time.
--  * The third row is blank.
--
addInfo
    :: Table                  -- ^ Table to modify.
    -> Maybe CodeforcesError  -- ^ Error message, if exists.
    -> UTCTime                -- ^ Current system time.
    -> Maybe UTCTime          -- ^ Last successful update time, if any.
    -> Table
addInfo :: Table -> Maybe CodeforcesError -> UTCTime -> Maybe UTCTime -> Table
addInfo Table
table Maybe CodeforcesError
me UTCTime
now Maybe UTCTime
lastUpdate =
    Color -> Text -> Text
colored Color
Cyan Text
"Watching for updates. Press CTRL+c to exit."
        Text -> Table -> Table
forall a. a -> [a] -> [a]
: Text
statusMsg
        Text -> Table -> Table
forall a. a -> [a] -> [a]
: Text
""
        Text -> Table -> Table
forall a. a -> [a] -> [a]
: Table
table
  where
    statusMsg :: Text
statusMsg = Table -> Text
T.concat (Table -> Text) -> Table -> Text
forall a b. (a -> b) -> a -> b
$ [Maybe Text] -> Table
forall a. [Maybe a] -> [a]
catMaybes [Maybe Text
errorMsg, Maybe Text
updateMsg]

    errorMsg :: Maybe Text
errorMsg  = Color -> Text -> Text
colored Color
Red (Text -> Text)
-> (CodeforcesError -> Text) -> CodeforcesError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
". ") (Text -> Text)
-> (CodeforcesError -> Text) -> CodeforcesError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text)
-> (CodeforcesError -> String) -> CodeforcesError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorLog -> String
elErrorMsg (ErrorLog -> String)
-> (CodeforcesError -> ErrorLog) -> CodeforcesError -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeforcesError -> ErrorLog
showE (CodeforcesError -> Text) -> Maybe CodeforcesError -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe CodeforcesError
me
    updateMsg :: Maybe Text
updateMsg = Table -> Text
T.concat (Table -> Text) -> Maybe Table -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Maybe Text] -> Maybe Table
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA
        [Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Last update: ", NominalDiffTime -> Text
fmtDiffTime (NominalDiffTime -> Text) -> Maybe NominalDiffTime -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
now (UTCTime -> NominalDiffTime)
-> Maybe UTCTime -> Maybe NominalDiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe UTCTime
lastUpdate)]

-- | 'truncateTable' @table x@ returns the table with the first @x@ rows, or the
-- original table if @x@ is @Nothing@.
truncateTable :: Table -> Maybe Int -> Table
truncateTable :: Table -> Maybe Int -> Table
truncateTable = Table -> (Int -> Table) -> Maybe Int -> Table
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Table -> (Int -> Table) -> Maybe Int -> Table)
-> (Table -> Int -> Table) -> Table -> Maybe Int -> Table
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> Table -> Table) -> Table -> Int -> Table
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Table -> Table
forall a. Int -> [a] -> [a]
take

--------------------------------------------------------------------------------

resetScreen :: IO ()
resetScreen :: IO ()
resetScreen = [SGR] -> IO ()
setSGR [SGR
Reset] IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
clearScreen IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Int -> IO ()
setCursorPosition Int
0 Int
0

-- | Prevents any input into the terminal while running the IO computation.
withDisabledStdin :: IO a -> IO a
withDisabledStdin :: IO a -> IO a
withDisabledStdin IO a
io = IO (BufferMode, Bool)
-> ((BufferMode, Bool) -> IO ())
-> ((BufferMode, Bool) -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
    (do
        BufferMode
prevBuff <- Handle -> IO BufferMode
hGetBuffering Handle
stdin
        Bool
prevEcho <- Handle -> IO Bool
hGetEcho Handle
stdin

        -- Disable terminal input
        Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdin BufferMode
NoBuffering
        Handle -> Bool -> IO ()
hSetEcho Handle
stdin Bool
False

        (BufferMode, Bool) -> IO (BufferMode, Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BufferMode
prevBuff, Bool
prevEcho)
    )
    (\(BufferMode
prevBuff, Bool
prevEcho) ->
        -- Revert stdin buffering and echo
        Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdin BufferMode
prevBuff IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> Bool -> IO ()
hSetEcho Handle
stdin Bool
prevEcho
    )
    (IO a -> (BufferMode, Bool) -> IO a
forall a b. a -> b -> a
const IO a
io)

--------------------------------------------------------------------------------