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

    Maintainer  :  fte@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
  ( fst3, snd3, thd3, curry3, uncurry3
  , (++!), foldr2, mapAccumM, findDouble, findMultiples
  ) where

import Control.Monad (MonadPlus, mzero, mplus)

import Data.List     (partition)

infixr 5 ++!

-- The Prelude does not contain standard functions for triples.
-- We provide projection, (un-)currying, and mapping for triples here.

fst3 :: (a, b, c) -> a
fst3 :: (a, b, c) -> a
fst3 (x :: a
x, _, _) = a
x

snd3 :: (a, b, c) -> b
snd3 :: (a, b, c) -> b
snd3 (_, y :: b
y, _) = b
y

thd3 :: (a, b, c) -> c
thd3 :: (a, b, c) -> c
thd3 (_, _, z :: c
z) = c
z

curry3 :: ((a, b, c) -> d) -> a -> b -> c -> d
curry3 :: ((a, b, c) -> d) -> a -> b -> c -> d
curry3 f :: (a, b, c) -> d
f x :: a
x y :: b
y z :: c
z = (a, b, c) -> d
f (a
x,b
y,c
z)

uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 f :: a -> b -> c -> d
f (x :: a
x, y :: b
y, z :: c
z) = a -> b -> c -> d
f a
x b
y c
z

-- 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 :: [a]
xs ++! :: [a] -> [a] -> [a]
++! ys :: [a]
ys = if [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
xs then [a]
ys else [a]
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 :: (a -> b -> c -> c) -> c -> [a] -> [b] -> c
foldr2 _ z :: c
z []       _        = c
z
foldr2 _ z :: c
z _        []       = c
z
foldr2 f :: a -> b -> c -> c
f z :: c
z (x :: a
x : xs :: [a]
xs) (y :: b
y : ys :: [b]
ys) = a -> b -> c -> c
f a
x b
y ((a -> b -> c -> c) -> c -> [a] -> [b] -> c
forall a b c. (a -> b -> c -> c) -> c -> [a] -> [b] -> c
foldr2 a -> b -> c -> c
f c
z [a]
xs [b]
ys)

mapAccumM :: (Monad m, MonadPlus p) => (acc -> x -> m (acc, y)) -> acc -> [x]
          -> m (acc, p y)
mapAccumM :: (acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, p y)
mapAccumM _ z :: acc
z [] = (acc, p y) -> m (acc, p y)
forall (m :: * -> *) a. Monad m => a -> m a
return (acc
z, p y
forall (m :: * -> *) a. MonadPlus m => m a
mzero)
mapAccumM f :: acc -> x -> m (acc, y)
f z :: acc
z (x :: x
x:xs :: [x]
xs) = do
  (z' :: acc
z', y :: y
y) <- acc -> x -> m (acc, y)
f acc
z x
x
  (z'' :: acc
z'', ys :: p y
ys) <- (acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, p y)
forall (m :: * -> *) (p :: * -> *) acc x y.
(Monad m, MonadPlus p) =>
(acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, p y)
mapAccumM acc -> x -> m (acc, y)
f acc
z' [x]
xs
  (acc, p y) -> m (acc, p y)
forall (m :: * -> *) a. Monad m => a -> m a
return (acc
z'', y -> p y
forall (m :: * -> *) a. Monad m => a -> m a
return y
y p y -> p y -> p y
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` p y
ys)

-- 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 :: [a] -> Maybe a
findDouble []   = Maybe a
forall a. Maybe a
Nothing
findDouble (x :: a
x : xs :: [a]
xs)
  | a
x a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
xs = a -> Maybe a
forall a. a -> Maybe a
Just a
x
  | Bool
otherwise   = [a] -> Maybe a
forall a. Eq a => [a] -> Maybe a
findDouble [a]
xs

findMultiples :: Eq a => [a] -> [[a]]
findMultiples :: [a] -> [[a]]
findMultiples []       = []
findMultiples (x :: a
x : xs :: [a]
xs)
  | [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
same = [[a]]
multiples
  | Bool
otherwise = (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
same) [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [[a]]
multiples
  where (same :: [a]
same, other :: [a]
other) = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
x) [a]
xs
        multiples :: [[a]]
multiples     = [a] -> [[a]]
forall a. Eq a => [a] -> [[a]]
findMultiples [a]
other