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
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 :: 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
:: Int
-> IO (Either CodeforcesError Table)
-> StateT WatchState IO ()
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
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
addInfo
:: Table
-> Maybe CodeforcesError
-> UTCTime
-> Maybe UTCTime
-> 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 -> 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
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
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) ->
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)