MUtils

Plain source file: base/lib/MUtils.hs (2005-05-19)

```-- Thomas' misc utils (things that are missing in the standard libraries)
```
```module MUtils where
import Monad(ap,unless,when)
import List(groupBy,sortBy,sort)
import Maybe(fromMaybe)
--import ExceptM()

-- all eta expansions because of the stupid monomorphism restriction

infixl 1 #,#.,<#,@@, >#<

-- Infix versions of two essential operators:
f # x = fmap f x
mf <# mx  = ap mf mx

--Kleisli composition, another essential operator, sadly lacking from the
--Haskell 98 libraries:
m1 @@ m2 = \ x -> m1 =<< m2 x

f #. m = \ x -> f # m x

done :: Monad m => m ()
done = return ()

unlessM m1 m2 = do b <- m1
unless b m2

whenM m1 m2 = do b <- m1
when b m2

ifM bM tM eM = do b <- bM; if b then tM else eM
aM &&& bM = ifM aM bM (return False)
andM ms = foldr (&&&) (return True) ms
allM p = andM . map p

seqMaybe m = maybe (return Nothing) (Just # ) m

-- Property: f # x == return f &lt;# x

(f >#< g) (x,y) = (,) # f x <# g y

mapFstM f = mapM (apFstM f)
apFstM f (x,y) = flip (,) y # f x
mapSndM f = mapM (apSndM f)
apSndM f (x,y) = (,) x # f y

concatMapM f xs = concat # mapM f xs

mapFst f = map (apFst f)
mapSnd f = map (apSnd f)
apSnd f (x,y) = (x,f y)
apFst f (x,y) = (f x,y)

mapBoth f = map (apBoth f)
apBoth f (x,y) = (f x,f y)
dup x = (x,x)
pairWith f x = (x,f x)
-- pairWith f = apSnd f . dup

mapPartition f [] = ([],[])
mapPartition f (x:xs) = either (apFst.(:)) (apSnd.(:)) (f x) (mapPartition f xs)

collectBySnd x =
map pick .
groupBy eqSnd .
sortBy cmpSnd \$ x
where
pick xys@((_,y):_) = ({-sort \$-} map fst xys,y)

collectByFst x = map swap . collectBySnd . map swap \$ x

onFst f (x1,_) (x2,_) = f x1 x2
onSnd f (_,y1) (_,y2) = f y1 y2
cmpFst x = onFst compare x
cmpSnd x = onSnd compare x
eqFst x = onFst (==) x
eqSnd x = onSnd (==) x

swap (x,y) = (y,x)

mapEither f g = either (Left . f) (Right . g)
seqEither x = either (Left # ) (Right # ) x

-- squeezeDups removes adjacent duplicates (cheaper than nub):
squeezeDups (r1:rrs@(r2:_)) = if r1==r2
then squeezeDups rrs
else r1:squeezeDups rrs
squeezeDups rs = rs

usort xs = squeezeDups (sort xs)

read' s = read'' "MUtils.read'" s

read'' msg s =
case reads s of
[(x,r)] | readAtEnd r -> x
[] -> error \$ msg++" no parse: "++take 60 s
_ ->  error \$ msg++" ambiguous parse: "++take 60 s

readAtEnd r = lex r == [("","")]

fromJust' = fromMaybe . error

--instance Functor ((->) a) where fmap = (.)

{-
instance Functor (Either err) where
fmap = mapEither id

instance Monad (Either err) where
return = Right
Left err >>= _ = Left err
Right ans >>= m = m ans
-}
```

Index

(HTML for this module was generated on 2006-08-12. About the conversion tool.)