bamse-0.9.1: Util/List.hs

{-# OPTIONS -fglasgow-exts #-}
{- |

  Module      :  Util.List
  Copyright   :  (c) Galois Connections 2001, 2002

  Maintainer      : lib@galois.com
  Stability       :
  Portability     :

  List routines needed by Bamse.
-}
module Util.List
	( split         -- :: (Eq a) => a -> [a] -> [[a]]
	, splitBy       -- :: (a -> Bool) -> [a] -> [[a]]
	, lookupBy      -- :: (a -> Bool) -> [a] -> Maybe a
	, revDropWhile  -- :: (a -> Bool) -> [a] -> [a]
	, mapFirstDefault -- :: a -> (a -> Maybe a) -> [a] -> [a]
	, enclose         -- :: [a{-pre-}] -> [a{-suff-}] -> [a{-list-}] -> [a]

	, mapFst	  -- :: (a -> b) -> [(a,c)] -> [(b,c)]
	, mapSnd	  -- :: (a -> b) -> [(c,a)] -> [(c,b)]
        , init0
	, ifCons          -- :: Bool -> a -> [a] -> [a]
	
	, concatWith      -- :: a -> [[a]] -> [a]
	) where

import Data.List

split :: (Eq a) => a -> [a] -> [[a]]
split elt ls = splitBy (==elt) ls

splitBy :: (a -> Bool) -> [a] -> [[a]]
splitBy _    [] = []
splitBy p ls =
  case break p ls of
    (bef,[])   -> [bef]
    (bef,_:xs) -> bef : splitBy p xs

--
-- consistent naming, provide 'find' as 'lookupBy'.
--
lookupBy :: (a -> Bool) -> [a] -> Maybe a
lookupBy = find

--
-- revDropWhile p = reverse . dropWhile p . reverse
--
revDropWhile :: (a -> Bool) -> [a] -> [a]
revDropWhile p = foldr f []
  where f x [] | p x       = []
               | otherwise = [x]
        f x xs@(_:_)       = x:xs

mapFirstDefault :: a
		-> (a -> Maybe a)
		-> [a]
		-> [a]
mapFirstDefault def _     [] = [def]
mapFirstDefault def f (x:xs) =
  case f x of
    Nothing -> x : mapFirstDefault def f xs
    Just x' -> x' : xs

--
-- mapping over just one component of a pair is not that
-- uncommon. As we all know, trivial to write out in terms
-- of 'map', but you shouldn't have to!
--
mapFst :: (a -> b) -> [(a,c)] -> [(b,c)]
mapFst f = map (\ (x,y) -> (f x,y))

mapSnd :: (a -> b) -> [(c,a)] -> [(c,b)]
mapSnd f = map (\ (x,y) -> (x,f y))

--
-- add a prefix and a suffix to a list.
--
enclose :: [a{-pre-}] -> [a{-suff-}] -> [a{-list-}] -> [a]
enclose p s ls = p ++ (ls ++ s)

init0 :: [a] -> [a]
init0 [] = []
init0 ls = init ls

-- | conditional cons
ifCons :: Bool -> a -> [a] -> [a]
ifCons True x xs = x:xs
ifCons _ _ xs = xs

-- intersperses with the separator before concat'ing
concatWith :: a -> [[a]] -> [a]
concatWith _   []  = []
concatWith sep xss =
  foldr1 ( \ xs yss -> xs ++ (sep : yss) ) xss