{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}

{- |
Module      : RsiBreak.Widget.Timer
Copyright   : (c) Ruben Astudillo, 2023
License     : BSD-2
Maintainer  : ruben.astud@gmail.com

Composite holding the threads with the time counter.
-}
module RsiBreak.Widget.Timer (
    TimerModel (..),
    TimerState (..),
    TimerEvent (TimerStop),
    handleEvent,
    buildUI,
) where

import Control.Concurrent (threadDelay)
import Control.Concurrent.Async
import Control.Monad (when)
import Data.Either (isRight)
import Data.Functor (void)
import Data.Time (NominalDiffTime, diffUTCTime, getCurrentTime)
import Monomer
import RsiBreak.Model.Minutes (toTimeDiff)
import RsiBreak.Model.Settings qualified as Settings (TimerSetting (..))
import System.Process (runInteractiveProcess, waitForProcess)

data TimerEvent
    = TimerStartWorkTime
    | TimerStartRestTime
    | TimerStop
    | TimerStateUpdate TimerState
    | TimerReport NominalDiffTime

-- | State data type that will be read and __written__ by this composite.
data TimerState
    = TimerWorkWait (Async ())
    | TimerRestWait (Async ())
    | TimerNoWait
    deriving (TimerState -> TimerState -> Bool
(TimerState -> TimerState -> Bool)
-> (TimerState -> TimerState -> Bool) -> Eq TimerState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TimerState -> TimerState -> Bool
== :: TimerState -> TimerState -> Bool
$c/= :: TimerState -> TimerState -> Bool
/= :: TimerState -> TimerState -> Bool
Eq)

{- | State data type that holds a read-only reference to
     @Settings.TimerSetting@. We will read such reference when launching a
     timer.
-}
data TimerModel = TimerModel
    { TimerModel -> TimerSetting
tmSettings :: Settings.TimerSetting
    , TimerModel -> TimerState
tmState :: TimerState
    }
    deriving (TimerModel -> TimerModel -> Bool
(TimerModel -> TimerModel -> Bool)
-> (TimerModel -> TimerModel -> Bool) -> Eq TimerModel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TimerModel -> TimerModel -> Bool
== :: TimerModel -> TimerModel -> Bool
$c/= :: TimerModel -> TimerModel -> Bool
/= :: TimerModel -> TimerModel -> Bool
Eq)

stopTimer :: TimerState -> IO ()
stopTimer :: TimerState -> IO ()
stopTimer (TimerWorkWait Async ()
t) = Async () -> IO ()
forall a. Async a -> IO ()
cancel Async ()
t
stopTimer (TimerRestWait Async ()
t) = Async () -> IO ()
forall a. Async a -> IO ()
cancel Async ()
t
stopTimer TimerState
_ = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

isWorkTime :: TimerState -> Bool
isWorkTime :: TimerState -> Bool
isWorkTime (TimerWorkWait Async ()
_) = Bool
True
isWorkTime TimerState
_ = Bool
False

handleEvent ::
    -- | Wrapper for event to report on parent composite
    (NominalDiffTime -> ep) ->
    EventHandler TimerModel TimerEvent es ep
handleEvent :: forall ep es.
(NominalDiffTime -> ep) -> EventHandler TimerModel TimerEvent es ep
handleEvent NominalDiffTime -> ep
toEp WidgetEnv TimerModel TimerEvent
_wenv WidgetNode TimerModel TimerEvent
_node model :: TimerModel
model@(TimerModel TimerSetting
settings TimerState
timer) TimerEvent
evt =
    case TimerEvent
evt of
        TimerStateUpdate TimerState
wstate -> [TimerModel -> EventResponse TimerModel TimerEvent es ep
forall s e sp ep. s -> EventResponse s e sp ep
Model (TimerModel
model{tmState :: TimerState
tmState = TimerState
wstate})]
        TimerReport NominalDiffTime
timediff -> [ep -> EventResponse TimerModel TimerEvent es ep
forall s e sp ep. ep -> EventResponse s e sp ep
Report (NominalDiffTime -> ep
toEp NominalDiffTime
timediff)]
        TimerEvent
TimerStop ->
            [ TaskHandler TimerEvent -> EventResponse TimerModel TimerEvent es ep
forall s e sp ep. TaskHandler e -> EventResponse s e sp ep
Task (TimerState -> TimerEvent
TimerStateUpdate TimerState
TimerNoWait TimerEvent -> IO () -> TaskHandler TimerEvent
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ TimerState -> IO ()
stopTimer TimerState
timer)
            , TimerEvent -> EventResponse TimerModel TimerEvent es ep
forall s e sp ep. e -> EventResponse s e sp ep
Event (NominalDiffTime -> TimerEvent
TimerReport NominalDiffTime
0)
            ]
        TimerEvent
TimerStartWorkTime
            | TimerState -> Bool
isWorkTime TimerState
timer -> [] -- no relaunch
            | Bool
otherwise -> [TimerEvent -> EventResponse TimerModel TimerEvent es ep
forall s e sp ep. e -> EventResponse s e sp ep
Event TimerEvent
TimerStop, ProducerHandler TimerEvent
-> EventResponse TimerModel TimerEvent es ep
forall s e sp ep. ProducerHandler e -> EventResponse s e sp ep
Producer (TimerSetting -> ProducerHandler TimerEvent
waitWork TimerSetting
settings)]
        TimerEvent
TimerStartRestTime
            | TimerState -> Bool
isWorkTime TimerState
timer -> [TimerEvent -> EventResponse TimerModel TimerEvent es ep
forall s e sp ep. e -> EventResponse s e sp ep
Event TimerEvent
TimerStop, ProducerHandler TimerEvent
-> EventResponse TimerModel TimerEvent es ep
forall s e sp ep. ProducerHandler e -> EventResponse s e sp ep
Producer (TimerSetting -> ProducerHandler TimerEvent
waitRest TimerSetting
settings)]
            | Bool
otherwise -> [] -- Do not jump to rest if the timer is stopped.

buildUI :: UIBuilder TimerModel TimerEvent
buildUI :: UIBuilder TimerModel TimerEvent
buildUI WidgetEnv TimerModel TimerEvent
_wenv TimerModel
_model =
    [WidgetNode TimerModel TimerEvent]
-> WidgetNode TimerModel TimerEvent
forall (t :: * -> *) s e.
Traversable t =>
t (WidgetNode s e) -> WidgetNode s e
vstack
        [ Text -> TimerEvent -> WidgetNode TimerModel TimerEvent
forall e s. WidgetEvent e => Text -> e -> WidgetNode s e
button Text
"Start" TimerEvent
TimerStartWorkTime
        , Text -> TimerEvent -> WidgetNode TimerModel TimerEvent
forall e s. WidgetEvent e => Text -> e -> WidgetNode s e
button Text
"Finish just this cycle" TimerEvent
TimerStartRestTime
        , Text -> TimerEvent -> WidgetNode TimerModel TimerEvent
forall e s. WidgetEvent e => Text -> e -> WidgetNode s e
button Text
"Stop" TimerEvent
TimerStop
        ]

popWin :: String -> IO ()
popWin :: String -> IO ()
popWin String
str = do
    (Handle
_, Handle
_, Handle
_, ProcessHandle
than) <- String
-> [String]
-> Maybe String
-> Maybe [(String, String)]
-> IO (Handle, Handle, Handle, ProcessHandle)
runInteractiveProcess String
"rsi-break-popup" (String -> [String]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
str) Maybe String
forall a. Maybe a
Nothing Maybe [(String, String)]
forall a. Maybe a
Nothing
    IO ExitCode -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ExitCode -> IO ()) -> IO ExitCode -> IO ()
forall a b. (a -> b) -> a -> b
$ ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
than

waitTime :: NominalDiffTime -> ProducerHandler TimerEvent
waitTime :: NominalDiffTime -> ProducerHandler TimerEvent
waitTime NominalDiffTime
totalTime TimerEvent -> IO ()
handle = IO UTCTime
getCurrentTime IO UTCTime -> (UTCTime -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UTCTime -> IO ()
go
  where
    go :: UTCTime -> IO ()
go UTCTime
startTime = do
        UTCTime
currentTime <- IO UTCTime
getCurrentTime
        let timeDiff :: NominalDiffTime
timeDiff = UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
currentTime UTCTime
startTime
        if NominalDiffTime
timeDiff NominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
<= NominalDiffTime
totalTime
            then do
                TimerEvent -> IO ()
handle (TimerEvent -> IO ()) -> TimerEvent -> IO ()
forall a b. (a -> b) -> a -> b
$! NominalDiffTime -> TimerEvent
TimerReport (NominalDiffTime
totalTime NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
- NominalDiffTime
timeDiff)
                Int -> IO ()
threadDelay Int
500_000
                UTCTime -> IO ()
go UTCTime
startTime
            else TimerEvent -> IO ()
handle (NominalDiffTime -> TimerEvent
TimerReport NominalDiffTime
0)

waitWork :: Settings.TimerSetting -> ProducerHandler TimerEvent
waitWork :: TimerSetting -> ProducerHandler TimerEvent
waitWork TimerSetting
ts TimerEvent -> IO ()
handle =
    IO () -> (Async () -> IO ()) -> IO ()
forall a b. IO a -> (Async a -> IO b) -> IO b
withAsync (NominalDiffTime -> ProducerHandler TimerEvent
waitTime NominalDiffTime
totalTime TimerEvent -> IO ()
handle) ((Async () -> IO ()) -> IO ()) -> (Async () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Async ()
waitThr ->
        IO () -> (Async () -> IO ()) -> IO ()
forall a b. IO a -> (Async a -> IO b) -> IO b
withAsync (String -> IO ()
popWin String
"Working Time!") ((Async () -> IO ()) -> IO ()) -> (Async () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Async ()
_popThr -> do
            TimerEvent -> IO ()
handle (TimerState -> TimerEvent
TimerStateUpdate (Async () -> TimerState
TimerWorkWait Async ()
waitThr))
            Either SomeException ()
res <- Async () -> IO (Either SomeException ())
forall a. Async a -> IO (Either SomeException a)
waitCatch Async ()
waitThr
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Either SomeException () -> Bool
forall a b. Either a b -> Bool
isRight Either SomeException ()
res) (TimerEvent -> IO ()
handle TimerEvent
TimerStartRestTime)
  where
    totalTime :: NominalDiffTime
totalTime = Int -> NominalDiffTime
toTimeDiff (TimerSetting -> Int
Settings._workInterval TimerSetting
ts)

waitRest :: Settings.TimerSetting -> ProducerHandler TimerEvent
waitRest :: TimerSetting -> ProducerHandler TimerEvent
waitRest TimerSetting
ts TimerEvent -> IO ()
handle =
    IO () -> (Async () -> IO ()) -> IO ()
forall a b. IO a -> (Async a -> IO b) -> IO b
withAsync (NominalDiffTime -> ProducerHandler TimerEvent
waitTime NominalDiffTime
totalTime TimerEvent -> IO ()
handle) ((Async () -> IO ()) -> IO ()) -> (Async () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Async ()
waitThr ->
        IO () -> (Async () -> IO ()) -> IO ()
forall a b. IO a -> (Async a -> IO b) -> IO b
withAsync (String -> IO ()
popWin String
"Resting Time!") ((Async () -> IO ()) -> IO ()) -> (Async () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Async ()
_popThr -> do
            TimerEvent -> IO ()
handle (TimerState -> TimerEvent
TimerStateUpdate (Async () -> TimerState
TimerRestWait Async ()
waitThr))
            Either SomeException ()
res <- Async () -> IO (Either SomeException ())
forall a. Async a -> IO (Either SomeException a)
waitCatch Async ()
waitThr
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Either SomeException () -> Bool
forall a b. Either a b -> Bool
isRight Either SomeException ()
res) (TimerEvent -> IO ()
handle TimerEvent
TimerStartWorkTime)
  where
    totalTime :: NominalDiffTime
totalTime = Int -> NominalDiffTime
toTimeDiff (TimerSetting -> Int
Settings._restInterval TimerSetting
ts)