-- Communicating Haskell Processes.
-- Copyright (c) 2010, Neil Brown.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
-- modification, are permitted provided that the following conditions are
-- met:
--
-- * Redistributions of source code must retain the above copyright
-- notice, this list of conditions and the following disclaimer.
-- * Redistributions in binary form must reproduce the above copyright
-- notice, this list of conditions and the following disclaimer in the
-- documentation and/or other materials provided with the distribution.
-- * Neither the name of the University of Kent nor the names of its
-- contributors may be used to endorse or promote products derived from
-- this software without specific prior written permission.
--
-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
-- THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-- PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR
-- CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
module Control.Concurrent.CHP.EventSet (delete, deleteOrFail, empty, fromList, insert, intersection, member, null, toList, toMap, union) where
import Control.Arrow ((&&&))
import Control.Concurrent.CHP.EventType
import qualified Data.List as List
type ListSet k = [k]
empty :: ListSet k
empty = []
toList :: ListSet k -> [k]
toList x = x
delete :: Ord k => k -> ListSet k -> ListSet k
{-# SPECIALISE delete :: Event -> ListSet Event -> ListSet Event #-}
{-# SPECIALISE delete :: OfferSet -> ListSet OfferSet -> ListSet OfferSet #-}
delete e = delete'
where
delete' [] = []
delete' allxs@(x:xs) = case compare e x of
LT -> allxs
EQ -> xs
GT -> x : delete' xs
-- If the element is present, returns Just the set without it
-- If the element is not present, returns Nothing
deleteOrFail :: Ord k => k -> ListSet k -> Maybe (ListSet k)
{-# SPECIALISE deleteOrFail :: Event -> ListSet Event -> Maybe (ListSet Event) #-}
deleteOrFail e = deleteOrFail'
where
deleteOrFail' [] = Nothing
deleteOrFail' (x:xs) = case compare e x of
LT -> Nothing
EQ -> Just xs
GT -> case deleteOrFail' xs of
Just xs' -> Just (x : xs')
Nothing -> Nothing
member :: Ord k => k -> ListSet k -> Bool
{-# SPECIALISE member :: Event -> ListSet Event -> Bool #-}
member e = member'
where
member' [] = False
member' (x:xs) = case compare e x of
LT -> False
EQ -> True
GT -> member' xs
insert :: Ord k => k -> ListSet k -> ListSet k
{-# SPECIALISE insert :: OfferSet -> ListSet OfferSet -> ListSet OfferSet #-}
insert k = insert'
where
insert' [] = [k]
insert' allxs@(x:xs) = case compare k x of
LT -> k : allxs
EQ -> k : xs -- replace with new value
GT -> x : insert' xs
union :: Ord k => ListSet k -> ListSet k -> ListSet k
{-# SPECIALISE union :: ListSet Event -> ListSet Event -> ListSet Event #-}
union [] ys = ys
union xs [] = xs
union allxs@(x:xs) allys@(y:ys) = case compare x y of
LT -> x : union xs allys
EQ -> x : union xs ys -- left-bias
GT -> y : union allxs ys
intersection :: Ord k => ListSet k -> ListSet k -> ListSet k
{-# SPECIALISE intersection :: ListSet OfferSet -> ListSet OfferSet -> ListSet OfferSet #-}
intersection [] _ = []
intersection _ [] = []
intersection allxs@(x:xs) allys@(y:ys) = case compare x y of
LT -> intersection xs allys
EQ -> x : intersection xs ys -- left-bias
GT -> intersection allxs ys
fromList :: Ord k => [k] -> ListSet k
{-# SPECIALISE fromList :: [Event] -> ListSet Event #-}
fromList = List.sort
toMap :: (k -> v) -> [k] -> [(k, v)]
toMap f = map (id &&& f)