%
+% (c) The University of Glasgow 2006
% (c) The University of Glasgow 1992-2002
%
\section[Util]{Highly random utility functions}
zipLazy, stretchZipWith,
mapFst, mapSnd,
mapAndUnzip, mapAndUnzip3,
- nOfThem, filterOut,
+ nOfThem, filterOut, partitionWith, splitEithers,
lengthExceeds, lengthIs, lengthAtLeast,
listLengthCmp, atLength, equalLength, compareLength,
import Panic ( panic, trace )
import FastTypes
-import EXCEPTION ( Exception(..), finally, throwDyn, catchDyn, throw )
-import qualified EXCEPTION as Exception
-import DYNAMIC ( Typeable )
-import DATA_IOREF ( IORef, newIORef )
-import UNSAFE_IO ( unsafePerformIO )
-import DATA_IOREF ( readIORef, writeIORef )
+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 qualified List ( elem, notElem )
+import qualified Data.List as List ( elem, notElem )
#ifndef DEBUG
-import List ( zipWith4 )
+import Data.List ( zipWith4 )
#endif
-import Monad ( when )
-import IO ( catch, isDoesNotExistError )
-import Directory ( doesDirectoryExist, createDirectory )
-import Char ( isUpper, isAlphaNum, isSpace, ord, isDigit )
-import Ratio ( (%) )
-import Time ( ClockTime )
-import Directory ( getModificationTime )
+import Control.Monad ( when )
+import SYSTEM_IO_ERROR as IO ( catch, isDoesNotExistError )
+import System.Directory ( doesDirectoryExist, createDirectory,
+ getModificationTime )
+import Data.Char ( isUpper, isAlphaNum, isSpace, ord, isDigit )
+import Data.Ratio ( (%) )
+import System.Time ( ClockTime )
infixr 9 `thenCmp`
\end{code}
filterOut p [] = []
filterOut p (x:xs) | p x = filterOut p xs
| otherwise = x : filterOut p xs
+
+partitionWith :: (a -> Either b c) -> [a] -> ([b], [c])
+partitionWith f [] = ([],[])
+partitionWith f (x:xs) = case f x of
+ 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
\end{code}
A paranoid @zip@ (and some @zipWith@ friends) that checks the lists
notNull [] = False
notNull _ = True
-snocView :: [a] -> Maybe ([a],a)
- -- 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
-
only :: [a] -> a
#ifdef DEBUG
only [a] = a
where
(ys', ys'') = splitAtList xs ys
+snocView :: [a] -> Maybe ([a],a)
+ -- 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
+
split :: Char -> String -> [String]
split c s = case rest of
[] -> [chunk]
go (c:cs) = (isAlphaNum c || c == '_') && go cs
\end{code}
-Akin to @Prelude.words@, but sensitive to dquoted entities treating
-them as single words.
+Akin to @Prelude.words@, but acts like the Bourne shell, treating
+quoted strings and escaped characters within the input as solid blocks
+of characters. Doesn't raise any exceptions on malformed escapes or
+quoting.
\begin{code}
toArgs :: String -> [String]
toArgs "" = []
toArgs s =
- case break (\ ch -> isSpace ch || ch == '"') (dropWhile isSpace s) of -- "
- (w,aft) ->
- (\ ws -> if null w then ws else w : ws) $
- case aft of
- [] -> []
- (x:xs)
- | x /= '"' -> toArgs xs
- | otherwise ->
- case lex aft of
- ((str,rs):_) -> stripQuotes str : toArgs rs
- _ -> [aft]
+ case dropWhile isSpace s of -- drop initial spacing
+ [] -> [] -- empty, so no more tokens
+ rem -> let (tok,aft) = token rem [] in tok : toArgs aft
where
- -- strip away dquotes; assume first and last chars contain quotes.
- stripQuotes :: String -> String
- stripQuotes ('"':xs) = init xs
- stripQuotes xs = xs
+ -- Grab a token off the string, given that the first character exists and
+ -- isn't whitespace. The second argument is an accumulator which has to be
+ -- reversed at the end.
+ token [] acc = (reverse acc,[]) -- out of characters
+ token ('\\':c:aft) acc -- escapes
+ = token aft ((escape c) : acc)
+ token (q:aft) acc | q == '"' || q == '\'' -- open quotes
+ = let (aft',acc') = quote q aft acc in token aft' acc'
+ token (c:aft) acc | isSpace c -- unescaped, unquoted spacing
+ = (reverse acc,aft)
+ token (c:aft) acc -- anything else goes in the token
+ = token aft (c:acc)
+
+ -- Get the appropriate character for a single-character escape.
+ escape 'n' = '\n'
+ escape 't' = '\t'
+ escape 'r' = '\r'
+ escape c = c
+
+ -- Read into accumulator until a quote character is found.
+ quote qc =
+ let quote' [] acc = ([],acc)
+ quote' ('\\':c:aft) acc = quote' aft ((escape c) : acc)
+ quote' (c:aft) acc | c == qc = (aft,acc)
+ quote' (c:aft) acc = quote' aft (c:acc)
+ in quote'
\end{code}
-- -----------------------------------------------------------------------------
projects / ghc-hetmet.git / blobdiff