Skip to content

Commit

Permalink
make janitor actually run
Browse files Browse the repository at this point in the history
  • Loading branch information
jaspervdj committed Dec 13, 2023
1 parent 8136957 commit 1a014be
Show file tree
Hide file tree
Showing 2 changed files with 18 additions and 47 deletions.
1 change: 0 additions & 1 deletion lib/Zureg/Database.hs
Original file line number Diff line number Diff line change
Expand Up @@ -184,7 +184,6 @@ registrantsSummaryToAttributeValue RegistrantsSummary {..} =
, ("scanned", avi rsScanned)
]


registrantsSummaryFromAttributeValue
:: DynamoDB.AttributeValue -> Maybe RegistrantsSummary
registrantsSummaryFromAttributeValue av = RegistrantsSummary
Expand Down
64 changes: 18 additions & 46 deletions lib/Zureg/Main/Janitor.hs
Original file line number Diff line number Diff line change
Expand Up @@ -5,59 +5,39 @@ module Zureg.Main.Janitor
( main
) where

import Control.Monad (guard)
import qualified Data.Aeson as A
import Data.List (sortOn)
import qualified Data.Time as Time
import qualified Eventful as E
import qualified System.IO as IO
import qualified Zureg.Database as Database
import Zureg.Hackathon (Hackathon)
import qualified Zureg.Hackathon as Hackathon
import qualified Zureg.Lambda as Lambda
import Control.Monad (guard)
import qualified Data.Aeson as A
import Data.List (sortOn)
import Data.Maybe
import qualified Data.Time as Time
import qualified Eventful as E
import qualified Zureg.Database as Database
import qualified Zureg.Hackathon as Hackathon
import Zureg.Hackathon (Hackathon)
import Zureg.Main.PopWaitlist (popWaitinglistUUIDs)
import Zureg.Model
import Data.Maybe



--------------------------------------------------------------------------------
-- The request and response types for the janitor lambda are mostly ignored,
-- it's just a thing that runs from time to time.

data Request = Request

instance A.FromJSON Request where
parseJSON _ = pure Request

data Response
= MessageResponse String
| ErrorResponse String

instance A.ToJSON Response where
toJSON (MessageResponse msg) = A.object ["message" A..= msg]
toJSON (ErrorResponse err) = A.object ["error" A..= err]

countByState ::(RegisterState -> Bool) -> [Registrant a] -> Int
countByState f registrants = length $ filter f $ mapMaybe rState registrants

isWaiting :: RegisterState -> Bool
isWaiting Waitlisted = True
isWaiting _ = False
isWaiting _ = False

isConfirmed :: RegisterState -> Bool
isConfirmed Confirmed = True
isConfirmed _ = False
isConfirmed _ = False

isAttending :: RegisterState -> Bool
isAttending Confirmed = True
isAttending Confirmed = True
isAttending Registered = True
isAttending _ = False
isAttending _ = False

main :: forall a. (Eq a, A.FromJSON a, A.ToJSON a) => Hackathon a -> IO ()
main
:: forall a. (Eq a, A.FromJSON a, A.ToJSON a)
=> Hackathon a -> IO Database.RegistrantsSummary
main hackathon =
Database.withHandle (Hackathon.databaseConfig hackathon) $ \db ->
Lambda.main IO.stdin IO.stdout (ErrorResponse . show) $ \Request -> do
Database.withHandle (Hackathon.databaseConfig hackathon) $ \db -> do
uuids <- Database.getRegistrantUuids db
registrants <- mapM (Database.getRegistrant db) uuids :: IO [Registrant a]

Expand All @@ -81,15 +61,7 @@ main hackathon =
}

Database.putRegistrantsSummary db summary
pure $ MessageResponse $ "Computed summary: " ++ renderSummary summary

renderSummary :: Database.RegistrantsSummary -> String
renderSummary rs = show (Database.rsTotal rs) ++ " total, " ++
show (Database.rsWaiting rs) ++ " waiting, " ++
show (Database.rsAttending rs) ++ " attending, " ++
show (Database.rsConfirmed rs) ++ " confirmed, " ++
show (Database.rsAvailable rs) ++ " available, " ++
show (Database.rsScanned rs) ++ " scanned"
pure summary

-- This is to put Nothings to the end of a sorted list
newtype Fifo = Fifo (Maybe Time.UTCTime) deriving Eq
Expand Down

0 comments on commit 1a014be

Please sign in to comment.