tea-cleaner: Add command line parser
This commit is contained in:
@ -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
|
||||
|
Reference in New Issue
Block a user