From 6b254dcdeb3c3da60bd09e8f6b680ee7deb40c89 Mon Sep 17 00:00:00 2001
From: Tissevert <tissevert+devel@marvid.fr>
Date: Wed, 1 Jan 2020 17:16:19 +0100
Subject: [PATCH] Write a priority queue module to handle dependencies
 efficiently

---
 SJW.cabal       |  1 +
 src/Priority.hs | 50 +++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 51 insertions(+)
 create mode 100644 src/Priority.hs

diff --git a/SJW.cabal b/SJW.cabal
index 29ad179..0381324 100644
--- a/SJW.cabal
+++ b/SJW.cabal
@@ -23,6 +23,7 @@ executable sjw
                      , Context
                      , Module
                      , Paths_SJW
+                     , Priority
   -- other-extensions:
   build-depends:       attoparsec
                      , base >=4.12 && <4.13
diff --git a/src/Priority.hs b/src/Priority.hs
new file mode 100644
index 0000000..53d225c
--- /dev/null
+++ b/src/Priority.hs
@@ -0,0 +1,50 @@
+{-# LANGUAGE NamedFieldPuns #-}
+module Priority (
+      Queue(..)
+    , empty
+    , set
+    , toList
+  ) where
+
+import Data.Map (Map)
+import qualified Data.Map as Map (
+    adjust, alter, delete, empty, insert, lookup, lookupMax
+  )
+
+data Queue a = Queue {
+      byElement :: Map a Int
+    , byRank :: Map Int [a]
+  }
+
+empty :: Queue a
+empty = Queue {byElement = Map.empty, byRank = Map.empty}
+
+set :: Ord a => a -> Int -> Queue a -> Queue a
+set x priority queue@(Queue {byElement, byRank}) =
+  case Map.lookup x byElement of
+    Nothing -> Queue {
+          byElement = Map.insert x priority byElement
+        , byRank = Map.alter (push x) priority byRank
+      }
+    Just formerPriority
+      | formerPriority >= priority -> queue
+      | otherwise -> queue {
+            byElement = Map.insert x priority byElement
+          , byRank = move x formerPriority priority byRank
+        }
+
+push :: a -> Maybe [a] -> Maybe [a]
+push a Nothing = Just [a]
+push a (Just as) = Just (a:as)
+
+move :: Eq a => a -> Int -> Int -> Map Int [a] -> Map Int [a]
+move a from to =
+  Map.alter (push a) to . Map.adjust (filter (/= a)) from
+
+toList :: Queue a -> [(Int, a)]
+toList = extract . byRank
+  where
+    extract tmpMap =
+      case Map.lookupMax tmpMap of
+        Nothing -> []
+        Just (k, elems) -> ((,) k <$> elems) ++ extract (Map.delete k tmpMap)