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
|
module Main
( main
) where
import System.Exit (exitFailure)
import System.IO (hPutStrLn, stderr)
import Data.Time.Calendar (Day)
import Options.Applicative
( Parser
, (<**>)
, (<|>)
, argument
, auto
, execParser
, flag'
, fullDesc
, help
, helper
, info
, long
, metavar
, option
, optional
, short
, showDefault
, some
, value
)
import Lib (partitionDays)
data Mode
= Keep
| Delete
data Options = Options
{ mode :: Maybe Mode
, base :: Double
, days :: [Day]
}
parseMode :: Parser Mode
parseMode = keep <|> delete
where
keep = flag' Keep (long "keep" <> short 'k' <> help "Print days to keep")
delete =
flag' Delete (long "delete" <> short 'd' <> help "Print days to delete")
parseOptions :: Parser Options
parseOptions =
Options <$> optional parseMode <*>
option
auto
(long "base" <> short 'b' <> metavar "BASE" <> showDefault <> value 1.1 <>
help "Base of the exponent") <*>
some (argument auto (metavar "DAY..."))
main :: IO ()
main = do
opts <- execParser $ info (parseOptions <**> helper) fullDesc
let groups = partitionDays (\n -> floor (base opts ^ (n - 1))) (days opts)
case mode opts of
Just Keep ->
putStrLn $ unwords . map show . concatMap (take 1 . reverse) $ groups
Just Delete ->
putStrLn $ unwords . map show . concatMap (drop 1 . reverse) $ groups
Nothing -> do
mapM_ (hPutStrLn stderr . unwords . map show . reverse) groups
exitFailure
|
