pomohoro-0.1.2.4: app/Main.hs

module Main where
import Protolude

import Options.Applicative hiding ((<>))
import System.Posix.Daemonize
import Data.Text as Text
import Data.Time
import System.Timeout

import Settings
import Timeclock
import Notifications
import Networking


data Command
    = Start { _account :: Text, _comment :: Text }
    | Status
    | Interrupt
    | RemindMe { _minutes :: Int, _message :: Text }
    deriving Show


args :: Parser Command
args =
    subparser (mconcat [
        command "start" (info (
            Start
                <$> textArgument
                <*> textRestArguments
        ) (progDesc (mconcat [
            "Start a new work session for the specified timeclock",
            " account (or default if none specified)"
        ]))),
        command "status" (info (
            pure Status
        ) (progDesc
            "How long has the current session been going on for?"
        )),
        command "int" (info (
            pure Interrupt
        ) (progDesc
            ("Interrupt the ongoing work session")
        )),
        command "rem" (info (
            RemindMe
                <$> argument auto (value 5)
                <*> textRestArguments 
        ) (progDesc (mconcat [
            "Wait for the specified number of minutes and then send",
            " a notification. Good for keeping time on breaks"
        ])))])


textArgument :: Parser Text
textArgument =
    fmap pack (strArgument (value ""))


textRestArguments :: Parser Text
textRestArguments =
    fmap (unwords . fmap pack) (many (strArgument mempty))


main :: IO ()
main = do
    settings <- loadSettings
    parsed <- execParser (info (helper <*> args) (progDesc (mconcat
        [ "A small pomodoro timer based on CLI usage and FreeDesktop.org"
        , " notifications. Optionally writes pomodoro sessions to a"
        , " timeclock file for budgeting and reporting."])))
    case parsed of
        Start account comment -> startWork settings account comment
        Status -> queryStatus settings
        Interrupt -> interrupt settings
        RemindMe minutes message -> remindMe minutes message


startWork :: Settings -> Text -> Text -> IO ()
startWork settings account comment = do
    sendUDP settings "status"
    response <- timeout 1000000 (recvUDP settings)
    case response of
        Just _ ->
            putStrLn ("Another session already active. Exiting." :: Text)
        Nothing ->
            daemonize $ do
                startTime <- getZonedTime
                appendFile (_timeclockPath settings) (clockin
                    startTime
                    (if Text.null account then _defaultAccount settings else account)
                    comment)
                void (timeout (usecFromMinutes (_sessionLength settings))
                    (handleSession settings startTime))
                stopTime <- getZonedTime
                appendFile (_timeclockPath settings) (clockout stopTime)
                notifySend "Work is over!"
                    ("You have worked for " <> show (minuteDiff stopTime startTime) <> " minutes. Well done!")


handleSession :: Settings -> ZonedTime -> IO ()
handleSession settings startTime = do
    request <- recvUDP settings
    case request of
        "interrupt" -> pure ()
        "status" -> do
            nowTime <- getZonedTime
            sendUDP settings (show (minuteDiff nowTime startTime))
            handleSession settings startTime
        _ -> handleSession settings startTime


queryStatus :: Settings -> IO ()
queryStatus settings = do
    sendUDP settings "status"
    response <- timeout 1000000 (recvUDP settings)
    case response of
        Just mins -> 
            putStrLn ("Current work session: " <> mins <> "/" <> show (_sessionLength settings) <> " minute(s)")
        Nothing ->
            putStrLn ("No work session active." :: Text)
    

interrupt :: Settings -> IO ()
interrupt settings =
    sendUDP settings "interrupt"


remindMe :: Int -> Text -> IO ()
remindMe minutes message =
    daemonize $ do
        threadDelay (usecFromMinutes minutes)
        notifySend "Time's up!" message