From 1ff6303a5a08504a938fd845505323f6a9771977 Mon Sep 17 00:00:00 2001
From: Igor Pashev <pashev.igor@gmail.com>
Date: Wed, 28 Aug 2019 19:47:07 +0200
Subject: Initial version

---
 src/Main.hs | 65 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 65 insertions(+)
 create mode 100644 src/Main.hs

(limited to 'src/Main.hs')

diff --git a/src/Main.hs b/src/Main.hs
new file mode 100644
index 0000000..0ab3259
--- /dev/null
+++ b/src/Main.hs
@@ -0,0 +1,65 @@
+module Main
+  ( main
+  ) where
+
+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) $ groups
+    Just Delete -> putStrLn $ unwords . map show . concatMap (drop 1) $ groups
+    Nothing -> mapM_ (hPutStrLn stderr . unwords . map show) groups
-- 
cgit v1.2.3