ghc-mod/Language/Haskell/GhcMod/Utils.hs

40 lines
1.4 KiB
Haskell
Raw Normal View History

2014-04-19 06:17:36 +00:00
module Language.Haskell.GhcMod.Utils where
2014-04-19 06:20:16 +00:00
2014-07-17 13:52:33 +00:00
import MonadUtils (MonadIO, liftIO)
2014-04-30 23:48:03 +00:00
import Control.Exception (bracket)
import System.Directory (getCurrentDirectory, setCurrentDirectory)
import System.Process (readProcessWithExitCode)
import System.Exit (ExitCode(..))
import System.IO (hPutStrLn, stderr)
2014-04-19 06:20:16 +00:00
-- dropWhileEnd is not provided prior to base 4.5.0.0.
dropWhileEnd :: (a -> Bool) -> [a] -> [a]
dropWhileEnd p = foldr (\x xs -> if p x && null xs then [] else x : xs) []
extractParens :: String -> String
extractParens str = extractParens' str 0
where
extractParens' :: String -> Int -> String
extractParens' [] _ = []
extractParens' (s:ss) level
| s `elem` "([{" = s : extractParens' ss (level+1)
| level == 0 = extractParens' ss 0
2014-07-17 08:16:44 +00:00
| s `elem` "}])" && level == 1 = [s]
| s `elem` "}])" = s : extractParens' ss (level-1)
| otherwise = s : extractParens' ss level
2014-07-17 13:52:33 +00:00
readProcess' :: MonadIO m => String -> [String] -> m String
2014-04-30 23:48:03 +00:00
readProcess' cmd opts = do
2014-07-17 13:52:33 +00:00
(rv,output,err) <- liftIO $ readProcessWithExitCode cmd opts ""
2014-04-30 23:48:03 +00:00
case rv of
ExitFailure val -> do
2014-07-17 13:52:33 +00:00
liftIO $ hPutStrLn stderr err
2014-04-30 23:48:03 +00:00
fail $ cmd ++ " " ++ unwords opts ++ " (exit " ++ show val ++ ")"
ExitSuccess ->
return output
2014-05-01 00:10:42 +00:00
withDirectory_ :: FilePath -> IO a -> IO a
withDirectory_ dir action =
bracket getCurrentDirectory setCurrentDirectory
(\_ -> setCurrentDirectory dir >> action)