Some simple haskell utilities

util.hs

import qualified Data.Map.Strict as M

-- The code in any functions here should be too small to really be coverable by copyright, but just in case:
{-
Copyright 2014 Daniel Martin

I, Daniel Martin, license this to you under the Apache License, Version 2.0 (the
"License"); you may not use this file except in compliance
with the License.  You may obtain a copy of the License at

  http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing,
software distributed under the License is distributed on an
"AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
KIND, either express or implied.  See the License for the
specific language governing permissions and limitations
under the License.
-}

{- Basically, anything in this file should be copied and pasted freely.
   CAVEAT USER: Don't credit me when you find it useful, and don't blame me when it
   doesn't work as expected. -}

-- | Finds those 'a's in the given 'lst' that result in the same thing when
-- passed to 'f'. It is a more efficient version of
-- '\f lst -> filter ((>= 2) . length) $ groupWith f lst'
duplicatesBy :: Ord b => (a -> b) -> [a] -> [[a]]
duplicatesBy f lst = -- filter ((>= 2) . length) $ groupWith f lst
  M.elems $ snd $ foldr pushMap (M.empty, M.empty) lst
  where
    pushMap thing (mapA, mapB) = let
      fval = f thing
      in case M.lookup fval mapA of
        Nothing -> (M.insert fval thing mapA, mapB)
        Just thing' ->
          (mapA, M.insert fval
                 (thing : M.findWithDefault [thing'] fval mapB) mapB)


-- | Finds those 'a's in the given 'lst' that result in a unique value when
-- passed to 'f'. It is a more efficient version of
-- '\f lst -> filter ((< 2) . length) $ groupWith f lst'
uniquesBy :: Ord b => (a -> b) -> [a] -> [a]
uniquesBy f lst = -- filter ((< 2) . length) $ groupWith f lst
  M.elems $ uncurry (M.differenceWith (\_ _ -> Nothing)) $
  foldl' pushMap (M.empty, M.empty) lst
  where
    pushMap (mapA, mapB) thing = let
      fval = f thing
      in case M.lookup fval mapA of
        Nothing -> (M.insert fval thing mapA, mapB)
        Just _ -> (mapA, M.insert fval () mapB)

-- | Frequently, some variant on this ends up as a local definition:
loop f x = case f x of
  Left x' -> loop f x'
  Right a -> a

-- Or its shortened version:
loop' f = either (loop' f) id . f