fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

More sophisticated submission distribution

Browse Source 
Fixes #77
This commit is contained in:
Gregor Kleen 2018-08-17 16:57:57 +02:00
parent 7686996214
commit 508ed2ecd9
10 changed files with 185 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
db.hs
View File

@ -267,8 +267,8 @@ fillDb = do
, sheetSolutionFrom = Nothing
}
void . insert $ SheetEdit jost now sh1
void . insert $ SheetCorrector jost sh1 (Load (Just True) 0)
void . insert $ SheetCorrector gkleen sh1 (Load (Just True) 1)
void . insert $ SheetCorrector jost sh1 (Load (Just True) 0) CorrectorNormal
void . insert $ SheetCorrector gkleen sh1 (Load (Just True) 1) CorrectorNormal
h102 <- insertFile "H10-2.hs"
h103 <- insertFile "H10-3.hs"
pdf10 <- insertFile "ProMo_Uebung10.pdf"

5
messages/uniworx/de.msg
View File

@ -160,6 +160,7 @@ SheetCorrectorsTitle tid@TermId courseShortHand@CourseShorthand sheetName@SheetN
CountTutProp: Tutorien zählen gegen Proportion
Corrector: Korrektor
Correctors: Korrektoren
CorState: Status
CorByTut: Nach Tutorium
CorProportion: Anteil
DeleteRow: Zeile entfernen
@ -264,3 +265,7 @@ SubmissionDoesNotExist smid@CryptoFileNameSubmission: Es existiert keine Abgabe
LDAPLoginTitle: Campus-Login
DummyLoginTitle: Development-Login
CorrectorNormal: Normal
CorrectorMissing: Abwesend
CorrectorExcused: Entschuldigt

1
models
View File

@ -115,6 +115,7 @@ SheetCorrector
user UserId
sheet SheetId
load Load
state CorrectorState default='Normal'
UniqueSheetCorrector user sheet
deriving Show Eq Ord
SheetFile

1
package.yaml
View File

@ -90,6 +90,7 @@ dependencies:
- connection
- universe
- universe-base
- random-shuffle
# The library contains all of our application code. The executable
# defined below is just a thin wrapper.

15
src/Foundation.hs
View File

@ -196,6 +196,13 @@ instance RenderMessage UniWorX SheetFileType where
SheetMarking -> renderMessage' MsgSheetMarking
where renderMessage' = renderMessage foundation ls
instance RenderMessage UniWorX CorrectorState where
renderMessage foundation ls = \case
CorrectorNormal -> renderMessage' MsgCorrectorNormal
CorrectorMissing -> renderMessage' MsgCorrectorMissing
CorrectorExcused -> renderMessage' MsgCorrectorExcused
where renderMessage' = renderMessage foundation ls
instance RenderMessage UniWorX (UnsupportedAuthPredicate (Route UniWorX)) where
renderMessage f ls (UnsupportedAuthPredicate tag route) = renderMessage f ls $ MsgUnsupportedAuthPredicate tag (show route)
@ -903,6 +910,14 @@ pageActions (CSheetR tid csh shn SShowR) =
, menuItemAccessCallback' = return True
}
]
pageActions (CSheetR tid csh shn SSubsR) =
[ PageActionPrime $ MenuItem
{ menuItemLabel = "Korrektoren"
, menuItemIcon = Nothing
, menuItemRoute = CSheetR tid csh shn SCorrR
, menuItemAccessCallback' = return True
}
]
pageActions (CSubmissionR tid csh shn cid SubShowR) =
[ PageActionPrime $ MenuItem
{ menuItemLabel = "Korrektur"

34
src/Handler/Sheet.hs
View File

@ -502,11 +502,11 @@ insertSheetFile' sid ftype fs = do
data CorrectorForm = CorrectorForm
{ cfUserId :: UserId
, cfUserName :: Text
, cfResult :: FormResult Load
, cfViewByTut, cfViewProp, cfViewDel :: FieldView UniWorX
, cfResult :: FormResult (CorrectorState, Load)
, cfViewByTut, cfViewProp, cfViewDel, cfViewState :: FieldView UniWorX
}
type Loads = Map UserId Load
type Loads = Map UserId (CorrectorState, Load)
defaultLoads :: SheetId -> DB Loads
-- ^ Generate `Loads` in such a way that minimal editing is required
@ -526,10 +526,10 @@ defaultLoads shid = do
E.orderBy [E.desc creationTime]
return (sheetCorrector E.^. SheetCorrectorUser, sheetCorrector E.^. SheetCorrectorLoad)
return (sheetCorrector E.^. SheetCorrectorUser, sheetCorrector E.^. SheetCorrectorLoad, sheetCorrector E.^. SheetCorrectorState)
where
toMap :: [(E.Value UserId, E.Value Load)] -> Loads
toMap = foldMap $ \(E.Value uid, E.Value load) -> Map.singleton uid load
toMap :: [(E.Value UserId, E.Value Load, E.Value CorrectorState)] -> Loads
toMap = foldMap $ \(E.Value uid, E.Value load, E.Value state) -> Map.singleton uid (state, load)
correctorForm :: SheetId -> MForm Handler (FormResult (Set SheetCorrector), [FieldView UniWorX])
@ -544,19 +544,19 @@ correctorForm shid = do
formCIDs <- mapM decrypt =<< catMaybes <$> liftHandlerT (map fromPathPiece <$> lookupPostParams cListIdent :: Handler [Maybe CryptoUUIDUser])
let
currentLoads :: DB Loads
currentLoads = Map.fromList . map (\(Entity _ SheetCorrector{..}) -> (sheetCorrectorUser, sheetCorrectorLoad)) <$> selectList [ SheetCorrectorSheet ==. shid ] []
currentLoads = foldMap (\(Entity _ SheetCorrector{..}) -> Map.singleton sheetCorrectorUser (sheetCorrectorState, sheetCorrectorLoad)) <$> selectList [ SheetCorrectorSheet ==. shid ] []
(defaultLoads', currentLoads') <- lift . runDB $ (,) <$> defaultLoads shid <*> currentLoads
loads' <- fmap (Map.fromList [(uid, mempty) | uid <- formCIDs] `Map.union`) $ if
loads' <- fmap (Map.fromList [(uid, (CorrectorNormal, mempty)) | uid <- formCIDs] `Map.union`) $ if
| Map.null currentLoads'
, null formCIDs -> defaultLoads' <$ when (not $ Map.null defaultLoads') (addMessageI "warning" MsgCorrectorsDefaulted)
| otherwise -> return $ Map.fromList (map (, mempty) formCIDs) `Map.union` currentLoads'
| otherwise -> return $ Map.fromList (map (, (CorrectorNormal, mempty)) formCIDs) `Map.union` currentLoads'
deletions <- lift $ foldM (\dels uid -> maybe (Set.insert uid dels) (const dels) <$> guardNonDeleted uid) Set.empty (Map.keys loads')
let loads'' = Map.restrictKeys loads' (Map.keysSet loads' `Set.difference` deletions)
didDelete = any (flip Set.member deletions) formCIDs
(countTutRes, countTutView) <- mreq checkBoxField (fsm MsgCountTutProp) . Just $ any (\Load{..} -> fromMaybe False byTutorial) $ Map.elems loads'
(countTutRes, countTutView) <- mreq checkBoxField (fsm MsgCountTutProp) . Just $ any (\(_, Load{..}) -> fromMaybe False byTutorial) $ Map.elems loads'
let
tutorField :: Field Handler [UserEmail]
tutorField = convertField (map CI.mk) (map CI.original) $ multiEmailField
@ -586,7 +586,7 @@ correctorForm shid = do
case mUid of
Nothing -> loads'' <$ addMessageI "error" (MsgEMailUnknown email)
Just uid
| not (Map.member uid loads') -> return $ Map.insert uid mempty loads''
| not (Map.member uid loads') -> return $ Map.insert uid (CorrectorNormal, mempty) loads''
| otherwise -> loads'' <$ addMessageI "warning" (MsgCorrectorExists email)
FormFailure errs -> loads'' <$ mapM_ (addMessage "error" . toHtml) errs
_ -> return loads''
@ -598,8 +598,8 @@ correctorForm shid = do
return $ (user E.^. UserId, user E.^. UserDisplayName)
let
constructFields :: (UserId, Text, Load) -> MForm Handler CorrectorForm
constructFields (uid, uname, Load{..}) = do
constructFields :: (UserId, Text, (CorrectorState, Load)) -> MForm Handler CorrectorForm
constructFields (uid, uname, (state, Load{..})) = do
cID@CryptoID{..} <- encrypt uid :: MForm Handler CryptoUUIDUser
let
fs name = ""
@ -607,12 +607,13 @@ correctorForm shid = do
}
rationalField = convertField toRational fromRational doubleField
(stateRes, cfViewState) <- mreq (selectField $ optionsFinite id) (fs "state") (Just state)
(byTutRes, cfViewByTut) <- mreq checkBoxField (fs "bytut") (Just $ isJust byTutorial)
(propRes, cfViewProp) <- mreq (checkBool (>= 0) MsgProportionNegative $ rationalField) (fs "prop") (Just byProportion)
(_, cfViewDel) <- mreq checkBoxField (fs "del") (Just False)
let
cfResult :: FormResult Load
cfResult = Load <$> tutRes' <*> propRes
cfResult :: FormResult (CorrectorState, Load)
cfResult = (,) <$> stateRes <*> (Load <$> tutRes' <*> propRes)
tutRes'
| FormSuccess True <- byTutRes = Just <$> countTutRes
| otherwise = Nothing <$ byTutRes
@ -629,6 +630,7 @@ correctorForm shid = do
let
corrColonnade = mconcat
[ headed (Yesod.textCell $ mr MsgCorrector) $ \CorrectorForm{..} -> Yesod.textCell cfUserName
, headed (Yesod.textCell $ mr MsgCorState) $ \CorrectorForm{..} -> Yesod.cell $ fvInput cfViewState
, headed (Yesod.textCell $ mr MsgCorByTut) $ \CorrectorForm{..} -> Yesod.cell $ fvInput cfViewByTut
, headed (Yesod.textCell $ mr MsgCorProportion) $ \CorrectorForm{..} -> Yesod.cell $ fvInput cfViewProp
, headed (Yesod.textCell $ mr MsgDeleteRow) $ \CorrectorForm{..} -> Yesod.cell $ fvInput cfViewDel
@ -637,7 +639,7 @@ correctorForm shid = do
| FormSuccess (Just es) <- addTutRes
, not $ null es = FormMissing
| didDelete = FormMissing
| otherwise = fmap Set.fromList $ sequenceA [ SheetCorrector <$> pure cfUserId <*> pure shid <*> cfResult
| otherwise = fmap Set.fromList $ sequenceA [ SheetCorrector <$> pure cfUserId <*> pure shid <*> (snd <$> cfResult) <*> (fst <$> cfResult)
| CorrectorForm{..} <- corrData
]
idField CorrectorForm{..} = do

12
src/Handler/Utils/Form.hs
View File

@ -377,6 +377,18 @@ optionsPersistCryptoId filts ords toDisplay = fmap mkOptionList $ do
, optionExternalValue = toPathPiece (cId :: CryptoID UUID (Key a))
}) cPairs
optionsFinite :: ( MonadHandler m, Finite a, RenderMessage site msg, HandlerSite m ~ site, PathPiece a )
=> (a -> msg) -> m (OptionList a)
optionsFinite toMsg = do
mr <- getMessageRender
let
mkOption a = Option
{ optionDisplay = mr $ toMsg a
, optionInternalValue = a
, optionExternalValue = toPathPiece a
}
return . mkOptionList $ mkOption <$> universeF
mforced :: (site ~ HandlerSite m, MonadHandler m)
=> Field m a -> FieldSettings site -> a -> MForm m (FormResult a, FieldView site)
mforced Field{..} FieldSettings{..} val = do

139
src/Handler/Utils/Submission.hs
View File

@ -25,6 +25,7 @@ module Handler.Utils.Submission
) where
import Import hiding ((.=), joinPath)
import Prelude (lcm)
import Yesod.Core.Types (HandlerContents(..), ErrorResponse(..))
import Control.Lens
@ -32,9 +33,10 @@ import Control.Lens.Extras (is)
import Utils.Lens
import Control.Monad.State hiding (forM_, mapM_,foldM)
import Control.Monad.Writer (MonadWriter(..))
import Control.Monad.Writer (MonadWriter(..), execWriterT)
import Control.Monad.RWS.Lazy (RWST)
import qualified Control.Monad.Random as Rand
import qualified System.Random.Shuffle as Rand (shuffleM)
import Data.Maybe
@ -45,11 +47,12 @@ import Data.Map (Map, (!?))
import qualified Data.Map as Map
import qualified Data.Text as Text
import Data.Ratio
import Data.CaseInsensitive (CI)
import qualified Data.CaseInsensitive as CI
import Data.Monoid (Monoid, Any(..))
import Data.Monoid (Monoid, Any(..), Sum(..))
import Generics.Deriving.Monoid (memptydefault, mappenddefault)
import Handler.Utils.Rating hiding (extractRatings)
@ -84,46 +87,126 @@ assignSubmissions :: SheetId -- ^ Sheet do distribute to correction
, Set SubmissionId -- ^ unassigend submissions (no tutors by load)
)
assignSubmissions sid restriction = do
correctors <- selectList [SheetCorrectorSheet ==. sid] []
let corrsGroup = filter hasTutorialLoad correctors -- needed as List within Esqueleto
let corrsProp = filter hasPositiveLoad correctors
let countsToLoad' :: UserId -> Bool
countsToLoad' uid = -- refactor by simply using Map.(!)
fromMaybe (error "Called `countsToLoad'` on entity not element of `corrsGroup`") $
Map.lookup uid loadMap
loadMap :: Map UserId Bool
loadMap = Map.fromList [(sheetCorrectorUser,b) | Entity _ SheetCorrector{ sheetCorrectorLoad = (Load {byTutorial = Just b}), .. } <- corrsGroup]
Sheet{..} <- getJust sid
correctors <- selectList [ SheetCorrectorSheet ==. sid, SheetCorrectorState ==. CorrectorNormal ] []
let
byTutorial' uid = join . Map.lookup uid $ Map.fromList [ (sheetCorrectorUser, byTutorial sheetCorrectorLoad) | Entity _ SheetCorrector{..} <- corrsTutorial ]
corrsTutorial = filter hasTutorialLoad correctors -- needed as List within Esqueleto
corrsProp = filter hasPositiveLoad correctors
countsToLoad' :: UserId -> Bool
countsToLoad' uid = Map.findWithDefault True uid loadMap
loadMap :: Map UserId Bool
loadMap = Map.fromList [(sheetCorrectorUser,b) | Entity _ SheetCorrector{ sheetCorrectorLoad = (Load {byTutorial = Just b}), .. } <- corrsTutorial]
subs <- E.select . E.from $ \(submission `E.LeftOuterJoin` user) -> do
currentSubs <- E.select . E.from $ \(submission `E.LeftOuterJoin` tutor) -> do
let tutors = E.subList_select . E.from $ \(submissionUser `E.InnerJoin` tutorialUser `E.InnerJoin` tutorial) -> do
-- Uncomment next line for equal chance between tutors, irrespective of the number of students per tutor per submission group
-- E.distinctOn [E.don $ tutorial E.^. TutorialTutor] $ do
E.on (tutorial E.^. TutorialId E.==. tutorialUser E.^. TutorialUserTutorial)
E.on (submissionUser E.^. SubmissionUserUser E.==. tutorialUser E.^. TutorialUserUser)
E.where_ (tutorial E.^. TutorialTutor `E.in_` E.valList (map (sheetCorrectorUser . entityVal) corrsGroup))
E.where_ (tutorial E.^. TutorialTutor `E.in_` E.valList (map (sheetCorrectorUser . entityVal) corrsTutorial))
return $ tutorial E.^. TutorialTutor
E.on $ user E.?. UserId `E.in_` E.justList tutors
E.on $ tutor E.?. UserId `E.in_` E.justList tutors
E.where_ $ submission E.^. SubmissionSheet E.==. E.val sid
E.&&. maybe (E.val True) (submission E.^. SubmissionId `E.in_`) (E.valList . Set.toList <$> restriction)
E.orderBy [E.rand] -- randomize for fair tutor distribution
return (submission E.^. SubmissionId, user) -- , listToMaybe tutors)
return (submission E.^. SubmissionId, tutor)
queue <- liftIO . Rand.evalRandIO . sequence . repeat $ Rand.weightedMay [ (sheetCorrectorUser, byProportion sheetCorrectorLoad) | Entity _ SheetCorrector{..} <- corrsProp]
let subTutor' :: Map SubmissionId (Set UserId)
subTutor' = Map.fromListWith Set.union $ currentSubs
& mapped._2 %~ maybe Set.empty Set.singleton
& mapped._2 %~ Set.mapMonotonic entityKey
& mapped._1 %~ E.unValue
let subTutor' :: Map SubmissionId (Maybe UserId)
subTutor' = Map.fromListWith (<|>) $ map (over (_2.traverse) entityKey . over _1 E.unValue) subs
prevSubs <- E.select . E.from $ \((sheet `E.InnerJoin` sheetCorrector) `E.LeftOuterJoin` submission) -> do
E.on $ E.joinV (submission E.?. SubmissionRatingBy) E.==. E.just (sheetCorrector E.^. SheetCorrectorUser)
E.on $ sheetCorrector E.^. SheetCorrectorSheet E.==. sheet E.^. SheetId
let isByTutorial = E.exists . E.from $ \(submissionUser `E.InnerJoin` tutorialUser `E.InnerJoin` tutorial) -> do
E.on $ tutorial E.^. TutorialId E.==. tutorialUser E.^. TutorialUserTutorial
E.on $ submissionUser E.^. SubmissionUserUser E.==. tutorialUser E.^. TutorialUserUser
E.where_ $ tutorial E.^. TutorialTutor E.==. sheetCorrector E.^. SheetCorrectorUser
E.&&. submission E.?. SubmissionId E.==. E.just (submissionUser E.^. SubmissionUserSubmission)
E.where_ $ sheet E.^. SheetCourse E.==. E.val sheetCourse
E.&&. sheetCorrector E.^. SheetCorrectorUser `E.in_` E.valList (map (sheetCorrectorUser . entityVal) correctors)
return (sheetCorrector, isByTutorial, E.isNothing (submission E.?. SubmissionId))
subTutor <- fmap fst . flip execStateT (Map.empty, queue) . forM_ (Map.toList subTutor') $ \case
(smid, Just tutid) -> do
let
prevSubs' :: Map SheetId (Map UserId (Rational, Integer))
prevSubs' = Map.unionsWith (Map.unionWith $ \(prop, n) (_, n') -> (prop, n + n')) $ do
(Entity _ sc@SheetCorrector{ sheetCorrectorLoad = Load{..}, .. }, E.Value isByTutorial, E.Value isPlaceholder) <- prevSubs
guard $ maybe True (not isByTutorial ||) byTutorial
let proportion
| CorrectorExcused <- sheetCorrectorState = 0
| otherwise = byProportion
return . Map.singleton sheetCorrectorSheet $ Map.singleton sheetCorrectorUser (proportion, bool 1 0 isPlaceholder)
deficit :: Map UserId Integer
deficit = Map.filter (> 0) $ Map.foldr (Map.unionWith (+) . toDeficit) Map.empty prevSubs'
toDeficit :: Map UserId (Rational, Integer) -> Map UserId Integer
toDeficit assignments = toDeficit' <$> assignments
where
assigned' = getSum $ foldMap (Sum . snd) assignments
props = getSum $ foldMap (Sum . fst) assignments
toDeficit' (prop, assigned) = let
target = round $ fromInteger assigned' * (prop / props)
in target - assigned
$logDebugS "assignSubmissions" $ "Previous submissions: " <> tshow prevSubs'
$logDebugS "assignSubmissions" $ "Current deficit: " <> tshow deficit
let
lcd :: Integer
lcd = foldr lcm 1 $ map (denominator . byProportion . sheetCorrectorLoad . entityVal) corrsProp
wholeProps :: Map UserId Integer
wholeProps = Map.fromList [ ( sheetCorrectorUser, round $ byProportion * fromInteger lcd ) | Entity _ SheetCorrector{ sheetCorrectorLoad = Load{..}, .. } <- corrsProp ]
detQueueLength = fromIntegral (Map.size $ Map.filter (\tuts -> all countsToLoad' tuts) subTutor') - sum deficit
detQueue = concat . List.genericReplicate (detQueueLength `div` sum wholeProps) . concatMap (uncurry $ flip List.genericReplicate) $ Map.toList wholeProps
$logDebugS "assignSubmissions" $ "Deterministic Queue: " <> tshow detQueue
queue <- liftIO . Rand.evalRandIO . execWriterT $ do
tell . map Just =<< Rand.shuffleM detQueue
forever $
tell . pure =<< Rand.weightedMay [ (sheetCorrectorUser, byProportion sheetCorrectorLoad) | Entity _ SheetCorrector{..} <- corrsProp ]
$logDebugS "assignSubmissions" $ "Queue: " <> tshow (take (Map.size subTutor') queue)
let
assignSubmission :: MonadState (Map SubmissionId UserId, [Maybe UserId], Map UserId Integer) m => Bool -> SubmissionId -> UserId -> m ()
assignSubmission countsToLoad smid tutid = do
_1 %= Map.insert smid tutid
when (any ((== tutid) . sheetCorrectorUser . entityVal) corrsProp && countsToLoad' tutid) $
_3 . at tutid %= assertM' (> 0) . maybe (-1) pred
when countsToLoad $
_2 %= List.delete (Just tutid)
(smid, Nothing) -> do
(q:qs) <- use _2
_2 .= qs
case q of
Just q -> _1 %= Map.insert smid q
Nothing -> return () -- NOTE: throwM NoCorrectorsByProportion
maximumDeficit :: (MonadState (_a, _b, Map UserId Integer) m, MonadIO m) => m (Maybe UserId)
maximumDeficit = do
transposed <- uses _3 invertMap
traverse (liftIO . Rand.evalRandIO . Rand.uniform . snd) (Map.lookupMax transposed)
subTutor <- fmap (view _1) . flip execStateT (Map.empty, queue, deficit) . forM_ (Map.toList subTutor') $ \(smid, tuts) -> do
let
restrictTuts
| Set.null tuts = id
| otherwise = flip Map.restrictKeys tuts
byDeficit <- withStateT (over _3 restrictTuts) maximumDeficit
case byDeficit of
Just q' -> do
$logDebugS "assignSubmissions" $ tshow smid <> " -> " <> tshow q' <> " (byDeficit)"
assignSubmission False smid q'
Nothing
| Set.null tuts -> do
q <- preuse $ _2 . _head . _Just
case q of
Just q' -> do
$logDebugS "assignSubmissions" $ tshow smid <> " -> " <> tshow q' <> " (queue)"
assignSubmission True smid q'
Nothing -> return ()
| otherwise -> do
q <- liftIO . Rand.evalRandIO $ Rand.uniform tuts
$logDebugS "assignSubmissions" $ tshow smid <> " -> " <> tshow q <> " (tutorial)"
assignSubmission (countsToLoad' q) smid q
forM_ (Map.toList subTutor) $ \(smid, tutid) -> update smid [SubmissionRatingBy =. Just tutid]

17
src/Model/Types.hs
View File

@ -349,6 +349,23 @@ data SelDateTimeFormat = SelFormatDateTime | SelFormatDate | SelFormatTime
deriving (Eq, Ord, Read, Show, Enum, Bounded)
data CorrectorState = CorrectorNormal | CorrectorMissing | CorrectorExcused
deriving (Eq, Ord, Read, Show, Enum, Bounded)
deriveJSON defaultOptions
{ constructorTagModifier = fromJust . stripPrefix "Corrector"
} ''CorrectorState
instance Universe CorrectorState where universe = universeDef
instance Finite CorrectorState
instance PathPiece CorrectorState where
toPathPiece = $(nullaryToPathPiece ''CorrectorState [Text.intercalate "-" . map Text.toLower . unsafeTail . splitCamel])
fromPathPiece = finiteFromPathPiece
derivePersistField "CorrectorState"
-- Type synonyms
type SheetName = CI Text

5
src/Utils.hs
View File

@ -15,9 +15,7 @@ module Utils
import ClassyPrelude.Yesod
-- import Data.Double.Conversion.Text -- faster implementation for textPercent?
import Data.List (foldl)
import Data.Foldable as Fold
import qualified Data.Char as Char
import Data.CaseInsensitive (CI)
import qualified Data.CaseInsensitive as CI
@ -199,6 +197,9 @@ groupMap l = Map.fromListWith mappend $ [(k, Set.singleton v) | (k,v) <- l]
partMap :: (Ord k, Monoid v) => [(k,v)] -> Map k v
partMap = Map.fromListWith mappend
invertMap :: (Ord k, Ord v) => Map k v -> Map v (Set k)
invertMap = groupMap . map swap . Map.toList
-----------
-- Maybe --
-----------