72 lines
2.8 KiB
Haskell
72 lines
2.8 KiB
Haskell
|
module Main
|
||
|
( main
|
||
|
) where
|
||
|
|
||
|
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 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)
|
||
|
|
||
|
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
|
||
|
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
|
||
|
|
||
|
main :: IO ()
|
||
|
main = getArgs >>= 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
|