fix(ratio): more attempts to fix ratio bug

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

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": {

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
 

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
+                | allocationCapacity > 0 = fromIntegral allocationPlacesRequested % fromIntegral allocationCapacity
-                | otherwise = fromIntegral allocationPlacesRequested % fromIntegral allocationCapacity
+                | otherwise              = 0 
       allocHeat capN
         = invDualHeat (optimumAllocated capN) capN
       degenerateHeat capN

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
+      | sumSize > 0 && intersectSize > 0 = realToFrac . (0.5 +) . (0.5 *) . max 0 . min 1 $ 2 * intersectSize % sumSize
-      | intersectSize == 0 = 0
+      | otherwise = 0  
-      | otherwise    = realToFrac . (0.5 +) . (0.5 *) . max 0 . min 1 $ 2 * intersectSize % sumSize
       where
         sumSize = (min `on` (intersections !)) (lCid, lCid) (uCid, uCid)
         intersectSize = symmIntersection intersections lCid uCid

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

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

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)
 

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
 

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

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

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
+        if
-          then return 0
+          | numAdmins >= 1 -> return $ numResolved % numAdmins
-          else 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
+      if 
-        | Map.null workers -> return Nothing
+        | size_workers >= 1 -> return . Just $ responders % size_workers
-        | otherwise        -> return . Just $ responders % fromIntegral (Map.size workers)
+        | otherwise         -> return Nothing        
 
 
 dispatchHealthCheckDoesFlush :: Handler HealthReport

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)