ghc-mod/Check.hs

54 lines
1.8 KiB
Haskell
Raw Normal View History

2010-04-06 13:54:23 +00:00
{-# LANGUAGE CPP #-}
2010-03-11 10:03:17 +00:00
module Check (checkSyntax) where
import Control.Applicative
2010-03-11 15:20:02 +00:00
import Control.Monad
2010-03-11 10:03:17 +00:00
import Data.Char
import Data.List
2010-03-11 13:39:07 +00:00
import Param
2010-03-11 15:20:02 +00:00
import System.Directory
import System.FilePath
2010-03-11 10:03:17 +00:00
import System.IO
import System.Process
----------------------------------------------------------------
2010-03-11 13:39:07 +00:00
checkSyntax :: Options -> String -> IO String
checkSyntax opt file = do
2010-03-11 15:20:02 +00:00
makeDirectory (outDir opt)
2010-04-11 03:03:08 +00:00
#if __GLASGOW_HASKELL__ >= 611
2010-03-31 04:06:47 +00:00
(_,_,herr,_) <- runInteractiveProcess (ghc opt) ["--make","-Wall","-fno-warn-unused-do-bind",file,"-outputdir","dist/flymake","-o","dist/flymake/a.out","-i..","-i../..","-i../../..","-i../../../..","-i../../../../.."] Nothing Nothing
2010-04-06 13:54:23 +00:00
#else
(_,_,herr,_) <- runInteractiveProcess (ghc opt) ["--make","-Wall",file,"-outputdir","dist/flymake","-o","dist/flymake/a.out","-i..","-i../..","-i../../..","-i../../../..","-i../../../../.."] Nothing Nothing
#endif
2010-03-30 03:05:18 +00:00
hSetBinaryMode herr False
2010-03-11 10:03:17 +00:00
refine <$> hGetContents herr
where
refine = unfoldLines . remove . lines
2010-03-14 13:39:45 +00:00
remove = filter (\x -> not ("Linking" `isPrefixOf` x))
. filter (\x -> not ("[" `isPrefixOf` x))
. filter (/="")
2010-03-11 10:03:17 +00:00
2010-03-14 13:39:45 +00:00
unfoldLines :: [String] -> String
unfoldLines [] = ""
unfoldLines (x:xs) = x ++ unfold xs
2010-03-11 10:03:17 +00:00
where
unfold [] = "\n"
unfold (l:ls)
2010-03-14 13:39:45 +00:00
| isAlpha (head l) = ('\n':l) ++ unfold ls
2010-04-23 09:09:38 +00:00
| otherwise = drop 4 l ++ "\0" ++ unfold ls
2010-03-11 15:20:02 +00:00
----------------------------------------------------------------
makeDirectory :: FilePath -> IO ()
makeDirectory dir = makeDirectoryRecur $ normalise dir
where
makeDirectoryRecur "" = return ()
makeDirectoryRecur cur = do
exist <- doesDirectoryExist cur
let par = takeDirectory cur
unless exist $ do
makeDirectoryRecur par
createDirectory cur