-- |
--   Module      :  Data.Edison.Coll.Utils
--   Copyright   :  Copyright (c) 1998 Chris Okasaki
--   License     :  MIT; see COPYRIGHT file for terms and conditions
--
--   Maintainer  :  robdockins AT fastmail DOT fm
--   Stability   :  stable
--   Portability :  GHC, Hugs (MPTC and FD)
--
--   This module provides implementations of several useful operations
--   that are not included in the collection classes themselves.  This is
--   usually because the operation involves transforming a collection into a
--   different type of collection; such operations cannot be typed using
--   the collection classes without significantly complicating them.
--
--   Be aware that these functions are defined using the external class
--   interfaces and may be less efficient than corresponding, but more
--   restrictively typed, functions in the collection classes.

module Data.Edison.Coll.Utils where

import Prelude hiding (map,null,foldr,foldl,foldr1,foldl1,lookup,filter)
import Data.Edison.Coll


-- | Apply a function across all the elements in a collection and transform
--   the collection type.
map :: (Coll cin a, CollX cout b) => (a -> b) -> (cin -> cout)
map :: forall cin a cout b.
(Coll cin a, CollX cout b) =>
(a -> b) -> cin -> cout
map a -> b
f cin
xs = forall c a b. Coll c a => (a -> b -> b) -> b -> c -> b
fold (\a
x cout
ys -> forall c a. CollX c a => a -> c -> c
insert (a -> b
f a
x) cout
ys) forall c a. CollX c a => c
empty cin
xs


-- | Map a partial function across all elements of a collection and transform
--   the collection type.
mapPartial :: (Coll cin a, CollX cout b) => (a -> Maybe b) -> (cin -> cout)
mapPartial :: forall cin a cout b.
(Coll cin a, CollX cout b) =>
(a -> Maybe b) -> cin -> cout
mapPartial a -> Maybe b
f cin
xs = forall c a b. Coll c a => (a -> b -> b) -> b -> c -> b
fold (\ a
x cout
ys -> case a -> Maybe b
f a
x of
                                    Just b
y -> forall c a. CollX c a => a -> c -> c
insert b
y cout
ys
                                    Maybe b
Nothing -> cout
ys)
                       forall c a. CollX c a => c
empty cin
xs


-- | Map a monotonic function across all the elements of a collection and
--   transform the collection type.   The function is required to satisfy
--   the following precondition:
--
-- > forall x y. x < y ==> f x < f y
unsafeMapMonotonic :: (OrdColl cin a, OrdCollX cout b) => (a -> b) -> (cin -> cout)
unsafeMapMonotonic :: forall cin a cout b.
(OrdColl cin a, OrdCollX cout b) =>
(a -> b) -> cin -> cout
unsafeMapMonotonic a -> b
f cin
xs = forall c a b. OrdColl c a => (a -> b -> b) -> b -> c -> b
foldr (forall c a. OrdCollX c a => a -> c -> c
unsafeInsertMin forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) forall c a. CollX c a => c
empty cin
xs


-- | Map a collection-producing function across all elements of a collection
--   and collect the results together using 'union'.
unionMap :: (Coll cin a, CollX cout b) => (a -> cout) -> (cin -> cout)
unionMap :: forall cin a cout b.
(Coll cin a, CollX cout b) =>
(a -> cout) -> cin -> cout
unionMap a -> cout
f cin
xs = forall c a b. Coll c a => (a -> b -> b) -> b -> c -> b
fold (\a
x cout
ys -> forall c a. CollX c a => c -> c -> c
union (a -> cout
f a
x) cout
ys) forall c a. CollX c a => c
empty cin
xs