{- |
    Module      :  $Header$
    Description :  Auxiliary functions
    Copyright   :  (c) 2001 - 2003 Wolfgang Lux
                       2011 - 2015 Björn Peemöler
    License     :  BSD-3-clause

    Maintainer  :  bjp@informatik.uni-kiel.de
    Stability   :  experimental
    Portability :  portable

   The module Utils provides a few simple functions that are
   commonly used in the compiler, but not implemented in the Haskell
   Prelude or standard library.
-}

module Base.Utils
  ( (++!), foldr2, mapAccumM, findDouble, concatMapM, findMultiples
  ) where

import Data.List (partition)

infixr 5 ++!

-- The function (++!) is variant of the list concatenation operator (++)
-- that ignores the second argument if the first is a non-empty list.
-- When lists are used to encode non-determinism in Haskell,
-- this operator has the same effect as the cut operator in Prolog,
-- hence the ! in the name.

(++!) :: [a] -> [a] -> [a]
xs ++! ys = if null xs then ys else xs

-- Fold operations with two arguments lists can be defined using
-- zip and foldl or foldr, resp. Our definitions are unfolded for
-- efficiency reasons.
-- foldl2 :: (a -> b -> c -> a) -> a -> [b] -> [c] -> a
-- foldl2 _ z []       _        = z
-- foldl2 _ z _        []       = z
-- foldl2 f z (x : xs) (y : ys) = foldl2 f (f z x y) xs ys

foldr2 :: (a -> b -> c -> c) -> c -> [a] -> [b] -> c
foldr2 _ z []       _        = z
foldr2 _ z _        []       = z
foldr2 f z (x : xs) (y : ys) = f x y (foldr2 f z xs ys)

-- The function 'mapAccumM' is a generalization of mapAccumL to monads
-- like foldM is for foldl.
mapAccumM :: Monad m => (a -> b -> m (a, c)) -> a -> [b] -> m (a, [c])
mapAccumM _ s []       = return (s, [])
mapAccumM f s (x : xs) = do
  (s' , y ) <- f s x
  (s'', ys) <- mapAccumM f s' xs
  return (s'', y : ys)

-- The function 'concatMapM' is a generalization of concatMap to monads
-- like foldM is for foldl.
concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM f xs = mapM f xs >>= return . concat

-- The function 'findDouble' checks whether a list of entities is linear,
-- i.e., if every entity in the list occurs only once. If it is non-linear,
-- the first offending object is returned.
findDouble :: Eq a => [a] -> Maybe a
findDouble []   = Nothing
findDouble (x : xs)
  | x `elem` xs = Just x
  | otherwise   = findDouble xs

findMultiples :: Eq a => [a] -> [[a]]
findMultiples []       = []
findMultiples (x : xs)
  | null same = multiples
  | otherwise = (x : same) : multiples
  where (same, other) = partition (==x) xs
        multiples     = findMultiples other