Initial import0.1.0

6 files changed, 230 insertions, 0 deletions

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..30d45fa
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,7 @@
+dist
+dist-newstyle
+*.o
+*.hi
+.ghc.environment.*
+tomato.st
+
diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
index 0000000..81cec39
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,5 @@
+# Revision history for tomato
+
+## 0.1.0 -- 2022-07-26
+
+* First version. Released on an unsuspecting world.
diff --git a/COPYING b/COPYING
new file mode 100644
index 0000000..29dacda
--- /dev/null
+++ b/COPYING
@@ -0,0 +1,21 @@
+tomato, yet another pomodoro tool
+Copyright (C) 2022 by Juan J. Martinez <jjm@usebox.net>
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in
+all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+THE SOFTWARE.
+
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..277671a
--- /dev/null
+++ b/README.md
@@ -0,0 +1,35 @@
+# 🍅 Tomato, yet another Pomodoro tool
+
+## Why?
+
+Because I'm learning Haskell and this seemed a simple little tool to write in a couple of hours.
+
+## Install
+
+Using [cabal](https://www.haskell.org/cabal/):
+
+```
+git clone https://git.usebox.net/tomato-hs
+cd tomato-hs
+cabal install tomato
+```
+
+## How to use it
+
+You can always read the CLI help with `tomato -h`, but basically:
+
+* `tomato start` starts a 45 minutes Pomodoro (default, use `-t` to specify a different number).
+* `tomato` or `tomato show` shows the time left in current Pomodoro (if any).
+* `tomato stop` stops current Pomodoro (if any).
+
+The state is saved on your `XDG_CACHE_HOME` directory (usually `$HOME/.cache`). If The tool has issues finding the directy, you can use `-s` option to specify a location.
+
+## Using it from tmux
+
+You can add `tomato` o tmux with:
+
+```
+set -g status-interval 1
+set -g status-right "#(tomato)"
+```
+
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
diff --git a/tomato.cabal b/tomato.cabal
new file mode 100644
index 0000000..46d3ba3
--- /dev/null
+++ b/tomato.cabal
@@ -0,0 +1,25 @@
+cabal-version:      2.4
+name:               tomato
+version:            0.1.0
+
+synopsis: Yet another pomodoro tool
+homepage: https://git.usebox.net/tomato-hs/about/
+
+license:            MIT
+author:             Juan J. Martinez
+maintainer:         jjm@usebox.net
+
+copyright: (c) 2022 Juan J. Martinez
+extra-source-files:
+    CHANGELOG.md
+    , README.md
+    , COPYING
+
+executable tomato
+    main-is:          Main.hs
+    build-depends:
+        base ^>=4.14.3.0
+        , directory ^>=1.3.6.2
+        , time ^>=1.11.1.1
+    hs-source-dirs:   app
+    default-language: Haskell2010