Implement least work left

Currently running into to some performance issues here.

app/LoadBalancer.hs

@@ -2,9 +2,13 @@
 
 module Main where
 
+import Control.DeepSeq
+import Debug.Trace (traceM)
 import Control.Monad (replicateM, forM_, forever)
 import Control.Monad.Random.Class (getRandomR)
+import Data.Coerce (coerce)
 import Data.Random.Source.PureMT (newPureMT)
+import qualified Data.PQueue.Prio.Min as PQueue
 import Deli (Channel, Deli, JobTiming(..))
 import Deli.Printer (printResults)
 import System.Random
@@ -46,6 +50,28 @@ randomWorkers num jobChannel = do
         job <- Deli.readChannel jobChannel
         Deli.writeChannel workerQueue job
 
+leastWorkLeft
+    :: Int
+    -> Channel JobTiming
+    -> Deli JobTiming ()
+leastWorkLeft num jobChannel = do
+    chans :: [Channel JobTiming] <- replicateM num createWorker
+    let workQueue :: PQueue.MinPQueue Deli.Duration (Deli.Channel JobTiming)
+        workQueue = PQueue.fromList [(0 :: Deli.Duration, c) | c <- chans]
+        mFun lastTime nowTime k = max 0 (k - coerce (nowTime - lastTime))
+        loop :: PQueue.MinPQueue Deli.Duration (Deli.Channel JobTiming) -> Deli.Time -> Deli JobTiming ()
+        loop prevQueue prevTime = do
+            job <- Deli.readChannel jobChannel
+            newTime <- Deli.now
+            let !adjustedQueue = PQueue.mapKeysMonotonic (mFun prevTime newTime) prevQueue
+                (shortestPrevDuration, shortestQueue) = PQueue.findMin adjustedQueue
+                !deletedMin = PQueue.deleteMin adjustedQueue
+                !addedBack = PQueue.insert (shortestPrevDuration + _jobDuration job) shortestQueue deletedMin
+            Deli.writeChannel shortestQueue job
+            loop (PQueue.seqSpine addedBack addedBack) newTime
+    now <- Deli.now
+    loop workQueue now
+
 loadBalancerExample :: IO ()
 loadBalancerExample = do
     simulationGen <- newStdGen
@@ -57,14 +83,17 @@ loadBalancerExample = do
     -- time of 3 milliseconds (0.03 seconds) (alpha is set to 1.16 inside this
     -- function)
         serviceTimes = Deli.Random.durationParetoDistribution 0.5
-        jobs = take 1000000 $ Deli.Random.distributionToJobs arrivals serviceTimes inputGen
+        jobs = take 20000 $ Deli.Random.distributionToJobs arrivals serviceTimes inputGen
         roundRobinRes = Deli.simulate simulationGen jobs (roundRobinWorkers (1018 * 8))
         randomRes = Deli.simulate simulationGen jobs (randomWorkers (1018 * 8))
+        leastWorkLeftRes = Deli.simulate simulationGen jobs (leastWorkLeft (1018 * 8))
 
     putStrLn "## Round Robin ##"
     printResults roundRobinRes
     putStrLn "## Random ##"
     printResults randomRes
+    putStrLn "## LeastWorkLeft ##"
+    printResults leastWorkLeftRes
     newline
 
     where newline = putStrLn "\n"

deli.cabal

@@ -74,17 +74,19 @@ executable load-balancer
                      , bytestring
                      , containers
                      , deli
+                     , deepseq
                      , lens
                      , monad-loops
                      , mtl
                      , parallel
+                     , pqueue
                      , random
                      , random-fu
                      , random-source
                      , tdigest
                      , time
   default-language:    Haskell2010
-  ghc-options:         -threaded -rtsopts -with-rtsopts=-N -O1
+  ghc-options:         -O1
 
 
 source-repository head