summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJuan J. Martinez <jjm@usebox.net>2022-07-26 21:35:06 +0100
committerJuan J. Martinez <jjm@usebox.net>2022-07-26 21:35:06 +0100
commit91c02ee3009aa40f697f16a306d973296ae82e23 (patch)
treee54b52910417fa4ec107a210d33c27b5c6572523
downloadtomato-hs-0.1.0.tar.gz
tomato-hs-0.1.0.zip
Initial import0.1.0
-rw-r--r--.gitignore7
-rw-r--r--CHANGELOG.md5
-rw-r--r--COPYING21
-rw-r--r--README.md35
-rw-r--r--app/Main.hs137
-rw-r--r--tomato.cabal25
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