+ 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 []
+
+-- detect {-# OPTIONS_GHC ... #-}. For the time being, we accept OPTIONS
+-- instead of OPTIONS_GHC, but that is deprecated.
+matchOptions s
+ | Just s1 <- maybePrefixMatch "{-#" s -- -}
+ = matchOptions1 (remove_spaces s1)
+ | otherwise
+ = Nothing
+ where
+ matchOptions1 s
+ | Just s2 <- maybePrefixMatch "OPTIONS" s
+ = case () of
+ _ | Just s3 <- maybePrefixMatch "_GHC" s2, not (is_ident (head s3))
+ -> matchOptions2 s3
+ | not (is_ident (head s2))
+ -> matchOptions2 s2
+ | otherwise
+ -> Just [] -- OPTIONS_anything is ignored, not treated as start of source
+ | otherwise = Nothing
+ matchOptions2 s
+ | Just s3 <- maybePrefixMatch "}-#" (reverse s) = Just (reverse s3)
+ | otherwise = Nothing
+
+-----------------------------------------------------------------------------
+-- A version of getDirectoryContents that is non-fatal if the
+-- directory doesn't exist.
+
+softGetDirectoryContents d
+ = IO.catch (getDirectoryContents d)
+ (\_ -> do hPutStrLn stderr
+ ("WARNING: error while reading directory " ++ d)
+ return []
+ )
+
+-----------------------------------------------------------------------------
+-- 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)