\section[Util]{Highly random utility functions}
\begin{code}
-{-# OPTIONS -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
--- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
--- for details
-
module Util (
- -- general list processing
- zipEqual, zipWithEqual, zipWith3Equal, zipWith4Equal,
+ -- general list processing
+ zipEqual, zipWithEqual, zipWith3Equal, zipWith4Equal,
zipLazy, stretchZipWith,
- mapFst, mapSnd,
- mapAndUnzip, mapAndUnzip3,
- nOfThem, filterOut, partitionWith, splitEithers,
+ mapFst, mapSnd,
+ mapAndUnzip, mapAndUnzip3,
+ nOfThem, filterOut, partitionWith, splitEithers,
foldl1',
- lengthExceeds, lengthIs, lengthAtLeast,
- listLengthCmp, atLength, equalLength, compareLength,
+ lengthExceeds, lengthIs, lengthAtLeast,
+ listLengthCmp, atLength, equalLength, compareLength,
+
+ isSingleton, only, singleton,
+ notNull, snocView,
+
+ isIn, isn'tIn,
- isSingleton, only, singleton,
- notNull, snocView,
+ -- for-loop
+ nTimes,
- isIn, isn'tIn,
+ -- sorting
+ sortLe, sortWith, on,
- -- for-loop
- nTimes,
+ -- transitive closures
+ transitiveClosure,
- -- sorting
- sortLe, sortWith, on,
+ -- accumulating
+ foldl2, count, all2,
- -- transitive closures
- transitiveClosure,
+ takeList, dropList, splitAtList, split,
- -- accumulating
- foldl2, count, all2,
-
- takeList, dropList, splitAtList, split,
+ -- comparisons
+ isEqual, eqListBy,
+ thenCmp, cmpList, maybePrefixMatch,
+ removeSpaces,
- -- comparisons
- isEqual, eqListBy,
- thenCmp, cmpList, maybePrefixMatch,
- removeSpaces,
+ -- strictness
+ seqList,
- -- strictness
- seqList,
+ -- pairs
+ unzipWith,
- -- pairs
- unzipWith,
+ global, consIORef,
- global, consIORef,
+ -- module names
+ looksLikeModuleName,
- -- module names
- looksLikeModuleName,
-
- toArgs,
+ toArgs,
- -- Floating point stuff
- readRational,
+ -- Floating point stuff
+ readRational,
- -- IO-ish utilities
- createDirectoryHierarchy,
- doesDirNameExist,
- modificationTimeIfExists,
+ -- IO-ish utilities
+ createDirectoryHierarchy,
+ doesDirNameExist,
+ modificationTimeIfExists,
- later, handleDyn, handle,
+ later, handleDyn, handle,
- -- Filename utils
- Suffix,
- splitLongestPrefix,
- escapeSpaces,
- parseSearchPath,
+ -- Filename utils
+ Suffix,
+ splitLongestPrefix,
+ escapeSpaces,
+ parseSearchPath,
) where
+-- XXX This define is a bit of a hack, and should be done more nicely
+#define FAST_STRING_NOT_NEEDED 1
#include "HsVersions.h"
-import FastTypes
-
-#if defined(DEBUG) || __GLASGOW_HASKELL__ < 604
import Panic
-#endif
import Control.Exception ( Exception(..), finally, catchDyn, throw )
import qualified Control.Exception as Exception
-import Data.Dynamic ( Typeable )
-import Data.IORef ( IORef, newIORef )
-import System.IO.Unsafe ( unsafePerformIO )
-import Data.IORef ( readIORef, writeIORef )
+import Data.Dynamic ( Typeable )
+import Data.IORef ( IORef, newIORef )
+import System.IO.Unsafe ( unsafePerformIO )
+import Data.IORef ( readIORef, writeIORef )
import Data.List hiding (group)
import qualified Data.List as List ( elem )
import qualified Data.List as List ( notElem )
#endif
-import Control.Monad ( unless )
+import Control.Monad ( unless )
import SYSTEM_IO_ERROR as IO ( catch, isDoesNotExistError )
-import System.Directory ( doesDirectoryExist, createDirectory,
+import System.Directory ( doesDirectoryExist, createDirectory,
getModificationTime )
import System.FilePath hiding ( searchPathSeparator )
-import Data.Char ( isUpper, isAlphaNum, isSpace, ord, isDigit )
-import Data.Ratio ( (%) )
-import System.Time ( ClockTime )
+import Data.Char ( isUpper, isAlphaNum, isSpace, ord, isDigit )
+import Data.Ratio ( (%) )
+import System.Time ( ClockTime )
infixr 9 `thenCmp`
\end{code}
%************************************************************************
-%* *
+%* *
\subsection{A for loop}
-%* *
+%* *
%************************************************************************
\begin{code}
\end{code}
%************************************************************************
-%* *
+%* *
\subsection[Utils-lists]{General list processing}
-%* *
+%* *
%************************************************************************
\begin{code}
filterOut :: (a->Bool) -> [a] -> [a]
-- Like filter, only reverses the sense of the test
-filterOut p [] = []
+filterOut _ [] = []
filterOut p (x:xs) | p x = filterOut p xs
- | otherwise = x : filterOut p xs
+ | otherwise = x : filterOut p xs
partitionWith :: (a -> Either b c) -> [a] -> ([b], [c])
-partitionWith f [] = ([],[])
+partitionWith _ [] = ([],[])
partitionWith f (x:xs) = case f x of
- Left b -> (b:bs, cs)
- Right c -> (bs, c:cs)
- where
- (bs,cs) = partitionWith f xs
+ Left b -> (b:bs, cs)
+ Right c -> (bs, c:cs)
+ where (bs,cs) = partitionWith f xs
splitEithers :: [Either a b] -> ([a], [b])
splitEithers [] = ([],[])
splitEithers (e : es) = case e of
- Left x -> (x:xs, ys)
- Right y -> (xs, y:ys)
- where
- (xs,ys) = splitEithers es
+ Left x -> (x:xs, ys)
+ Right y -> (xs, y:ys)
+ where (xs,ys) = splitEithers es
\end{code}
A paranoid @zip@ (and some @zipWith@ friends) that checks the lists
DEBUGging on; hey, why not?
\begin{code}
-zipEqual :: String -> [a] -> [b] -> [(a,b)]
-zipWithEqual :: String -> (a->b->c) -> [a]->[b]->[c]
-zipWith3Equal :: String -> (a->b->c->d) -> [a]->[b]->[c]->[d]
-zipWith4Equal :: String -> (a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e]
+zipEqual :: String -> [a] -> [b] -> [(a,b)]
+zipWithEqual :: String -> (a->b->c) -> [a]->[b]->[c]
+zipWith3Equal :: String -> (a->b->c->d) -> [a]->[b]->[c]->[d]
+zipWith4Equal :: String -> (a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e]
#ifndef DEBUG
zipEqual _ = zip
zipEqual msg as bs = panic ("zipEqual: unequal lists:"++msg)
zipWithEqual msg z (a:as) (b:bs)= z a b : zipWithEqual msg z as bs
-zipWithEqual msg _ [] [] = []
-zipWithEqual msg _ _ _ = panic ("zipWithEqual: unequal lists:"++msg)
+zipWithEqual msg _ [] [] = []
+zipWithEqual msg _ _ _ = panic ("zipWithEqual: unequal lists:"++msg)
zipWith3Equal msg z (a:as) (b:bs) (c:cs)
- = z a b c : zipWith3Equal msg z as bs cs
-zipWith3Equal msg _ [] [] [] = []
-zipWith3Equal msg _ _ _ _ = panic ("zipWith3Equal: unequal lists:"++msg)
+ = z a b c : zipWith3Equal msg z as bs cs
+zipWith3Equal msg _ [] [] [] = []
+zipWith3Equal msg _ _ _ _ = panic ("zipWith3Equal: unequal lists:"++msg)
zipWith4Equal msg z (a:as) (b:bs) (c:cs) (d:ds)
- = z a b c d : zipWith4Equal msg z as bs cs ds
-zipWith4Equal msg _ [] [] [] [] = []
-zipWith4Equal msg _ _ _ _ _ = panic ("zipWith4Equal: unequal lists:"++msg)
+ = z a b c d : zipWith4Equal msg z as bs cs ds
+zipWith4Equal msg _ [] [] [] [] = []
+zipWith4Equal msg _ _ _ _ _ = panic ("zipWith4Equal: unequal lists:"++msg)
#endif
\end{code}
-- zipLazy is lazy in the second list (observe the ~)
zipLazy :: [a] -> [b] -> [(a,b)]
-zipLazy [] ys = []
+zipLazy [] _ = []
zipLazy (x:xs) ~(y:ys) = (x,y) : zipLazy xs ys
\end{code}
\begin{code}
stretchZipWith :: (a -> Bool) -> b -> (a->b->c) -> [a] -> [b] -> [c]
--- (stretchZipWith p z f xs ys) stretches ys by inserting z in
+-- (stretchZipWith p z f xs ys) stretches ys by inserting z in
-- the places where p returns *True*
-stretchZipWith p z f [] ys = []
+stretchZipWith _ _ _ [] _ = []
stretchZipWith p z f (x:xs) ys
| p x = f x z : stretchZipWith p z f xs ys
| otherwise = case ys of
- [] -> []
- (y:ys) -> f x y : stretchZipWith p z f xs ys
+ [] -> []
+ (y:ys) -> f x y : stretchZipWith p z f xs ys
\end{code}
mapAndUnzip :: (a -> (b, c)) -> [a] -> ([b], [c])
-mapAndUnzip f [] = ([],[])
+mapAndUnzip _ [] = ([], [])
mapAndUnzip f (x:xs)
- = let
- (r1, r2) = f x
- (rs1, rs2) = mapAndUnzip f xs
+ = let (r1, r2) = f x
+ (rs1, rs2) = mapAndUnzip f xs
in
(r1:rs1, r2:rs2)
mapAndUnzip3 :: (a -> (b, c, d)) -> [a] -> ([b], [c], [d])
-mapAndUnzip3 f [] = ([],[],[])
+mapAndUnzip3 _ [] = ([], [], [])
mapAndUnzip3 f (x:xs)
- = let
- (r1, r2, r3) = f x
- (rs1, rs2, rs3) = mapAndUnzip3 f xs
+ = let (r1, r2, r3) = f x
+ (rs1, rs2, rs3) = mapAndUnzip3 f xs
in
(r1:rs1, r2:rs2, r3:rs3)
\end{code}
-> [a]
-> Int
-> b
-atLength atLenPred atEndPred ls n
- | n < 0 = atEndPred n
+atLength atLenPred atEndPred ls n
+ | n < 0 = atEndPred n
| otherwise = go n ls
where
go n [] = atEndPred n
lengthIs :: [a] -> Int -> Bool
lengthIs = atLength null (==0)
-listLengthCmp :: [a] -> Int -> Ordering
-listLengthCmp = atLength atLen atEnd
+listLengthCmp :: [a] -> Int -> Ordering
+listLengthCmp = atLength atLen atEnd
where
atEnd 0 = EQ
atEnd x
atLen _ = GT
equalLength :: [a] -> [b] -> Bool
-equalLength [] [] = True
+equalLength [] [] = True
equalLength (_:xs) (_:ys) = equalLength xs ys
-equalLength xs ys = False
+equalLength _ _ = False
compareLength :: [a] -> [b] -> Ordering
-compareLength [] [] = EQ
+compareLength [] [] = EQ
compareLength (_:xs) (_:ys) = compareLength xs ys
-compareLength [] _ys = LT
-compareLength _xs [] = GT
+compareLength [] _ = LT
+compareLength _ [] = GT
----------------------------
singleton :: a -> [a]
singleton x = [x]
isSingleton :: [a] -> Bool
-isSingleton [x] = True
-isSingleton _ = False
+isSingleton [_] = True
+isSingleton _ = False
notNull :: [a] -> Bool
notNull [] = False
#else
only (a:_) = a
#endif
+only _ = panic "Util: only"
\end{code}
Debugging/specialising versions of \tr{elem} and \tr{notElem}
\begin{code}
-isIn, isn'tIn :: (Eq a) => String -> a -> [a] -> Bool
+isIn, isn'tIn :: Eq a => String -> a -> [a] -> Bool
# ifndef DEBUG
-isIn msg x ys = elem__ x ys
-isn'tIn msg x ys = notElem__ x ys
+isIn _msg x ys = elem__ x ys
+isn'tIn _msg x ys = notElem__ x ys
--these are here to be SPECIALIZEd (automagically)
-elem__ _ [] = False
-elem__ x (y:ys) = x==y || elem__ x ys
+elem__ :: Eq a => a -> [a] -> Bool
+elem__ _ [] = False
+elem__ x (y:ys) = x == y || elem__ x ys
-notElem__ x [] = True
-notElem__ x (y:ys) = x /= y && notElem__ x ys
+notElem__ :: Eq a => a -> [a] -> Bool
+notElem__ _ [] = True
+notElem__ x (y:ys) = x /= y && notElem__ x ys
# else /* DEBUG */
isIn msg x ys
= elem (_ILIT 0) x ys
where
- elem i _ [] = False
+ elem i _ [] = False
elem i x (y:ys)
- | i ># _ILIT 100 = trace ("Over-long elem in " ++ msg) $
- x `List.elem` (y:ys)
+ | i ># _ILIT 100 = trace ("Over-long elem in " ++ msg)
+ (x `List.elem` (y:ys))
| otherwise = x == y || elem (i +# _ILIT(1)) x ys
isn'tIn msg x ys
where
notElem i x [] = True
notElem i x (y:ys)
- | i ># _ILIT 100 = trace ("Over-long notElem in " ++ msg) $
- x `List.notElem` (y:ys)
+ | i ># _ILIT 100 = trace ("Over-long notElem in " ++ msg)
+ (x `List.notElem` (y:ys))
| otherwise = x /= y && notElem (i +# _ILIT(1)) x ys
# endif /* DEBUG */
\end{code}
\begin{code}
#if __GLASGOW_HASKELL__ < 604
-foldl1' :: (a -> a -> a) -> [a] -> a
-foldl1' f (x:xs) = foldl' f x xs
-foldl1' _ [] = panic "foldl1'"
+foldl1' :: (a -> a -> a) -> [a] -> a
+foldl1' f (x:xs) = foldl' f x xs
+foldl1' _ [] = panic "foldl1'"
#endif
\end{code}
%************************************************************************
-%* *
+%* *
\subsubsection[Utils-Carsten-mergesort]{A mergesort from Carsten}
-%* *
+%* *
%************************************************************************
\begin{display}
\begin{code}
group :: (a -> a -> Bool) -> [a] -> [[a]]
--- Given a <= function, group finds maximal contiguous up-runs
+-- Given a <= function, group finds maximal contiguous up-runs
-- or down-runs in the input list.
-- It's stable, in the sense that it never re-orders equal elements
--
-- From: Andy Gill <andy@dcs.gla.ac.uk>
-- Here is a `better' definition of group.
-group p [] = []
+group _ [] = []
group p (x:xs) = group' xs x x (x :)
where
group' [] _ _ s = [s []]
- group' (x:xs) x_min x_max s
- | x_max `p` x = group' xs x_min x (s . (x :))
- | not (x_min `p` x) = group' xs x x_max ((x :) . s)
- | otherwise = s [] : group' xs x x (x :)
- -- NB: the 'not' is essential for stablity
- -- x `p` x_min would reverse equal elements
+ group' (x:xs) x_min x_max s
+ | x_max `p` x = group' xs x_min x (s . (x :))
+ | not (x_min `p` x) = group' xs x x_max ((x :) . s)
+ | otherwise = s [] : group' xs x x (x :)
+ -- NB: the 'not' is essential for stablity
+ -- x `p` x_min would reverse equal elements
generalMerge :: (a -> a -> Bool) -> [a] -> [a] -> [a]
-generalMerge p xs [] = xs
-generalMerge p [] ys = ys
-generalMerge p (x:xs) (y:ys) | x `p` y = x : generalMerge p xs (y:ys)
- | otherwise = y : generalMerge p (x:xs) ys
+generalMerge _ xs [] = xs
+generalMerge _ [] ys = ys
+generalMerge p (x:xs) (y:ys) | x `p` y = x : generalMerge p xs (y:ys)
+ | otherwise = y : generalMerge p (x:xs) ys
-- gamma is now called balancedFold
balancedFold :: (a -> a -> a) -> [a] -> a
-balancedFold f [] = error "can't reduce an empty list using balancedFold"
-balancedFold f [x] = x
+balancedFold _ [] = error "can't reduce an empty list using balancedFold"
+balancedFold _ [x] = x
balancedFold f l = balancedFold f (balancedFold' f l)
balancedFold' :: (a -> a -> a) -> [a] -> [a]
balancedFold' f (x:y:xs) = f x y : balancedFold' f xs
-balancedFold' f xs = xs
+balancedFold' _ xs = xs
-generalNaturalMergeSort p [] = []
+generalNaturalMergeSort :: (a -> a -> Bool) -> [a] -> [a]
+generalNaturalMergeSort _ [] = []
generalNaturalMergeSort p xs = (balancedFold (generalMerge p) . group p) xs
#if NOT_USED
sortWith :: Ord b => (a->b) -> [a] -> [a]
sortWith get_key xs = sortLe le xs
where
- x `le` y = get_key x < get_key y
+ x `le` y = get_key x < get_key y
on :: (a -> a -> Ordering) -> (b -> a) -> b -> b -> Ordering
on cmp sel = \x y -> sel x `cmp` sel y
\end{code}
%************************************************************************
-%* *
+%* *
\subsection[Utils-transitive-closure]{Transitive closure}
-%* *
+%* *
%************************************************************************
This algorithm for transitive closure is straightforward, albeit quadratic.
\begin{code}
-transitiveClosure :: (a -> [a]) -- Successor function
- -> (a -> a -> Bool) -- Equality predicate
- -> [a]
- -> [a] -- The transitive closure
+transitiveClosure :: (a -> [a]) -- Successor function
+ -> (a -> a -> Bool) -- Equality predicate
+ -> [a]
+ -> [a] -- The transitive closure
transitiveClosure succ eq xs
= go [] xs
where
- go done [] = done
+ go done [] = done
go done (x:xs) | x `is_in` done = go done xs
- | otherwise = go (x:done) (succ x ++ xs)
+ | otherwise = go (x:done) (succ x ++ xs)
- x `is_in` [] = False
+ _ `is_in` [] = False
x `is_in` (y:ys) | eq x y = True
- | otherwise = x `is_in` ys
+ | otherwise = x `is_in` ys
\end{code}
%************************************************************************
-%* *
+%* *
\subsection[Utils-accum]{Accumulating}
-%* *
+%* *
%************************************************************************
A combination of foldl with zip. It works with equal length lists.
\begin{code}
foldl2 :: (acc -> a -> b -> acc) -> acc -> [a] -> [b] -> acc
-foldl2 k z [] [] = z
+foldl2 _ z [] [] = z
foldl2 k z (a:as) (b:bs) = foldl2 k (k z a b) as bs
+foldl2 _ _ _ _ = panic "Util: foldl2"
all2 :: (a -> b -> Bool) -> [a] -> [b] -> Bool
--- True if the lists are the same length, and
+-- True if the lists are the same length, and
-- all corresponding elements satisfy the predicate
-all2 p [] [] = True
+all2 _ [] [] = True
all2 p (x:xs) (y:ys) = p x y && all2 p xs ys
-all2 p xs ys = False
+all2 _ _ _ = False
\end{code}
Count the number of times a predicate is true
\begin{code}
count :: (a -> Bool) -> [a] -> Int
-count p [] = 0
+count _ [] = 0
count p (x:xs) | p x = 1 + count p xs
- | otherwise = count p xs
+ | otherwise = count p xs
\end{code}
@splitAt@, @take@, and @drop@ but with length of another
\begin{code}
takeList :: [b] -> [a] -> [a]
takeList [] _ = []
-takeList (_:xs) ls =
+takeList (_:xs) ls =
case ls of
[] -> []
(y:ys) -> y : takeList xs ys
(ys', ys'') = splitAtList xs ys
snocView :: [a] -> Maybe ([a],a)
- -- Split off the last element
+ -- Split off the last element
snocView [] = Nothing
snocView xs = go [] xs
- where
- -- Invariant: second arg is non-empty
- go acc [x] = Just (reverse acc, x)
- go acc (x:xs) = go (x:acc) xs
+ where
+ -- Invariant: second arg is non-empty
+ go acc [x] = Just (reverse acc, x)
+ go acc (x:xs) = go (x:acc) xs
+ go _ [] = panic "Util: snocView"
split :: Char -> String -> [String]
split c s = case rest of
- [] -> [chunk]
- _:rest -> chunk : split c rest
+ [] -> [chunk]
+ _:rest -> chunk : split c rest
where (chunk, rest) = break (==c) s
\end{code}
%************************************************************************
-%* *
+%* *
\subsection[Utils-comparison]{Comparisons}
-%* *
+%* *
%************************************************************************
\begin{code}
thenCmp :: Ordering -> Ordering -> Ordering
{-# INLINE thenCmp #-}
-thenCmp EQ any = any
-thenCmp other any = other
+thenCmp EQ ordering = ordering
+thenCmp ordering _ = ordering
eqListBy :: (a->a->Bool) -> [a] -> [a] -> Bool
-eqListBy eq [] [] = True
+eqListBy _ [] [] = True
eqListBy eq (x:xs) (y:ys) = eq x y && eqListBy eq xs ys
-eqListBy eq xs ys = False
+eqListBy _ _ _ = False
cmpList :: (a -> a -> Ordering) -> [a] -> [a] -> Ordering
-- `cmpList' uses a user-specified comparer
-cmpList cmp [] [] = EQ
-cmpList cmp [] _ = LT
-cmpList cmp _ [] = GT
+cmpList _ [] [] = EQ
+cmpList _ [] _ = LT
+cmpList _ _ [] = GT
cmpList cmp (a:as) (b:bs)
= case cmp a b of { EQ -> cmpList cmp as bs; xxx -> xxx }
\end{code}
\end{code}
%************************************************************************
-%* *
+%* *
\subsection[Utils-pairs]{Pairs}
-%* *
+%* *
%************************************************************************
\begin{code}
looksLikeModuleName [] = False
looksLikeModuleName (c:cs) = isUpper c && go cs
where go [] = True
- go ('.':cs) = looksLikeModuleName cs
- go (c:cs) = (isAlphaNum c || c == '_') && go cs
+ go ('.':cs) = looksLikeModuleName cs
+ go (c:cs) = (isAlphaNum c || c == '_') && go cs
\end{code}
Akin to @Prelude.words@, but acts like the Bourne shell, treating
\begin{code}
readRational__ :: ReadS Rational -- NB: doesn't handle leading "-"
-readRational__ r = do
+readRational__ r = do
(n,d,s) <- readFix r
(k,t) <- readExp s
return ((n%1)*10^^(k-d), t)
where
readFix r = do
- (ds,s) <- lexDecDigits r
- (ds',t) <- lexDotDigits s
- return (read (ds++ds'), length ds', t)
+ (ds,s) <- lexDecDigits r
+ (ds',t) <- lexDotDigits s
+ return (read (ds++ds'), length ds', t)
readExp (e:s) | e `elem` "eE" = readExp' s
- readExp s = return (0,s)
+ readExp s = return (0,s)
readExp' ('+':s) = readDec s
- readExp' ('-':s) = do
- (k,t) <- readDec s
- return (-k,t)
- readExp' s = readDec s
+ readExp' ('-':s) = do (k,t) <- readDec s
+ return (-k,t)
+ readExp' s = readDec s
readDec s = do
(ds,r) <- nonnull isDigit s
where
read_me s
= case (do { (x,"") <- readRational__ s ; return x }) of
- [x] -> x
- [] -> error ("readRational: no parse:" ++ top_s)
- _ -> error ("readRational: ambiguous parse:" ++ top_s)
+ [x] -> x
+ [] -> error ("readRational: no parse:" ++ top_s)
+ _ -> error ("readRational: ambiguous parse:" ++ top_s)
-----------------------------------------------------------------------------
createDirectoryHierarchy dir | isDrive dir = return () -- XXX Hack
createDirectoryHierarchy dir = do
b <- doesDirectoryExist dir
- unless b $ do
- createDirectoryHierarchy (takeDirectory dir)
- createDirectory dir
+ unless b $ do createDirectoryHierarchy (takeDirectory dir)
+ createDirectory dir
-----------------------------------------------------------------------------
-- Verify that the 'dirname' portion of a FilePath exists.
---
+--
doesDirNameExist :: FilePath -> IO Bool
doesDirNameExist fpath = case takeDirectory fpath of
- "" -> return True -- XXX Hack
- dir -> doesDirectoryExist (takeDirectory fpath)
+ "" -> return True -- XXX Hack
+ _ -> doesDirectoryExist (takeDirectory fpath)
-- -----------------------------------------------------------------------------
-- Exception utils
+later :: IO b -> IO a -> IO a
later = flip finally
handleDyn :: Typeable ex => (ex -> IO a) -> IO a -> IO a
modificationTimeIfExists :: FilePath -> IO (Maybe ClockTime)
modificationTimeIfExists f = do
(do t <- getModificationTime f; return (Just t))
- `IO.catch` \e -> if isDoesNotExistError e
- then return Nothing
- else ioError e
+ `IO.catch` \e -> if isDoesNotExistError e
+ then return Nothing
+ else ioError e
-- split a string at the last character where 'pred' is True,
-- returning a pair of strings. The first component holds the string
splitLongestPrefix str pred
| null r_pre = (str, [])
| otherwise = (reverse (tail r_pre), reverse r_suf)
- -- 'tail' drops the char satisfying 'pred'
- where
- (r_suf, r_pre) = break pred (reverse str)
+ -- 'tail' drops the char satisfying 'pred'
+ where (r_suf, r_pre) = break pred (reverse str)
escapeSpaces :: String -> String
escapeSpaces = foldr (\c s -> if isSpace c then '\\':c:s else c:s) ""
split :: String -> [String]
split s =
case rest' of
- [] -> [chunk]
+ [] -> [chunk]
_:rest -> chunk : split rest
where
- chunk =
+ chunk =
case chunk' of
#ifdef mingw32_HOST_OS
('\"':xs@(_:_)) | last xs == '\"' -> init xs
(chunk', rest') = break (==searchPathSeparator) s
--- | A platform-specific character used to separate search path strings in
--- environment variables. The separator is a colon (\":\") on Unix and Macintosh,
--- and a semicolon (\";\") on the Windows operating system.
+-- | A platform-specific character used to separate search path strings in
+-- environment variables. The separator is a colon (\":\") on Unix and
+-- Macintosh, and a semicolon (\";\") on the Windows operating system.
searchPathSeparator :: Char
#if mingw32_HOST_OS || mingw32_TARGET_OS
searchPathSeparator = ';'
projects / ghc-hetmet.git / commitdiff