module CLI (
    containsEither,
    filterParams,
    printVersion,
    runPomodoros,
    runSession,
    showManual,
    showUsage
) where

import Control.Concurrent (threadDelay)
import Control.Monad      (void)
import Data.Char          (isDigit)
import Data.List          (intersect)
import Data.Version       (showVersion)
import System.Exit        (ExitCode(ExitSuccess))
import System.Process     (system)

import Paths_Monadoro     (getDataFileName, version)
import CountdownLoop      (countdownLoop)
import Pomodoro           (session)

showUsage :: IO ()
showUsage :: IO ()
showUsage = String -> IO ()
putStrLn String
usage

options :: [String]
options = [ String
"[-h|--help]"
          , String
"[-m|--man]"
          , String
"[-v|--version]"
          , String
"[--session]"
          , String
"[INTERVAL [...]]" ]

withLastSpaceTrimmed :: String -> String
withLastSpaceTrimmed :: String -> String
withLastSpaceTrimmed String
"" = String
""
withLastSpaceTrimmed (Char
x:String
y)
    | String
y forall a. Eq a => a -> a -> Bool
== String
" " = [Char
x]
    | Bool
otherwise = Char
x forall a. a -> [a] -> [a]
: String -> String
withLastSpaceTrimmed String
y

intersperseWithSpaces :: [String] -> String
intersperseWithSpaces :: [String] -> String
intersperseWithSpaces [String]
options =
    String -> String
withLastSpaceTrimmed (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
x forall a. [a] -> [a] -> [a]
++ String
" " | String
x <- [String]
options])

{-| usage

Returns the usage string.

>>> usage
"Usage: monadoro [-h|--help] [-m|--man] [-v|--version] [--session] [INTERVAL [...]]"
-}
usage :: String
usage :: String
usage = String
"Usage: monadoro " forall a. [a] -> [a] -> [a]
++ [String] -> String
intersperseWithSpaces [String]
options

runPomodoros :: [String] -> IO ()
runPomodoros :: [String] -> IO ()
runPomodoros [String]
xs = do
    [String] -> IO ()
warnAboutErrorsIfAny [String]
invalidIntervals
    IO () -> [String] -> IO ()
runTimer ([String] -> IO ()
getDelayIfNeeded [String]
xs) [String]
validIntervals
    where ([String]
validIntervals, [String]
invalidIntervals) = [String] -> ([String], [String])
checkInput forall a b. (a -> b) -> a -> b
$ [String] -> [String]
filterParams [String]
xs

runSession :: [String] -> IO ()
runSession :: [String] -> IO ()
runSession [String]
xs = IO () -> IO ()
session ([String] -> IO ()
getDelayIfNeeded [String]
xs)

runTimer :: IO () -> [String] -> IO ()
runTimer :: IO () -> [String] -> IO ()
runTimer IO ()
delayer []     = forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO () -> String -> IO String
countdownLoop IO ()
delayer String
"25:00")
runTimer IO ()
delayer [String
t]    = forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO () -> String -> IO String
countdownLoop IO ()
delayer String
t)
runTimer IO ()
delayer (String
t:[String]
ts) = IO () -> [String] -> IO ()
runTimer IO ()
delayer [String
t] forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO () -> [String] -> IO ()
runTimer IO ()
delayer [String]
ts

filterParams :: [String] -> [String]
filterParams :: [String] -> [String]
filterParams = String -> [String] -> [String]
remove String
"-n" forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> [String]
remove String
"--nodelay"

remove :: String -> [String] -> [String]
remove :: String -> [String] -> [String]
remove String
element = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/=String
element)

showManual :: IO ()
showManual :: IO ()
showManual = do
    String
man_file <- String -> IO String
getDataFileName String
"man/monadoro.1"
    ExitCode
ExitSuccess <- String -> IO ExitCode
system forall a b. (a -> b) -> a -> b
$ String
"man " forall a. [a] -> [a] -> [a]
++ String
man_file
    forall (m :: * -> *) a. Monad m => a -> m a
return ()

printVersion :: IO ()
printVersion :: IO ()
printVersion = String -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> String
showVersion forall a b. (a -> b) -> a -> b
$ Version
version

warnAboutErrorsIfAny :: [String] -> IO ()
warnAboutErrorsIfAny :: [String] -> IO ()
warnAboutErrorsIfAny [] = forall (m :: * -> *) a. Monad m => a -> m a
return ()
warnAboutErrorsIfAny [String]
errors =
  String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"Unable to parse as interval: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show [String]
errors

{-| checkInput

Returns valid entries (first list) and invalid entries (second list).

>>> checkInput []
([],[])

>>> checkInput ["x"]
([],["x"])

>>> checkInput ["00:00"]
(["00:00"],[])

>>> checkInput ["00:00", "x"]
(["00:00"],["x"])

>>> checkInput ["00:00", "x"]
(["00:00"],["x"])

>>> checkInput ["00:00", "00:01", "x"]
(["00:00","00:01"],["x"])

-}

checkInput :: [String] -> ([String], [String])
checkInput :: [String] -> ([String], [String])
checkInput [] = ([], [])
checkInput [String
x]
  | String -> Bool
isValidTimeInterval String
x = ([String
x], [])
  | Bool
otherwise = ([], [String
x])
checkInput (String
x:[String]
xs) = ([String]
validEntries, [String]
invalidEntries)
  where
    validEntries :: [String]
validEntries =
      forall a b. (a, b) -> a
fst ([String] -> ([String], [String])
checkInput [String
x]) forall a. [a] -> [a] -> [a]
++ forall a b. (a, b) -> a
fst ([String] -> ([String], [String])
checkInput [String]
xs)
    invalidEntries :: [String]
invalidEntries =
      forall a b. (a, b) -> b
snd ([String] -> ([String], [String])
checkInput [String
x]) forall a. [a] -> [a] -> [a]
++ forall a b. (a, b) -> b
snd ([String] -> ([String], [String])
checkInput [String]
xs)

{-| isValidTimeInterval

>>> isValidTimeInterval "x"
False

>>> isValidTimeInterval "00:00"
True

-}

isValidTimeInterval :: String -> Bool
isValidTimeInterval :: String -> Bool
isValidTimeInterval (Char
m1:Char
m2:Char
':':Char
s1:[Char
s2])
  | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit [Char
m1, Char
m2, Char
s1, Char
s2] = Bool
True
isValidTimeInterval String
_ = Bool
False

containsEither :: (Eq a) => [a] -> [a] -> Bool
containsEither :: forall a. Eq a => [a] -> [a] -> Bool
containsEither [a]
a = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a] -> [a]
intersect [a]
a

getDelayIfNeeded :: [String] -> IO ()
getDelayIfNeeded :: [String] -> IO ()
getDelayIfNeeded [String]
xs
  | [String]
xs forall a. Eq a => [a] -> [a] -> Bool
`containsEither` [String
"--nodelay", String
"-n"] = Int -> IO ()
wait Int
0
  | Bool
otherwise = Int -> IO ()
wait Int
1

milisecPerSecond :: Int
milisecPerSecond :: Int
milisecPerSecond = Int
10 forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
6 :: Int)

wait :: Int -> IO()
wait :: Int -> IO ()
wait Int
n = Int -> IO ()
threadDelay (Int
n forall a. Num a => a -> a -> a
* Int
milisecPerSecond)