-----------------------------------------------------------------------------
--- $Id: DriverUtil.hs,v 1.43 2004/08/13 13:07:02 simonmar Exp $
+-- $Id: DriverUtil.hs,v 1.46 2004/11/09 16:59:31 simonmar Exp $
--
-- Utils for the driver
--
split, add, addNoDups,
Suffix, splitFilename, getFileSuffix,
splitFilename3, remove_suffix, split_longest_prefix,
- replaceFilenameSuffix, directoryOf, replaceFilenameDirectory,
- remove_spaces, escapeSpaces,
+ replaceFilenameSuffix, directoryOf, filenameOf,
+ replaceFilenameDirectory, remove_spaces, escapeSpaces,
) where
#include "../includes/ghcconfig.h"
-> IO [String] -- options, if any
getOptionsFromSource file
= do h <- openFile file ReadMode
- catchJust ioErrors (look h `finally` hClose h)
- (\e -> if isEOFError e then return [] else ioError e)
+ look h `finally` hClose h
where
-
look h = do
- l' <- hGetLine h
- let l = remove_spaces l'
- case () of
- () | null l -> look h
- | prefixMatch "#" l -> look h
- | prefixMatch "{-# LINE" l -> look h -- -}
- | Just opts <- matchOptions l
- -> do rest <- look h
+ r <- tryJust ioErrors (hGetLine h)
+ case r of
+ Left e | isEOFError e -> return []
+ | otherwise -> ioError e
+ Right l' -> do
+ let l = remove_spaces l'
+ case () of
+ () | null l -> look h
+ | prefixMatch "#" l -> look h
+ | prefixMatch "{-# LINE" l -> look h -- -}
+ | Just opts <- matchOptions l
+ -> do rest <- look h
return (words opts ++ rest)
- | otherwise -> return []
+ | otherwise -> return []
matchOptions s
| Just s1 <- maybePrefixMatch "{-#" s, -- -}
directoryOf :: FilePath -> String
directoryOf = fst . splitFilenameDir
+-- filenameOf strips the directory off the input string, returning
+-- the filename.
+filenameOf :: FilePath -> String
+filenameOf = snd . splitFilenameDir
+
replaceFilenameDirectory :: FilePath -> String -> FilePath
replaceFilenameDirectory s dir
= dir ++ '/':drop_longest_prefix s isPathSeparator