Initial import0.1.0

1 files changed, 137 insertions, 0 deletions

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