tea-cleaner: Add command line parser

This commit is contained in:
2025-01-26 10:17:33 +01:00
parent 3c430bca64
commit 6c170513a6
6 changed files with 168 additions and 116 deletions

View File

@ -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