\begin{code}
module Util (
+ debugIsOn, ghciTablesNextToCode, picIsOn,
+ isWindowsHost, isWindowsTarget, isDarwinTarget,
-- general list processing
zipEqual, zipWithEqual, zipWith3Equal, zipWith4Equal,
-- module names
looksLikeModuleName,
- toArgs,
+ getCmd, toCmdArgs, toArgs,
-- Floating point stuff
readRational,
Direction(..), reslash,
) 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 Panic
%************************************************************************
%* *
+\subsection{Is DEBUG on, are we on Windows?}
+%* *
+%************************************************************************
+
+\begin{code}
+debugIsOn :: Bool
+#ifdef DEBUG
+debugIsOn = True
+#else
+debugIsOn = False
+#endif
+
+ghciTablesNextToCode :: Bool
+#ifdef GHCI_TABLES_NEXT_TO_CODE
+ghciTablesNextToCode = True
+#else
+ghciTablesNextToCode = False
+#endif
+
+picIsOn :: Bool
+#ifdef __PIC__
+picIsOn = True
+#else
+picIsOn = False
+#endif
+
+isWindowsHost :: Bool
+#ifdef mingw32_HOST_OS
+isWindowsHost = True
+#else
+isWindowsHost = False
+#endif
+
+isWindowsTarget :: Bool
+#ifdef mingw32_TARGET_OS
+isWindowsTarget = True
+#else
+isWindowsTarget = False
+#endif
+
+isDarwinTarget :: Bool
+#ifdef darwin_TARGET_OS
+isDarwinTarget = True
+#else
+isDarwinTarget = False
+#endif
+\end{code}
+
+%************************************************************************
+%* *
\subsection{A for loop}
%* *
%************************************************************************
zipLazy :: [a] -> [b] -> [(a,b)]
zipLazy [] _ = []
-zipLazy (x:xs) ~(y:ys) = (x,y) : zipLazy xs ys
+-- We want to write this, but with GHC 6.4 we get a warning, so it
+-- doesn't validate:
+-- zipLazy (x:xs) ~(y:ys) = (x,y) : zipLazy xs ys
+-- so we write this instead:
+zipLazy (x:xs) zs = let y : ys = zs
+ in (x,y) : zipLazy xs ys
\end{code}
\end{code}
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.
+quoted strings as Haskell Strings, and also parses Haskell [String]
+syntax.
\begin{code}
-toArgs :: String -> [String]
-toArgs "" = []
-toArgs s =
- case dropWhile isSpace s of -- drop initial spacing
- [] -> [] -- empty, so no more tokens
- rem -> let (tok,aft) = token rem [] in tok : toArgs aft
+getCmd :: String -> Either String -- Error
+ (String, String) -- (Cmd, Rest)
+getCmd s = case break isSpace $ dropWhile isSpace s of
+ ([], _) -> Left ("Couldn't find command in " ++ show s)
+ res -> Right res
+
+toCmdArgs :: String -> Either String -- Error
+ (String, [String]) -- (Cmd, Args)
+toCmdArgs s = case getCmd s of
+ Left err -> Left err
+ Right (cmd, s') -> case toArgs s' of
+ Left err -> Left err
+ Right args -> Right (cmd, args)
+
+toArgs :: String -> Either String -- Error
+ [String] -- Args
+toArgs str
+ = case dropWhile isSpace str of
+ s@('[':_) -> case reads s of
+ [(args, spaces)]
+ | all isSpace spaces ->
+ Right args
+ _ ->
+ Left ("Couldn't read " ++ show str ++ "as [String]")
+ s -> toArgs' s
where
- -- 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'
+ toArgs' s = case dropWhile isSpace s of
+ [] -> Right []
+ ('"' : _) -> case reads s of
+ [(arg, rest)]
+ -- rest must either be [] or start with a space
+ | all isSpace (take 1 rest) ->
+ case toArgs' rest of
+ Left err -> Left err
+ Right args -> Right (arg : args)
+ _ ->
+ Left ("Couldn't read " ++ show s ++ "as String")
+ s' -> case break isSpace s' of
+ (arg, s'') -> case toArgs' s'' of
+ Left err -> Left err
+ Right args -> Right (arg : args)
\end{code}
-- -----------------------------------------------------------------------------