diff options
author | RobertHenderson <> | 2011-06-21 20:14:23 (GMT) |
---|---|---|
committer | Luite Stegeman <luite@luite.com> | 2011-06-21 20:14:23 (GMT) |
commit | e451b35b94e359d437717d3340f72205980b5ef7 (patch) | |
tree | 8a212dc606f2bcca31cb935787eb648ef04babe9 |
-rw-r--r-- | Control/Monad/Rosso1.hs | 59 | ||||
-rw-r--r-- | Data/Bool/Rosso1.hs | 36 | ||||
-rw-r--r-- | Data/Either/Rosso1.hs | 46 | ||||
-rw-r--r-- | Data/List/Rosso1.hs | 110 | ||||
-rw-r--r-- | Data/Map/Rosso1.hs | 49 | ||||
-rw-r--r-- | Data/Maybe/Rosso1.hs | 36 | ||||
-rw-r--r-- | Data/MultiMap/Rosso1.hs | 371 | ||||
-rw-r--r-- | Data/Set/Rosso1.hs | 35 | ||||
-rw-r--r-- | Data/Tuple/Rosso1.hs | 51 | ||||
-rw-r--r-- | LICENSE | 32 | ||||
-rw-r--r-- | Setup.hs | 2 | ||||
-rw-r--r-- | System/IO/Rosso1.hs | 32 | ||||
-rw-r--r-- | rosso.cabal | 44 |
13 files changed, 903 insertions, 0 deletions
diff --git a/Control/Monad/Rosso1.hs b/Control/Monad/Rosso1.hs new file mode 100644 index 0000000..f3ae191 --- /dev/null +++ b/Control/Monad/Rosso1.hs @@ -0,0 +1,59 @@ +{- Copyright (c) 2011 Robert Henderson +This source file is distributed under the terms of a BSD3-style +license, which can be found in the file LICENSE at the root of +this package. -} + +-- | Extends "Control.Monad" +-- +module Control.Monad.Rosso1 + (module Control.Monad + + ,nop + + ,concatMapM + ,ifM + ,whenM + + ) where + +------------------------------------------------------ +import Control.Monad + + +-- | Synonym for @return ()@ +nop :: Monad m => m () +nop = return () + + + +-- | Monadic generalisation of 'concatMap'. +concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b] +concatMapM f = liftM concat . mapM f + + +-- | Monadic generalisation of 'if'. +ifM :: Monad m => m Bool -> m a -> m a -> m a +ifM t a b = do tVal <- t + if tVal then a else b + +-- | Like 'when', but the condition is also monadic. +whenM :: Monad m => m Bool -> m () -> m () +whenM t a = do tVal <- t + when tVal a + + + +----------------------------------------------------------- +{- UNIT TESTS + +*Rosso.Monad1e> concatMapM (\ x -> do y <- [1..x]; return [1..y]) [1..3] +[[1,1,1],[1,1,1,2],[1,1,1,2,3],[1,1,2,1],[1,1,2,1,2],[1,1,2,1,2,3]] + +*Rosso.Monad1> ifM [True, False, True] "ab" "xyz" +"abxyzab" +*Rosso.Monad1> whenM [True, False, True] [] +[()] +*Rosso.Monad1> whenM [True, False, True] [(), (), ()] +[(),(),(),(),(),(),()] + +-} diff --git a/Data/Bool/Rosso1.hs b/Data/Bool/Rosso1.hs new file mode 100644 index 0000000..2b280f5 --- /dev/null +++ b/Data/Bool/Rosso1.hs @@ -0,0 +1,36 @@ +{- Copyright (c) 2011 Robert Henderson +This source file is distributed under the terms of a BSD3-style +license, which can be found in the file LICENSE at the root of +this package. -} + +-- | Extends "Data.Bool" +-- +module Data.Bool.Rosso1 + (module Data.Bool + + ,xor + + ) where + +------------------------------------------------------ +import Data.Bool + + +-- | Exclusive OR. +xor :: Bool -> Bool -> Bool +xor = (/=) + + +------------------------------------------------------ +{- UNIT TESTS + +*Rosso.Bool1> xor False False +False +*Rosso.Bool1> xor False True +True +*Rosso.Bool1> xor True False +True +*Rosso.Bool1> xor True True +False + +-} diff --git a/Data/Either/Rosso1.hs b/Data/Either/Rosso1.hs new file mode 100644 index 0000000..0572472 --- /dev/null +++ b/Data/Either/Rosso1.hs @@ -0,0 +1,46 @@ +{- Copyright (c) 2011 Robert Henderson +This source file is distributed under the terms of a BSD3-style +license, which can be found in the file LICENSE at the root of +this package. -} + +-- | Extends "Data.Either" +-- +module Data.Either.Rosso1 + (module Data.Either + + ,mapLeft + ,mapRight + + ) where + +------------------------------------------------------ +import Data.Either + + +-- | Applies a function to the left component. +-- +mapLeft :: (a -> c) -> Either a b -> Either c b +mapLeft f (Left x) = Left (f x) +mapLeft _ (Right x) = Right x + + +-- | Applies a function to the right component. +-- +mapRight :: (b -> c) -> Either a b -> Either a c +mapRight _ (Left x) = Left x +mapRight f (Right x) = Right (f x) + + +----------------------------------------------------------- +{- UNIT TESTS + +*Rosso.Either1e> mapLeft (+ 10) (Left 4) +Left 14 +*Rosso.Either1e> mapLeft (+ 10) (Right 4) +Right 4 +*Rosso.Either1e> mapRight (+ 10) (Left 4) +Left 4 +*Rosso.Either1e> mapRight (+ 10) (Right 4) +Right 14 + +-} diff --git a/Data/List/Rosso1.hs b/Data/List/Rosso1.hs new file mode 100644 index 0000000..dfe1577 --- /dev/null +++ b/Data/List/Rosso1.hs @@ -0,0 +1,110 @@ +{- Copyright (c) 2011 Robert Henderson +This source file is distributed under the terms of a BSD3-style +license, which can be found in the file LICENSE at the root of +this package. -} + +-- | Extends "Data.List" +-- +module Data.List.Rosso1 + (module Data.List + + ,dropEachElem + ,extractEachElem + + ,sortAndGroupOn + ,alistCollect + + ,zipFilter + + ) where + +------------------------------------------------------ +import Data.List +import Data.Function + + +-- | Returns a list of lists, each obtained by dropping a single +-- element of the argument. +-- +-- >>> dropEachElem "abcd" +-- ["bcd","acd","abd","abc"] +-- +dropEachElem :: [a] -> [[a]] +dropEachElem lst = zipWith (++) (inits lst) (tail . tails $ lst) + + +-- | Similar to 'dropEachElem', but each output list is paired with the +-- element that was dropped. +-- +-- >>> extractEachElem "abcd" +-- [('a',"bcd"),('b',"acd"),('c',"abd"),('d',"abc")] +-- +extractEachElem :: [a] -> [(a, [a])] +extractEachElem lst = zip lst (dropEachElem lst) + + + +-- | Sorts, then groups the elements of a list, using a specified key +-- function. The sorting process is stable, i.e. elements with equal +-- keys remain in the same order. +-- +-- >>> sortAndGroupOn (`mod` 3) [1..10] +-- [[3,6,9],[1,4,7,10],[2,5,8]] +-- +sortAndGroupOn :: Ord b => (a -> b) -> [a] -> [[a]] +sortAndGroupOn f = groupBy ((==) `on` f) . sortBy (compare `on` f) + + +-- | Collects together the list of values corresponding to each unique +-- key in an association list. Entries in the output list are arranged +-- in ascending order of key. The ordering of values corresponding to +-- a given key is preserved from input to output. +-- +-- >>> alistCollect [(7, 'a'), (3, 'a'), (5, 'x'), (3, 'a'), (3, 'b')] +-- [(3,"aab"),(5,"x"),(7,"a")] +-- +alistCollect :: Ord k => [(k, a)] -> [(k, [a])] +alistCollect = map f . sortAndGroupOn fst + where f grp = (fst (head grp), map snd grp) + + + +-- | Filters a list of values according to a list of corresponding +-- boolean flags. +-- +-- >>> zipFilter [False, True, False, True, True] [0..] +-- [1,3,4] +-- +zipFilter :: [Bool] -> [a] -> [a] +zipFilter bs xs = map snd . filter fst $ zip bs xs + + + +----------------------------------------------------------- +{- UNIT TESTS + +*Util.List1e> dropEachElem "abcd" +["bcd","acd","abd","abc"] +*Util.List1e> extractEachElem "abcd" +[('a',"bcd"),('b',"acd"),('c',"abd"),('d',"abc")] + +*Util.List1e> sortAndGroupOn (`mod` 3) [1..10] +[[3,6,9],[1,4,7,10],[2,5,8]] + +*Rosso.List1e> alistCollect [] +[] +*Rosso.List1e> alistCollect [(7, 'a'), (3, 'a'), (5, 'x'), (3, 'a'), (3, 'b')] +[(3,"aab"),(5,"x"),(7,"a")] +*Data.List.Rosso1> alistCollect [(7, 'c'), (3, 'b'), (7, 'a'), (3, 'a'), (7, 'd')] +[(3,"ba"),(7,"cad")] + +*Rosso.List1> zipFilter [False, True, False, True, True] [0..] +[1,3,4] +*Rosso.List1> zipFilter [] [] +[] +*Rosso.List1> zipFilter [False, True] [5] +[] +*Rosso.List1> zipFilter [True, False] [5] +[5] + +-} diff --git a/Data/Map/Rosso1.hs b/Data/Map/Rosso1.hs new file mode 100644 index 0000000..d6d5638 --- /dev/null +++ b/Data/Map/Rosso1.hs @@ -0,0 +1,49 @@ +{- Copyright (c) 2011 Robert Henderson +This source file is distributed under the terms of a BSD3-style +license, which can be found in the file LICENSE at the root of +this package. -} + +-- | Extends "Data.Map" +-- +module Data.Map.Rosso1 + (module Data.Map + + ,insertMany + ,extract + + ) where + +------------------------------------------------------ +import Data.Map + + +-- | Passes down the list from left to right, inserting each entry +-- into the map. +-- +insertMany :: Ord k => [(k, a)] -> Map k a -> Map k a +insertMany xs m = foldl (flip . uncurry $ insert) m xs + + +-- | Simultaneous lookup and delete. +-- +extract :: Ord k => k -> Map k a -> (Maybe a, Map k a) +extract = updateLookupWithKey (\ _ _ -> Nothing) + + + +----------------------------------------------------------- +{- UNIT TESTS + +*Rosso.Map1> insertMany [] $ fromList [(2, 'a'), (5, 'b')] +fromList [(2,'a'),(5,'b')] +*Rosso.Map1> insertMany [(4, 'x'), (2, 'b'), (4, 'y'), (7, 'a')] $ fromList [(2, 'a'), (5, 'b')] +fromList [(2,'b'),(4,'y'),(5,'b'),(7,'a')] + +*Rosso.Map1> extract 5 empty +(Nothing,fromList []) +*Rosso.Map1> extract 3 $ fromList [(2, 'a'), (5, 'c')] +(Nothing,fromList [(2,'a'),(5,'c')]) +*Rosso.Map1> extract 2 $ fromList [(2, 'a'), (5, 'c')] +(Just 'a',fromList [(5,'c')]) + +-} diff --git a/Data/Maybe/Rosso1.hs b/Data/Maybe/Rosso1.hs new file mode 100644 index 0000000..735d1fb --- /dev/null +++ b/Data/Maybe/Rosso1.hs @@ -0,0 +1,36 @@ +{- Copyright (c) 2011 Robert Henderson +This source file is distributed under the terms of a BSD3-style +license, which can be found in the file LICENSE at the root of +this package. -} + +-- | Extends "Data.Maybe" +-- +module Data.Maybe.Rosso1 + (module Data.Maybe + + ,toMaybe + + ) where + +------------------------------------------------------ +import Data.Maybe + + +-- | Dual of 'fromMaybe'. Wraps the value in 'Just' if the predicate +-- succeeds, otherwise returns 'Nothing'. +-- +toMaybe :: (a -> Bool) -> a -> Maybe a +toMaybe f x | f x = Just x + | otherwise = Nothing + + + +------------------------------------------------------ +{- UNIT TESTS + +*Rosso.Maybe1> toMaybe (> 0) 1 +Just 1 +*Rosso.Maybe1> toMaybe (> 0) 0 +Nothing + +-} diff --git a/Data/MultiMap/Rosso1.hs b/Data/MultiMap/Rosso1.hs new file mode 100644 index 0000000..4c14429 --- /dev/null +++ b/Data/MultiMap/Rosso1.hs @@ -0,0 +1,371 @@ +{- Copyright (c) 2011 Robert Henderson +This source file is distributed under the terms of a BSD3-style +license, which can be found in the file LICENSE at the root of +this package. -} + +-- | 'MultiMap' data structure: similar to a map ("Data.Map"), but allows +-- multiple values with the same key. +-- +module Data.MultiMap.Rosso1 + (MultiMap + + ,fromList + ,toList + + ,empty + ,singleton + ,insert + ,insertMany + ,insertList + ,insertManyLists + + ,null + ,lookup + ,deleteList + ,extractList + ,extractEachListWithKey + ,alter + + ,maxView + ,elems + ,descElems + ,assocs + ,descAssocs + + ) where + +{-- Notes -- + +The only other multimap implementation that I know of on Hackage is +part of the 'Holumbus' system. The Holumbus multimap has different +semantics to this one, as it maps each key to a /set/ of values rather +than a list. + +Todo: + () Add Big-O time complexities to the documentation. + +-} + +----------------------------------------------------------------- +import Prelude hiding (null, lookup) +import qualified Prelude + +import Data.Maybe.Rosso1 +import Data.Tuple.Rosso1 +import Data.Map.Rosso1 (Map) +import qualified Data.Map.Rosso1 as Map + + + +data MultiMap k a = MultiMap (Map k [a]) +-- In a valid multimap, the list mapped to by a key is always non-empty. + + + +-- Helper function: converts from 'toList' form to 'assocs' form. Preserves +-- the order of the values. +-- +listToAssocs :: [(k, [a])] -> [(k, a)] +listToAssocs lst = do (k, vs) <- lst + v <- vs + return (k, v) + + + +-- | Converts an association list into a multimap. If the association +-- list contains duplicate keys, then the corresponding lists of +-- values become concatenated. +-- +-- >>> fromList [(4, "dca"), (1, "aba"), (2, "b"), (1, "ac"), (3, "")] +-- fromList [(1,"abaac"),(2,"b"),(4,"dca")] +-- +fromList :: Ord k => [(k, [a])] -> MultiMap k a +fromList = foldr (uncurry insert) empty . listToAssocs + + +-- | Converts a multimap into an association list, with the keys in +-- ascending order. +-- +-- >>> toList $ fromList [(4, "dca"), (1, "aba"), (2, "b"), (1, "ac"), (3, "")] +-- [(1,"abaac"),(2,"b"),(4,"dca")] +-- +toList :: MultiMap k a -> [(k, [a])] +toList (MultiMap m) = Map.assocs m + + +instance (Show k, Show a) => Show (MultiMap k a) where + -- Adds parentheses if the precedence of the enclosing context + -- is greater than that of the top-level constructor (function + -- application). + showsPrec d m = showParen (d > 10) $ + showString "fromList " . shows (toList m) + + + +-- | The empty multimap. +-- +empty :: MultiMap k a +empty = MultiMap (Map.empty) + + +-- | A multimap with a single entry. +-- +singleton :: k -> a -> MultiMap k a +singleton k a = MultiMap (Map.singleton k [a]) + + +-- | Inserts a new key-value pair. If other entries already exist +-- with the same key, then the new entry is inserted just before them. +-- +-- >>> insert 2 'a' $ fromList [(1, "efg"), (2, "jzw"), (3, "abc")] +-- fromList [(1,"efg"),(2,"ajzw"),(3,"abc")] +-- +insert :: Ord k => k -> a -> MultiMap k a -> MultiMap k a +insert k a (MultiMap m) = MultiMap (Map.alter f k m) + where f Nothing = Just [a] + f (Just as) = Just (a : as) + + +-- | Passes down the list from left to right, inserting each entry into +-- the multimap. +-- +-- >>> insertMany [(1, 'a'), (5, 'a'), (1, 'a'), (1, 'b')] empty +-- fromList [(1,"baa"),(5,"a")] +-- +insertMany :: Ord k => [(k, a)] -> MultiMap k a -> MultiMap k a +insertMany xs mm = foldl (flip . uncurry $ insert) mm xs + + +-- | Prepends a list of values onto the entry with the given key. +-- +-- >>> insertList 7 "hello" $ fromList [(5, "ab"), (7, "efg")] +-- fromList [(5,"ab"),(7,"helloefg")] +-- +insertList :: Ord k => k -> [a] -> MultiMap k a -> MultiMap k a +insertList k as (MultiMap m) = MultiMap (Map.alter f k m) + where f Nothing = Just as + f (Just as2) = Just (as ++ as2) + + +-- | Passes down the given list from left to right invoking 'insertList'. +-- +insertManyLists :: Ord k => [(k, [a])] -> MultiMap k a -> MultiMap k a +insertManyLists xs mm = foldl (flip . uncurry $ insertList) mm xs + + + +-- | Tests if the multimap is empty. +-- +null :: MultiMap k a -> Bool +null (MultiMap m) = Map.null m + + +-- | Returns the list of values associated with the given key. +-- +-- >>> lookup 5 $ fromList [(1, "abc"), (5, "aagf"), (6, "c")] +-- "aagf" +-- +lookup :: Ord k => k -> MultiMap k a -> [a] +lookup k (MultiMap m) = Map.findWithDefault [] k m + + +-- | Deletes all the values associated with the given key. +-- +deleteList :: Ord k => k -> MultiMap k a -> MultiMap k a +deleteList k (MultiMap m) = MultiMap (Map.delete k m) + + +-- | Simultaneous lookup and deleteList. +-- +extractList :: Ord k => k -> MultiMap k a -> ([a], MultiMap k a) +extractList k (MultiMap m) + = pairApply (fromMaybe []) MultiMap (Map.extract k m) + + +-- | For each key that maps to a non-empty list of values, returns +-- that key and its corresponding values as well as the multimap with +-- those values removed. The keys are enumerated in ascending order. +-- +extractEachListWithKey :: Ord k => + MultiMap k a -> [((k, [a]), MultiMap k a)] +extractEachListWithKey m = map f (toList m) + where f x@(k, _) = (x, deleteList k m) + + +-- | Modifies the list of values associated with a given key. +-- +alter :: Ord k => ([a] -> [a]) -> k -> MultiMap k a -> MultiMap k a +alter f k (MultiMap m) = MultiMap (Map.alter g k m) + where g = toMaybe (not . Prelude.null) . f . fromMaybe [] + + + +-- | Returns 'Nothing' if the multimap is empty, otherwise returns the +-- first value associated with the maximal key of the multimap, and +-- the multimap stripped of that value. +-- +-- >>> maxView $ fromList [(1, "ab"), (2, "efg")] +-- Just ('e',fromList [(1,"ab"),(2,"fg")]) +-- +maxView :: MultiMap k a -> Maybe (a, MultiMap k a) +maxView (MultiMap m) = fmap f (Map.maxView m) + where f ([], _) = error "maxView: multimap is invalid" + f ([x], rest) = (x, MultiMap rest) + f (x : _, _) = (x, MultiMap (Map.updateMax (Just . tail) m)) + + +-- | Returns all of the values in the multimap in ascending order of +-- their keys. +-- +-- >>> elems $ fromList [(1, "aba"), (2, "adf"), (3, "z")] +-- "abaadfz" +-- +elems :: MultiMap k a -> [a] +elems (MultiMap m) = concat (Map.elems m) + + +-- | Returns all of the values in the multimap in descending order of +-- their keys. The values are enumerated in the same order as with 'maxView'. +-- +-- >>> descElems $ fromList [(1, "aba"), (2, "adf"), (3, "z")] +-- "zadfaba" +-- +descElems :: MultiMap k a -> [a] +descElems (MultiMap m) = concat . reverse $ Map.elems m + + +-- | Returns all of the key-value pairs in the multimap in ascending order +-- of keys. +-- +-- >>> assocs $ fromList [(1, "ab"), (4, "cda")] +-- [(1,'a'),(1,'b'),(4,'c'),(4,'d'),(4,'a')] +-- +assocs :: MultiMap k a -> [(k, a)] +assocs = listToAssocs . toList + + +-- | Returns all of the key-value pairs in the multimap in descending order +-- of keys. The values are enumerated in the same order as with 'maxView'. +-- +-- >>> descAssocs (fromList [(1, "ab"), (4, "cda")]) +-- [(4,'c'),(4,'d'),(4,'a'),(1,'a'),(1,'b')] +-- +descAssocs :: MultiMap k a -> [(k, a)] +descAssocs = listToAssocs . reverse . toList + + + +----------------------------------------------------------- +{- UNIT TESTS + +*Util.MultiMap1e> fromList [] +fromList [] +*Util.MultiMap1e> fromList [(3, ""), (1, "")] +fromList [] +*Util.MultiMap1e> fromList [(4, "dca"), (1, "aba"), (2, "b"), (1, "ac"), (3, "")] +fromList [(1,"abaac"),(2,"b"),(4,"dca")] + +*Util.MultiMap1e> toList (fromList [(1,"abaac"),(2,"b"),(4,"dca")]) +[(1,"abaac"),(2,"b"),(4,"dca")] +*Util.MultiMap1e> toList (fromList [(4, "dca"), (1, "aba"), (2, "b"), (1, "ac"), (3, "")]) +[(1,"abaac"),(2,"b"),(4,"dca")] + +*Util.MultiMap1e> empty +fromList [] +*Util.MultiMap1e> singleton 1 'a' +fromList [(1,"a")] + +*Util.MultiMap1e> insert 1 'a' empty +fromList [(1,"a")] +*Util.MultiMap1e> insert 2 'a' $ fromList [(1, "efg"), (3, "abc")] +fromList [(1,"efg"),(2,"a"),(3,"abc")] +*Util.MultiMap1e> insert 2 'a' $ fromList [(1, "efg"), (2, "jzw"), (3, "abc")] +fromList [(1,"efg"),(2,"ajzw"),(3,"abc")] +*Util.MultiMap1e> insert 1 'a' $ insert 5 'a' $ insert 1 'a' $ insert 1 'b' $ empty +fromList [(1,"aab"),(5,"a")] + +*Util.MultiMap1e> insertMany [(1, 'a'), (5, 'a'), (1, 'a'), (1, 'b')] empty +fromList [(1,"baa"),(5,"a")] +*Util.MultiMap1e> insertMany (zip (cycle "abc") [1..8]) empty +fromList [('a',[7,4,1]),('b',[8,5,2]),('c',[6,3])] +*Util.MultiMap1e> insertMany (zip (cycle "abc") [1..8]) $ fromList [('b', [2, 1])] +fromList [('a',[7,4,1]),('b',[8,5,2,2,1]),('c',[6,3])] + +*Rosso.MultiMap1e> insertList 3 "hello" $ fromList [(5, "ab"), (7, "efg")] +fromList [(3,"hello"),(5,"ab"),(7,"efg")] +*Rosso.MultiMap1e> insertList 7 "hello" $ fromList [(5, "ab"), (7, "efg")] +fromList [(5,"ab"),(7,"helloefg")] + +*Rosso.MultiMap1e> insertManyLists [(5, "abcd"), (3, "xxy"), (5, "fa")] $ fromList [(1, "ab"), (5, "z")] +fromList [(1,"ab"),(3,"xxy"),(5,"faabcdz")] + +*Rosso.MultiMap1e> null empty +True +*Rosso.MultiMap1e> null $ fromList [(3, "")] +True +*Rosso.MultiMap1e> null $ fromList [(3, "abc")] +False + +*Rosso.MultiMap1e> lookup 3 empty +[] +*Rosso.MultiMap1e> lookup 5 $ fromList [(1, "abc"), (5, "aagf"), (6, "c")] +"aagf" +*Rosso.MultiMap1e> lookup 2 $ fromList [(1, "abc"), (5, "aagf"), (6, "c")] +"" + +*Rosso.MultiMap1e> deleteList 3 $ fromList [(2, "abc"), (5, "ef")] +fromList [(2,"abc"),(5,"ef")] +*Rosso.MultiMap1e> deleteList 2 $ fromList [(2, "abc"), (5, "ef")] +fromList [(5,"ef")] + +*Rosso.MultiMap1e> extractList 3 $ fromList [(2, "abc"), (5, "ef")] +("",fromList [(2,"abc"),(5,"ef")]) +*Rosso.MultiMap1e> extractList 2 $ fromList [(2, "abc"), (5, "ef")] +("abc",fromList [(5,"ef")]) + +*Rosso.MultiMap1e> extractEachListWithKey empty +[] +*Rosso.MultiMap1e> extractEachListWithKey $ singleton 3 'a' +[((3,"a"),fromList [])] +*Rosso.MultiMap1e> extractEachListWithKey $ fromList [(2, "abc"), (5, "e"), (6, "zzzz")] +[((2,"abc"),fromList [(5,"e"),(6,"zzzz")]),((5,"e"),fromList [(2,"abc"),(6,"zzzz")]),((6,"zzzz"),fromList [(2,"abc"),(5,"e")])] + +*Rosso.MultiMap1e> alter reverse 2 $ fromList [(2, "abc"), (5, "ef")] +fromList [(2,"cba"),(5,"ef")] +*Rosso.MultiMap1e> alter tail 5 $ fromList [(2, "abc"), (5, "e")] +fromList [(2,"abc")] +*Rosso.MultiMap1e> alter reverse 6 $ fromList [(2, "abc"), (5, "e")] +fromList [(2,"abc"),(5,"e")] +*Rosso.MultiMap1e> alter (++ "hello") 6 $ fromList [(2, "abc"), (5, "e")] +fromList [(2,"abc"),(5,"e"),(6,"hello")] + +*Util.MultiMap1e> maxView empty +Nothing +*Util.MultiMap1e> maxView $ singleton 1 'a' +Just ('a',fromList []) +*Util.MultiMap1e> maxView $ fromList [(1, "ab"), (2, "g")] +Just ('g',fromList [(1,"ab")]) +*Util.MultiMap1e> maxView $ fromList [(1, "ab"), (2, "efg")] +Just ('e',fromList [(1,"ab"),(2,"fg")]) + +*Util.MultiMap1e> elems empty +[] +*Util.MultiMap1e> elems $ fromList [(1, "aba"), (2, "adf"), (3, "z")] +"abaadfz" + +*Util.MultiMap1e> descElems empty +[] +*Util.MultiMap1e> descElems $ fromList [(1, "aba"), (2, "adf"), (3, "z")] +"zadfaba" + +*Util.MultiMap1e> assocs empty +[] +*Util.MultiMap1e> assocs (fromList [(1, "ab"), (4, "cda")]) +[(1,'a'),(1,'b'),(4,'c'),(4,'d'),(4,'a')] + +*Util.MultiMap1e> descAssocs empty +[] +*Util.MultiMap1e> descAssocs (fromList [(1, "ab"), (4, "cda")]) +[(4,'c'),(4,'d'),(4,'a'),(1,'a'),(1,'b')] + +-} diff --git a/Data/Set/Rosso1.hs b/Data/Set/Rosso1.hs new file mode 100644 index 0000000..d9c1fc2 --- /dev/null +++ b/Data/Set/Rosso1.hs @@ -0,0 +1,35 @@ +{- Copyright (c) 2011 Robert Henderson +This source file is distributed under the terms of a BSD3-style +license, which can be found in the file LICENSE at the root of +this package. -} + +-- | Extends "Data.Set" +-- +module Data.Set.Rosso1 + (module Data.Set + + ,insertMany + + ) where + +------------------------------------------------------ +import Data.Set + + +-- | Inserts each element of the list into the set in turn, from left +-- to right. +-- +insertMany :: Ord a => [a] -> Set a -> Set a +insertMany xs set = foldl (flip insert) set xs + + + +----------------------------------------------------------- +{- UNIT TESTS + +*Util.Set1e> insertMany [0..10] empty +fromList [0,1,2,3,4,5,6,7,8,9,10] +*Util.Set1e> insertMany [2, 5, 2, 4, 6, 10, 3] $ fromList [0..4] +fromList [0,1,2,3,4,5,6,10] + +-} diff --git a/Data/Tuple/Rosso1.hs b/Data/Tuple/Rosso1.hs new file mode 100644 index 0000000..dd72bb6 --- /dev/null +++ b/Data/Tuple/Rosso1.hs @@ -0,0 +1,51 @@ +{- Copyright (c) 2011 Robert Henderson +This source file is distributed under the terms of a BSD3-style +license, which can be found in the file LICENSE at the root of +this package. -} + +-- | Extends "Data.Tuple" +-- +module Data.Tuple.Rosso1 + (module Data.Tuple + + ,mapFst + ,mapSnd + ,pairApply + + ) where + +------------------------------------------------------ +import Data.Tuple + + +-- | Applies a function to the first component of a pair. +-- +mapFst :: (a -> c) -> (a, b) -> (c, b) +mapFst f (a, b) = (f a, b) + + +-- | Applies a function to the second component of a pair. +-- +mapSnd :: (b -> c) -> (a, b) -> (a, c) +mapSnd f (a, b) = (a, f b) + + +-- | Applies a pair of functions to a pair of values. +-- +pairApply :: (a -> c) -> (b -> d) -> (a, b) -> (c, d) +pairApply f g (a, b) = (f a, g b) + + + +----------------------------------------------------------- +{- UNIT TESTS + +*Util.Tuple1e> mapFst (+ 10) (3, 5) +(13,5) +*Util.Tuple1e> mapSnd (+ 10) (3, 5) +(3,15) + +*Rosso.Tuple1> pairApply (+ 5) tail (2, "abc") +(7,"bc") + +-} @@ -0,0 +1,32 @@ +-- Rosso BSD3 license -- + +Copyright (c) 2011 Robert Henderson +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +2. 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. + +3. Neither the name of the author nor the names of other 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 +HOLDER 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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/System/IO/Rosso1.hs b/System/IO/Rosso1.hs new file mode 100644 index 0000000..9c6c9fb --- /dev/null +++ b/System/IO/Rosso1.hs @@ -0,0 +1,32 @@ +{- Copyright (c) 2011 Robert Henderson +This source file is distributed under the terms of a BSD3-style +license, which can be found in the file LICENSE at the root of +this package. -} + +-- | Extends "System.IO" +-- +module System.IO.Rosso1 + (module System.IO + + ,readFileStrict + + ) where + +------------------------------------------------------ +import System.IO +import Control.DeepSeq + + +-- | Like 'readFile', but reads the entire contents of the file into +-- the string, and then closes the file, before the computation +-- completes. +-- +readFileStrict :: FilePath -> IO String +readFileStrict file = do str <- readFile file + deepseq str $ return str + + +------------------------------------------------------ +{- UNIT TESTS + +-} diff --git a/rosso.cabal b/rosso.cabal new file mode 100644 index 0000000..ec8c49b --- /dev/null +++ b/rosso.cabal @@ -0,0 +1,44 @@ +name: rosso +version: 1.0 +stability: provisional +tested-with: GHC ==7.0.3 +cabal-version: >=1.8 + +license: BSD3 +license-file: LICENSE +author: Robert Henderson +maintainer: robh dot junpi at gmail dot com + +category: Utility +synopsis: General purpose utility library +description: + A miscellaneous collection of re-usable functions and data + structures. Many of Rosso's modules are direct extensions of the + Haskell base libraries; for example, Data.Map.Rosso1 extends + Data.Map, Control.Monad.Rosso1 extends Control.Monad, etc. + . + Rosso is designed to remain backward-compatible with any client code + that works with an older version of itself. To this end, all module + names include explicit version numbers. + +build-type: Simple + +source-repository head + type: git + location: git://github.com/robhenderson/rosso.git + +library + build-depends: base >=4 && <5, containers, deepseq + + exposed-modules: Control.Monad.Rosso1, + + Data.Bool.Rosso1, + Data.Either.Rosso1, + Data.List.Rosso1, + Data.Map.Rosso1, + Data.Maybe.Rosso1, + Data.MultiMap.Rosso1, + Data.Set.Rosso1, + Data.Tuple.Rosso1, + + System.IO.Rosso1 |