tea-cleaner: Add command line parser

1 files changed, 25 insertions, 49 deletions

diff --git a/tea-cleaner/Main.hs b/tea-cleaner/Main.hs
index bfad0f7..08c3b89 100644
--- a/tea-cleaner/Main.hs
+++ b/tea-cleaner/Main.hs
@@ -2,70 +2,46 @@ module Main
     ( main
     ) where
 
+import Data.Text (StrictText)
 import Data.Vector (Vector)
 import qualified Data.Text as Text
-import System.Environment (getArgs)
-import qualified Text.URI as URI
-import Data.Time (LocalTime(..), ZonedTime(..))
+import Text.URI (URI, mkURI)
 import qualified Data.Vector as Vector
 import qualified Data.Text.IO as Text.IO
 import qualified Data.Text.Lazy.IO as Text.Lazy.IO
 import qualified Data.Text.Lazy.Builder as Text.Builder
 import qualified Data.Text.Lazy.Builder.Int as Text.Builder
 import GHC.Records (HasField(..))
-import Data.Time.Calendar.OrdinalDate (fromOrdinalDate)
-import TeaCleaner.Types (Activity(..), User(..))
-import TeaCleaner.Client (getActivities, getUsers, purgeUser)
+import TeaCleaner.Filter (filterByActivities, filterByUserProperties)
+import TeaCleaner.Client (User(..), getUsers, purgeUser)
+import TeaCleaner.CommandLine (ProgramOptions(..), commandLineInfo, execParser)
 
-filterByUserProperties :: User -> Bool
-filterByUserProperties User{ created, lastLogin, description, website }
-    = zonedDay created == zonedDay lastLogin
-    && zonedDay created > fromOrdinalDate 2024 1
-    && zonedDay created < fromOrdinalDate 2025 17
-    && not (Text.null description)
-    && not (Text.null website)
-  where
-    zonedDay = localDay . zonedTimeToLocalTime
-
-filterByActivities :: String -> URI.URI -> User -> IO Bool
-filterByActivities server token user
-    = getActivities server token user
-    >>= evalActivities
-  where
-    evalActivities activities
-        | Just (Activity{ opType }, rest) <- Vector.uncons activities
-        , Vector.null rest = pure $ opType == "create_repo"
-    evalActivities _ = pure False
-
-printUsers :: String -> URI.URI -> Vector User -> IO ()
-printUsers server token users = printCount
-    >> Vector.forM_ users printUser
+printUsers :: URI -> StrictText -> Bool -> Vector User -> IO ()
+printUsers server token liveRun users = printCount
+    >> Vector.forM_ users (printUser liveRun)
   where
     printCount =
         let count = Text.Builder.decimal $ Vector.length users
          in Text.Lazy.IO.putStrLn
             $ Text.Builder.toLazyText
             $ "Count: " <> count
-    printUser user =
-        let value
-                = "  Website: " <> getField @"website" user <> "\n"
-                <> "  Created: " <> Text.pack (show $ getField @"created" user) <> "\n"
-                <> "  Last login: " <> Text.pack (show $ getField @"lastLogin" user) <> "\n"
-                <> "  Email: " <> getField @"email" user <> "\n"
-                <> "  Website: " <> getField @"website" user <> "\n"
-                <> "  Description: " <> getField @"description" user <> "\n"
-                <> "  Avatar: " <> getField @"avatarUrl" user <> "\n"
-                <> "\n"
-         in Text.IO.putStrLn (getField @"username" user <> "\n" <> value)
-            >> purgeUser server token user
+    buildValue user = getField @"username" user <> "\n"
+        <> "  Website: " <> getField @"website" user <> "\n"
+        <> "  Created: " <> Text.pack (show $ getField @"created" user) <> "\n"
+        <> "  Last login: " <> Text.pack (show $ getField @"lastLogin" user) <> "\n"
+        <> "  Email: " <> getField @"email" user <> "\n"
+        <> "  Website: " <> getField @"website" user <> "\n"
+        <> "  Description: " <> getField @"description" user <> "\n"
+        <> "  Avatar: " <> getField @"avatarUrl" user <> "\n"
+        <> "\n"
+    printUser True user = Text.IO.putStrLn (buildValue user)
+        >> purgeUser server token user
+    printUser False user = Text.IO.putStrLn (buildValue user)
 
 main :: IO ()
-main = getArgs >>= withArguments
+main = execParser commandLineInfo >>= withArguments
   where
-    withArguments [server, token]
-        = URI.mkURI (Text.pack server)
-        >>= withServer token
-    withArguments _ = putStrLn "Expected exactly two arguments: server URL and the access token."
-    withServer token server = getUsers token server
-        >>= Vector.filterM (filterByActivities token server) . Vector.filter filterByUserProperties
-        >>= printUsers token server
+    withArguments ProgramOptions{..} = mkURI server >>= withServer liveRun token
+    withServer liveRun token server = getUsers server token
+        >>= Vector.filterM (filterByActivities server token) . Vector.filter filterByUserProperties
+        >>= printUsers server token liveRun