diff --git a/load/Load.hs b/load/Load.hs index b2eec491d..338314574 100644 --- a/load/Load.hs +++ b/load/Load.hs @@ -16,6 +16,7 @@ import qualified Data.Text as Text import qualified Data.Map.Strict as Map +import Data.Ratio ((%)) import Data.Random.Normal import qualified Control.Monad.Random.Class as Random import System.Random (RandomGen) @@ -283,7 +284,7 @@ runSimulation' LoadSheetSubmission = do yieldMany (zip [0..] chunks) .| runReaderC simCtx ( C.mapM $ \(ci, cs) -> - fromIntegral cs <$ delayRemaining (1 % (genericLength chunks - ci) :: Rational) + fromIntegral cs <$ delayRemaining ((1 % max 1 (genericLength chunks - ci)) :: Rational) ) .| generateDownload' uploadSeed -- print $ ala Sum foldMap chunks diff --git a/package-lock.json b/package-lock.json index 7f5e5bf20..126eba908 100644 --- a/package-lock.json +++ b/package-lock.json @@ -3825,7 +3825,7 @@ "boolbase": "~1.0.0", "css-what": "2.1", "domutils": "1.5.1", - "nth-check": "2.0.1" + "nth-check": "~1.0.1" }, "dependencies": { "nth-check": { diff --git a/src/Application.hs b/src/Application.hs index e8892582c..e3cd25755 100644 --- a/src/Application.hs +++ b/src/Application.hs @@ -91,6 +91,7 @@ import qualified Network.Socket as Socket (close) import Control.Concurrent.STM.Delay import Control.Monad.Trans.Cont (runContT, callCC) +import Data.Ratio ((%)) import qualified Data.Set as Set import qualified Data.Map as Map diff --git a/src/Handler/Allocation/Accept.hs b/src/Handler/Allocation/Accept.hs index 8809c034a..2fb3118d0 100644 --- a/src/Handler/Allocation/Accept.hs +++ b/src/Handler/Allocation/Accept.hs @@ -9,6 +9,7 @@ import Import import Handler.Utils import Handler.Utils.Allocation +import Data.Ratio ((%)) import Data.Map ((!?)) import qualified Data.Map as Map import qualified Data.Set as Set @@ -121,8 +122,8 @@ allocationAcceptForm aId = runMaybeT $ do optimumAllocated = round . (* optimumProportion) . fromIntegral where optimumProportion :: Rational optimumProportion - | allocationCapacity == 0 = 0 - | otherwise = fromIntegral allocationPlacesRequested % fromIntegral allocationCapacity + | allocationCapacity > 0 = fromIntegral allocationPlacesRequested % fromIntegral allocationCapacity + | otherwise = 0 allocHeat capN = invDualHeat (optimumAllocated capN) capN degenerateHeat capN diff --git a/src/Handler/Participants.hs b/src/Handler/Participants.hs index 0d1b9eb1b..2653fc356 100644 --- a/src/Handler/Participants.hs +++ b/src/Handler/Participants.hs @@ -11,6 +11,7 @@ import Handler.Utils import qualified Database.Esqueleto.Legacy as E import qualified Database.Esqueleto.Utils as E +import Data.Ratio ((%)) import qualified Data.Map as Map import qualified Data.Set as Set import Data.Map ((!), (!?)) @@ -119,9 +120,8 @@ postParticipantsIntersectR = do symmIntersection intersections lCid uCid = fromMaybe 0 $ intersections !? (lCid, uCid) <|> intersections !? (uCid, lCid) intersectionHotness :: _ -> _ -> _ -> Centi intersectionHotness intersections lCid uCid - | sumSize == 0 = 0 - | intersectSize == 0 = 0 - | otherwise = realToFrac . (0.5 +) . (0.5 *) . max 0 . min 1 $ 2 * intersectSize % sumSize + | sumSize > 0 && intersectSize > 0 = realToFrac . (0.5 +) . (0.5 *) . max 0 . min 1 $ 2 * intersectSize % sumSize + | otherwise = 0 where sumSize = (min `on` (intersections !)) (lCid, lCid) (uCid, uCid) intersectSize = symmIntersection intersections lCid uCid diff --git a/src/Handler/Utils/Exam.hs b/src/Handler/Utils/Exam.hs index 2453e7dd6..a19bc874f 100644 --- a/src/Handler/Utils/Exam.hs +++ b/src/Handler/Utils/Exam.hs @@ -20,6 +20,7 @@ module Handler.Utils.Exam import Import +import Data.Ratio ((%)) import Database.Persist.Sql (SqlBackendCanRead) import qualified Database.Esqueleto.Legacy as E import qualified Database.Esqueleto.Utils as E diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs index 69845b554..131061a6d 100644 --- a/src/Handler/Utils/Table/Pagination.hs +++ b/src/Handler/Utils/Table/Pagination.hs @@ -66,6 +66,7 @@ import Utils.Lens import Import hiding (pi) +import Data.Ratio ((%)) import qualified Data.Foldable as Foldable import qualified Yesod.Form.Functions as Yesod diff --git a/src/Import/NoModel.hs b/src/Import/NoModel.hs index 16c566181..17d24b4ab 100644 --- a/src/Import/NoModel.hs +++ b/src/Import/NoModel.hs @@ -101,7 +101,7 @@ import Data.Dynamic.Lens as Import import System.FilePath as Import hiding (joinPath, normalise, isValid, makeValid) import Numeric.Natural as Import (Natural) -import Data.Ratio as Import ((%)) +-- import Data.Ratio as Import ((%)) import Network.IP.Addr as Import (IP) diff --git a/src/Jobs/Crontab.hs b/src/Jobs/Crontab.hs index a8c0be52a..c78c8b7af 100644 --- a/src/Jobs/Crontab.hs +++ b/src/Jobs/Crontab.hs @@ -12,6 +12,7 @@ import Jobs.Types import qualified Data.Set as Set import qualified Data.Map as Map +import Data.Ratio ((%)) import Data.Time.Zones import Data.Time.Clock.POSIX diff --git a/src/Jobs/Handler/Files.hs b/src/Jobs/Handler/Files.hs index c8e8e38af..79b25593f 100644 --- a/src/Jobs/Handler/Files.hs +++ b/src/Jobs/Handler/Files.hs @@ -9,6 +9,8 @@ module Jobs.Handler.Files import Import hiding (matching, maximumBy, init) +import Data.Ratio ((%)) + import Database.Persist.Sql (deleteWhereCount) import qualified Database.Esqueleto.Legacy as E diff --git a/src/Jobs/Handler/LMS.hs b/src/Jobs/Handler/LMS.hs index 7705a9f10..e4ad4cb0a 100644 --- a/src/Jobs/Handler/LMS.hs +++ b/src/Jobs/Handler/LMS.hs @@ -100,7 +100,7 @@ dispatchJobLmsEnqueueUser qid uid = JobHandlerAtomic act startLmsUser = E.insertUniqueEntity =<< (mkLmsUser <$> randomLMSIdent <*> randomLMSpw) inserted <- untilJustMaxM maxLmsUserIdentRetries startLmsUser case inserted of - Nothing -> $logErrorS "LMS" "Generating and inserting fresh LmsIdent failed!" + Nothing -> $logErrorS "LMS" $ "Generating and inserting fresh LmsIdent failed for uid " <> tshow uid <> " and qid " <> tshow qid <> "!" (Just _) -> queueDBJob JobSendNotification { jRecipient = uid, jNotification = NotificationQualificationRenewal { nQualification = qid } } diff --git a/src/Jobs/HealthReport.hs b/src/Jobs/HealthReport.hs index a53dc8616..979709a75 100644 --- a/src/Jobs/HealthReport.hs +++ b/src/Jobs/HealthReport.hs @@ -6,6 +6,7 @@ module Jobs.HealthReport import Import +import Data.Ratio ((%)) import Data.List (genericLength) import qualified Data.Map.Strict as Map @@ -119,9 +120,9 @@ dispatchHealthCheckLDAPAdmins = fmap HealthLDAPAdmins . yesodTimeout (^. _appHea let hCampusExc :: CampusUserException -> Handler (Sum Integer) hCampusExc err = mempty <$ $logErrorS "healthCheckLDAPAdmins" (adminIdent <> ": " <> tshow err) in handle hCampusExc $ Sum 1 <$ campusUserReTest ldapPool ((>= reTestAfter) . realToFrac) FailoverUnlimited (Creds apLdap adminIdent []) - if numAdmins == 0 - then return 0 - else return $ numResolved % numAdmins + if + | numAdmins >= 1 -> return $ numResolved % numAdmins + | otherwise -> return 0 _other -> return Nothing @@ -173,12 +174,13 @@ dispatchHealthCheckActiveJobExecutors = HealthActiveJobExecutors <$> do tid <- myThreadId let workers' = Map.fromSet jobWorkerName (Map.keysSet jobWorkers) workers = Map.filterWithKey (\a _ -> asyncThreadId a /= tid) workers' + size_workers = fromIntegral $ Map.size workers $logDebugS "HealthCheckActiveJobExecutors" . tshow . map showWorkerId $ Map.elems workers' responders <- fmap (getSum . fold) . liftIO . forConcurrently (Map.toList workers) $ \(_, wName) -> diffTimeout timeoutLength (Sum 0) (runReaderT ?? app $ Sum 1 <$ writeJobCtlBlock' (writeJobCtl' wName) JobCtlTest) - if - | Map.null workers -> return Nothing - | otherwise -> return . Just $ responders % fromIntegral (Map.size workers) + if + | size_workers >= 1 -> return . Just $ responders % size_workers + | otherwise -> return Nothing dispatchHealthCheckDoesFlush :: Handler HealthReport diff --git a/src/Model/Types/DateTime.hs b/src/Model/Types/DateTime.hs index e6b2bdc51..a2ecdad3e 100644 --- a/src/Model/Types/DateTime.hs +++ b/src/Model/Types/DateTime.hs @@ -11,6 +11,7 @@ module Model.Types.DateTime import Import.NoModel +import Data.Ratio ((%)) import qualified Data.Text as Text -- import Data.Either.Combinators (maybeToRight, mapLeft) import Text.Read (readMaybe)