aboutsummaryrefslogtreecommitdiff
path: root/app/Main.hs
blob: d5df3d361ae5479f752358feaa9b6b3b4cd6bf72 (plain)
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.1"

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) >> exitSuccess
        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