#!/usr/bin/env stack
> --stack --install-ghc runghc

This is a command-line Pomodoro counter.

> module Pomodoro (session) where

> import Control.Concurrent (threadDelay)
> import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
> import Data.Time.Format (formatTime, defaultTimeLocale)
> import Display (display)
>
> data Pomodoro = First | Second | Third | Fourth
>     deriving (Pomodoro -> Pomodoro -> Bool
(Pomodoro -> Pomodoro -> Bool)
-> (Pomodoro -> Pomodoro -> Bool) -> Eq Pomodoro
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Pomodoro -> Pomodoro -> Bool
== :: Pomodoro -> Pomodoro -> Bool
$c/= :: Pomodoro -> Pomodoro -> Bool
/= :: Pomodoro -> Pomodoro -> Bool
Eq, Eq Pomodoro
Eq Pomodoro =>
(Pomodoro -> Pomodoro -> Ordering)
-> (Pomodoro -> Pomodoro -> Bool)
-> (Pomodoro -> Pomodoro -> Bool)
-> (Pomodoro -> Pomodoro -> Bool)
-> (Pomodoro -> Pomodoro -> Bool)
-> (Pomodoro -> Pomodoro -> Pomodoro)
-> (Pomodoro -> Pomodoro -> Pomodoro)
-> Ord Pomodoro
Pomodoro -> Pomodoro -> Bool
Pomodoro -> Pomodoro -> Ordering
Pomodoro -> Pomodoro -> Pomodoro
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Pomodoro -> Pomodoro -> Ordering
compare :: Pomodoro -> Pomodoro -> Ordering
$c< :: Pomodoro -> Pomodoro -> Bool
< :: Pomodoro -> Pomodoro -> Bool
$c<= :: Pomodoro -> Pomodoro -> Bool
<= :: Pomodoro -> Pomodoro -> Bool
$c> :: Pomodoro -> Pomodoro -> Bool
> :: Pomodoro -> Pomodoro -> Bool
$c>= :: Pomodoro -> Pomodoro -> Bool
>= :: Pomodoro -> Pomodoro -> Bool
$cmax :: Pomodoro -> Pomodoro -> Pomodoro
max :: Pomodoro -> Pomodoro -> Pomodoro
$cmin :: Pomodoro -> Pomodoro -> Pomodoro
min :: Pomodoro -> Pomodoro -> Pomodoro
Ord, Int -> Pomodoro -> ShowS
[Pomodoro] -> ShowS
Pomodoro -> String
(Int -> Pomodoro -> ShowS)
-> (Pomodoro -> String) -> ([Pomodoro] -> ShowS) -> Show Pomodoro
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Pomodoro -> ShowS
showsPrec :: Int -> Pomodoro -> ShowS
$cshow :: Pomodoro -> String
show :: Pomodoro -> String
$cshowList :: [Pomodoro] -> ShowS
showList :: [Pomodoro] -> ShowS
Show, ReadPrec [Pomodoro]
ReadPrec Pomodoro
Int -> ReadS Pomodoro
ReadS [Pomodoro]
(Int -> ReadS Pomodoro)
-> ReadS [Pomodoro]
-> ReadPrec Pomodoro
-> ReadPrec [Pomodoro]
-> Read Pomodoro
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Pomodoro
readsPrec :: Int -> ReadS Pomodoro
$creadList :: ReadS [Pomodoro]
readList :: ReadS [Pomodoro]
$creadPrec :: ReadPrec Pomodoro
readPrec :: ReadPrec Pomodoro
$creadListPrec :: ReadPrec [Pomodoro]
readListPrec :: ReadPrec [Pomodoro]
Read, Pomodoro
Pomodoro -> Pomodoro -> Bounded Pomodoro
forall a. a -> a -> Bounded a
$cminBound :: Pomodoro
minBound :: Pomodoro
$cmaxBound :: Pomodoro
maxBound :: Pomodoro
Bounded, Int -> Pomodoro
Pomodoro -> Int
Pomodoro -> [Pomodoro]
Pomodoro -> Pomodoro
Pomodoro -> Pomodoro -> [Pomodoro]
Pomodoro -> Pomodoro -> Pomodoro -> [Pomodoro]
(Pomodoro -> Pomodoro)
-> (Pomodoro -> Pomodoro)
-> (Int -> Pomodoro)
-> (Pomodoro -> Int)
-> (Pomodoro -> [Pomodoro])
-> (Pomodoro -> Pomodoro -> [Pomodoro])
-> (Pomodoro -> Pomodoro -> [Pomodoro])
-> (Pomodoro -> Pomodoro -> Pomodoro -> [Pomodoro])
-> Enum Pomodoro
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Pomodoro -> Pomodoro
succ :: Pomodoro -> Pomodoro
$cpred :: Pomodoro -> Pomodoro
pred :: Pomodoro -> Pomodoro
$ctoEnum :: Int -> Pomodoro
toEnum :: Int -> Pomodoro
$cfromEnum :: Pomodoro -> Int
fromEnum :: Pomodoro -> Int
$cenumFrom :: Pomodoro -> [Pomodoro]
enumFrom :: Pomodoro -> [Pomodoro]
$cenumFromThen :: Pomodoro -> Pomodoro -> [Pomodoro]
enumFromThen :: Pomodoro -> Pomodoro -> [Pomodoro]
$cenumFromTo :: Pomodoro -> Pomodoro -> [Pomodoro]
enumFromTo :: Pomodoro -> Pomodoro -> [Pomodoro]
$cenumFromThenTo :: Pomodoro -> Pomodoro -> Pomodoro -> [Pomodoro]
enumFromThenTo :: Pomodoro -> Pomodoro -> Pomodoro -> [Pomodoro]
Enum)

> {-| Given an integer number of seconds, secToTimestamp
>  returns the corresponding time in MM:SS.
>
> >>> secToTimestamp 0
> "00:00"
> >>> secToTimestamp 1500
> "25:00"
> >>> secToTimestamp 3000
> "50:00"
> -}

> secToTimestamp :: Int -> String
> secToTimestamp :: Int -> String
secToTimestamp = TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%M:%S"
>     (UTCTime -> String) -> (Int -> UTCTime) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> UTCTime
posixSecondsToUTCTime
>     (POSIXTime -> UTCTime) -> (Int -> POSIXTime) -> Int -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> POSIXTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral

For testing purposes, this function returns an empty action without delay.

Its type allows for drop-in replacement of the standard delay function.

> no_del :: Int -> IO()
> no_del :: Int -> IO ()
no_del Int
_ = do
>     () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

> pom :: Show a => IO () -> a -> IO ()
> pom :: forall a. Show a => IO () -> a -> IO ()
pom IO ()
delay a
m = do
>     let prefix :: String
prefix = a -> String
forall a. Show a => a -> String
show a
m String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" pomodoro" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" | "
>     IO () -> String -> Int -> IO ()
wait_seconds IO ()
delay String
prefix (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Int
25 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
>     String -> IO ()
putStrLn String
"Finished, take a 5 minute rest."

> rest :: IO () -> Int -> IO ()
> rest :: IO () -> Int -> IO ()
rest IO ()
delay Int
minutes = do
>     let prefix :: String
prefix = String
"Rest time" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" | "
>     IO () -> String -> Int -> IO ()
wait_seconds IO ()
delay String
prefix (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Int
minutes Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

> pomodoro :: IO () -> Pomodoro -> IO ()
> pomodoro :: IO () -> Pomodoro -> IO ()
pomodoro IO ()
delay Pomodoro
Fourth = do
>     IO () -> Pomodoro -> IO ()
forall a. Show a => IO () -> a -> IO ()
pom IO ()
delay Pomodoro
Fourth
>     String -> IO ()
putStrLn String
"Take a 30-minute rest now. You just completed 4 pomodoros."
>     String -> IO ()
putStrLn String
"Congratulations on 4 pomodoros finished in a row!"
> pomodoro IO ()
delay Pomodoro
m = do
>     IO () -> Pomodoro -> IO ()
forall a. Show a => IO () -> a -> IO ()
pom IO ()
delay Pomodoro
m
>     IO () -> Int -> IO ()
rest IO ()
delay Int
5
>     String -> IO ()
putStrLn String
"Get back to work." IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
delay
>     IO () -> Pomodoro -> IO ()
pomodoro IO ()
delay (Pomodoro -> IO ()) -> Pomodoro -> IO ()
forall a b. (a -> b) -> a -> b
$ Pomodoro -> Pomodoro
forall a. Enum a => a -> a
succ Pomodoro
m
>
> wait_seconds :: IO () -> String -> Int -> IO()
> wait_seconds :: IO () -> String -> Int -> IO ()
wait_seconds IO ()
delay String
prefix Int
0 = String -> IO ()
display String
""
> wait_seconds IO ()
delay String
prefix Int
n = do
>     String -> IO ()
display (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
prefix String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Int -> String
secToTimestamp (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
>     IO ()
delay
>     IO () -> String -> Int -> IO ()
wait_seconds IO ()
delay String
prefix (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

> session :: IO() -> IO()
> session :: IO () -> IO ()
session IO ()
delay = IO () -> Pomodoro -> IO ()
pomodoro IO ()
delay Pomodoro
First