Skip to content

Instantly share code, notes, and snippets.

@tomjaguarpaw
Last active November 2, 2016 17:39
Show Gist options
  • Save tomjaguarpaw/0ab7157ca9eeba02c9844dc2e0e6168c to your computer and use it in GitHub Desktop.
Save tomjaguarpaw/0ab7157ca9eeba02c9844dc2e0e6168c to your computer and use it in GitHub Desktop.
traverseNubOf
-- | Traverse the structure using the traversal but memoize the
-- results of the transforming function; this means that the function
-- is called once for every unique element.
--
-- NB: I can't work out how to do this with only one optic argument,
-- but it should be possible.
--
-- prop> traverseNubOf (traverse._1) (traverse._1) (\x -> do print x; return (-x)) [(2,10),(2,20),(1,30),(1,40),(3,50),(3,60)]
-- 1
-- 2
-- 3
-- [(-2,10),(-2,20),(-1,30),(-1,40),(-3,50),(-3,60)]
traverseNubOf :: (Applicative f, Ord a)
=> L.Getting (Data.Monoid.Endo [a]) s a
-> L.ASetter s t a b
-> (a -> f b)
-> s
-> f t
traverseNubOf t1 t2 f s =
let tagMap = (traverse f
. Map.fromList
. map (\x -> (x, x))
. L.toListOf t1)
s
lookup' m k = let e = error "traverseNubOf: Missing value in map"
in Map.findWithDefault e k m
in (\m -> L.over t2 (lookup' m) s) <$> tagMap
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment