1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
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
|
