+
+-----------------------------------------------------------------------------
+-- Create a hierarchy of directories
+
+createDirectoryHierarchy :: FilePath -> IO ()
+createDirectoryHierarchy dir = do
+ b <- doesDirectoryExist dir
+ when (not b) $ do
+ createDirectoryHierarchy (directoryOf dir)
+ createDirectory dir
+
+-----------------------------------------------------------------------------
+-- Verify that the 'dirname' portion of a FilePath exists.
+--
+doesDirNameExist :: FilePath -> IO Bool
+doesDirNameExist fpath = doesDirectoryExist (directoryOf fpath)
+
+-- -----------------------------------------------------------------------------
+-- Exception utils
+
+later = flip finally
+
+handleDyn :: Typeable ex => (ex -> IO a) -> IO a -> IO a
+handleDyn = flip catchDyn
+
+handle :: (Exception -> IO a) -> IO a -> IO a
+#if __GLASGOW_HASKELL__ < 501
+handle = flip Exception.catchAllIO
+#else
+handle h f = f `Exception.catch` \e -> case e of
+ ExitException _ -> throw e
+ _ -> h e
+#endif
+
+-- --------------------------------------------------------------
+-- check existence & modification time at the same time
+
+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
+
+-- --------------------------------------------------------------
+-- Filename manipulation
+
+-- Filenames are kept "normalised" inside GHC, using '/' as the path
+-- separator. On Windows these functions will also recognise '\\' as
+-- the path separator, but will generally construct paths using '/'.
+
+type Suffix = String
+
+splitFilename :: String -> (String,Suffix)
+splitFilename f = splitLongestPrefix f (=='.')
+
+basenameOf :: FilePath -> String
+basenameOf = fst . splitFilename
+
+suffixOf :: FilePath -> Suffix
+suffixOf = snd . splitFilename
+
+joinFileExt :: String -> String -> FilePath
+joinFileExt path "" = path
+joinFileExt path ext = path ++ '.':ext
+
+-- "foo/bar/xyzzy.ext" -> ("foo/bar", "xyzzy.ext")
+splitFilenameDir :: String -> (String,String)
+splitFilenameDir str
+ = let (dir, rest) = splitLongestPrefix str isPathSeparator
+ (dir', rest') | null rest = (".", dir)
+ | otherwise = (dir, rest)
+ in (dir', rest')
+
+-- "foo/bar/xyzzy.ext" -> ("foo/bar", "xyzzy", ".ext")
+splitFilename3 :: String -> (String,String,Suffix)
+splitFilename3 str
+ = let (dir, rest) = splitFilenameDir str
+ (name, ext) = splitFilename rest
+ in (dir, name, ext)
+
+joinFileName :: String -> String -> FilePath
+joinFileName "" fname = fname
+joinFileName "." fname = fname
+joinFileName dir "" = dir
+joinFileName dir fname = dir ++ '/':fname
+
+-- split a string at the last character where 'pred' is True,
+-- returning a pair of strings. The first component holds the string
+-- up (but not including) the last character for which 'pred' returned
+-- True, the second whatever comes after (but also not including the
+-- last character).
+--
+-- If 'pred' returns False for all characters in the string, the original
+-- string is returned in the first component (and the second one is just
+-- empty).
+splitLongestPrefix :: String -> (Char -> Bool) -> (String,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)
+
+replaceFilenameSuffix :: FilePath -> Suffix -> FilePath
+replaceFilenameSuffix file suf = basenameOf file `joinFileExt` suf
+
+-- directoryOf strips the filename off the input string, returning
+-- the directory.
+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 path dir = dir `joinFileName` filenameOf path
+
+escapeSpaces :: String -> String
+escapeSpaces = foldr (\c s -> if isSpace c then '\\':c:s else c:s) ""
+
+isPathSeparator :: Char -> Bool
+isPathSeparator ch =
+#ifdef mingw32_TARGET_OS
+ ch == '/' || ch == '\\'
+#else
+ ch == '/'
+#endif
+
+--------------------------------------------------------------
+-- * Search path
+--------------------------------------------------------------
+
+-- | The function splits the given string to substrings
+-- using the 'searchPathSeparator'.
+parseSearchPath :: String -> [FilePath]
+parseSearchPath path = split path
+ where
+ split :: String -> [String]
+ split s =
+ case rest' of
+ [] -> [chunk]
+ _:rest -> chunk : split rest
+ where
+ chunk =
+ case chunk' of
+#ifdef mingw32_HOST_OS
+ ('\"':xs@(_:_)) | last xs == '\"' -> init xs
+#endif
+ _ -> chunk'
+
+ (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.
+searchPathSeparator :: Char
+#if mingw32_HOST_OS || mingw32_TARGET_OS
+searchPathSeparator = ';'
+#else
+searchPathSeparator = ':'
+#endif
+
+-----------------------------------------------------------------------------
+-- Convert filepath into platform / MSDOS form.
+
+-- We maintain path names in Unix form ('/'-separated) right until
+-- the last moment. On Windows we dos-ify them just before passing them
+-- to the Windows command.
+--
+-- The alternative, of using '/' consistently on Unix and '\' on Windows,
+-- proved quite awkward. There were a lot more calls to platformPath,
+-- and even on Windows we might invoke a unix-like utility (eg 'sh'), which
+-- interpreted a command line 'foo\baz' as 'foobaz'.
+
+normalisePath :: String -> String
+-- Just changes '\' to '/'
+
+pgmPath :: String -- Directory string in Unix format
+ -> String -- Program name with no directory separators
+ -- (e.g. copy /y)
+ -> String -- Program invocation string in native format
+
+#if defined(mingw32_HOST_OS)
+--------------------- Windows version ------------------
+normalisePath xs = subst '\\' '/' xs
+pgmPath dir pgm = platformPath dir ++ '\\' : pgm
+platformPath p = subst '/' '\\' p
+
+subst a b ls = map (\ x -> if x == a then b else x) ls
+#else
+--------------------- Non-Windows version --------------
+normalisePath xs = xs
+pgmPath dir pgm = dir ++ '/' : pgm
+platformPath stuff = stuff
+--------------------------------------------------------
+#endif
+\end{code}