From: Nathaniel Wesley Filardo <nwf@cs.jhu.edu>
Date: Sun, 9 Dec 2012 22:50:18 +0000 (-0500)
Subject: Add mapUpsert to XXX.DataUtils
X-Git-Url: https://hydra-www.ietfng.org/gitweb/?a=commitdiff_plain;h=6635ea203fba66a72e744cacfa9750b51b42edcc;p=dyna2

Add mapUpsert to XXX.DataUtils
---

diff --git a/src/Dyna/XXX/DataUtils.hs b/src/Dyna/XXX/DataUtils.hs
index 1c83689..d7483fb 100644
--- a/src/Dyna/XXX/DataUtils.hs
+++ b/src/Dyna/XXX/DataUtils.hs
@@ -2,6 +2,8 @@ module Dyna.XXX.DataUtils (
   -- * 'Data.Map' utilities
   -- ** Quantification
   mapExists, mapForall,
+  -- ** Upsertion
+  mapUpsert,
   -- * 'Data.Set' utilities
   -- ** Quantification
   setExists, setForall
@@ -18,3 +20,18 @@ mapExists p m = M.foldrWithKey (\k v -> (|| p k v)) False m
 setForall, setExists :: (a -> Bool) -> S.Set a -> Bool
 setForall p s = S.fold (\e -> (&& p e)) True  s
 setExists p s = S.fold (\e -> (|| p e)) False s
+
+-- | Conditional insertion
+--
+-- @mapUpsert k v m@ attempts to insert @v@ at key @k@ in @m@ and will
+-- either return @Right m'@, if @k@ previously had no value or if the old
+-- value was '==' to @v@, or @Left v@ if @k@ was occupied by a different
+-- value.
+mapUpsert :: (Ord k, Eq v)
+          => k -> v
+          -> M.Map k v
+          -> Either v (M.Map k v)
+mapUpsert k v m =
+ let (mo, m') = M.insertLookupWithKey (\_ _ _ -> v) k v m
+     r        = Right m'
+ in maybe r (\o -> if o == v then r else Left o) mo