Improve intersection test--fails sometimes

src/FoldableHelp.hs

@@ -1,5 +1,7 @@
+{-# LANGUAGE TupleSections #-}
 module FoldableHelp
     ( safeMinimumOn
+    , safeMinimumOnMaybe
     , module Data.Foldable
     )
     where
@@ -7,17 +9,26 @@ import Data.Foldable
 
 -- TODO check up whether and how it is necessary to specialise this
 -- | A version of 'minimum' where the comparison is done on some extracted value.
---   Returns Nothing if the list is empty. Only calls the function once per element.
+--   Returns Nothing if the list is empty. Only calls the function once per element (not true).
 --
 -- > safeMinimumOn id [] == Nothing
 -- > safeMinimumOn length ["test","extra","a"] == Just "a"
 safeMinimumOn :: (Foldable t,Ord b) => (a -> b) -> t a -> Maybe a
+{-# INLINE safeMinimumOn #-}
 safeMinimumOn f = foldl' g Nothing
   where
     g (Just x) y 
         | f x < f y = Just x
         | otherwise = Just y
     g Nothing y = Just y
+safeMinimumOnMaybe :: (Ord b) => (a -> Maybe b) -> [a] -> Maybe a
+safeMinimumOnMaybe f ys = fst <$> go Nothing ys
+  where
+    go Nothing (x:xs) = go ((x ,) <$> f x) xs
+    go (Just (y,cmin)) (x:xs) = case f x of
+        Just v | v < cmin -> go (Just (x,v)) xs
+        _                 -> go (Just (y,cmin)) xs
+    go m _ = m
 --{- | Partial. -}
 --minimumOn :: Ord b => (a -> b) -> [a] -> a
 --minimumOn f [] = error "tried to take minimumOn of empty list"