From 91c02ee3009aa40f697f16a306d973296ae82e23 Mon Sep 17 00:00:00 2001 From: "Juan J. Martinez" Date: Tue, 26 Jul 2022 21:35:06 +0100 Subject: Initial import --- app/Main.hs | 137 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 137 insertions(+) create mode 100644 app/Main.hs (limited to 'app') diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 index 0000000..713d40f --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,137 @@ +module Main where + +import Control.Exception +import Control.Monad +import Data.Fixed +import Data.Maybe +import Data.Time +import System.Console.GetOpt +import System.Directory +import System.Environment +import System.Exit +import System.IO +import System.IO.Error + +version = "0.1.0" + +tomatoState = "tomato.st" + +data Options = Options + { optHelp :: Bool, + optStateFile :: Maybe FilePath, + optTime :: Integer, + optVersion :: Bool + } + +defOptions = + Options + { optHelp = False, + optStateFile = Nothing, + optTime = 45, + optVersion = False + } + +options :: [OptDescr (Options -> Options)] +options = + [ Option + ['h'] + ["help"] + (NoArg (\opts -> opts {optHelp = True})) + "show help and exit", + Option + ['s'] + ["state"] + (ReqArg (\f opts -> opts {optStateFile = Just f}) "FILE") + "use FILE as state file", + Option + ['t'] + ["time"] + (ReqArg (\t opts -> opts {optTime = read t :: Integer}) "MINUTES") + ("use MINUTES as deadline (default: " ++ show (optTime defOptions) ++ ")"), + Option + ['v'] + ["version"] + (NoArg (\opts -> opts {optVersion = True})) + "output version and exit" + ] + +usage :: String -> [String] -> IO () +usage progName errs + | null errs = do + putStrLn helpText + exitSuccess + | otherwise = do + hPutStrLn stderr ("error: " ++ concat errs ++ "Try " ++ progName ++ " -h for more information.") + exitFailure + where + header = + "Yet another simple pomodoro tool\n" + ++ "Usage: " + ++ progName + ++ " [OPTION...] [command]" + helpText = + usageInfo header options + +resolveEmoji :: NominalDiffTime -> String +resolveEmoji diff + | diff > 0 = "πŸ…" + | otherwise = "πŸ’’" + +doShow :: String -> IO () +doShow stateFile = do + content <- try (readFile stateFile) + case content of + Left err -> + if isDoesNotExistError err + then putStrLn "⏸️ 00:00:00" + else ioError err + Right str -> do + currTime <- getCurrentTime + let start = read str :: UTCTime + let diff = diffUTCTime start currTime + let emoji = resolveEmoji diff + putStrLn (emoji ++ " " ++ formatTime defaultTimeLocale "%0H:%0M:%0S" diff) + +doStop :: String -> IO () +doStop stateFile = do + result <- try (removeFile stateFile) + case result of + Left err -> + if isDoesNotExistError err + then putStrLn "OK" + else ioError err + Right _ -> putStrLn "Stopped" + +doStart :: String -> Integer -> IO () +doStart stateFile mins = do + currTime <- getCurrentTime + let deadline = addUTCTime secs currTime + writeFile stateFile (show deadline) + putStrLn ("Started, end on " ++ show deadline) + where + secs = secondsToNominalDiffTime (60 * fromInteger mins) + +tomato :: String -> [String] -> String -> IO () +tomato progName argv state = + case getOpt Permute options argv of + (o, n, []) -> + do + when (optHelp opts) $ usage progName [] + when (optVersion opts) $ putStrLn (progName ++ " " ++ version) + case n of + [] -> doShow stateFile + ["show"] -> doShow stateFile + ["start"] -> doStart stateFile (optTime opts) + ["stop"] -> doStop stateFile + _ -> usage progName ["invalid command\n"] + where + opts = foldl (flip id) defOptions o + stateFile = fromMaybe state (optStateFile opts) + (_, _, errs) -> usage progName errs + +main :: IO () +main = do + args <- getArgs + progName <- getProgName + state <- getXdgDirectory XdgCache tomatoState + tomato progName args state -- cgit v1.2.3