62 lines
2.0 KiB
Haskell
62 lines
2.0 KiB
Haskell
{-# LANGUAGE CPP #-}
|
|
|
|
module Check (checkSyntax) where
|
|
|
|
import Control.Applicative
|
|
import Control.Monad
|
|
import Data.Char
|
|
import Data.List
|
|
import Param
|
|
import System.Directory
|
|
import System.FilePath
|
|
import System.IO
|
|
import System.Process
|
|
|
|
----------------------------------------------------------------
|
|
|
|
checkSyntax :: Options -> String -> IO String
|
|
checkSyntax opt file = do
|
|
let outdir = outDir opt
|
|
outfile = outFile opt
|
|
objfile = objectFile outdir file
|
|
makeDirectory outdir
|
|
exist <- doesFileExist objfile
|
|
when exist $ removeFile objfile
|
|
#if __GLASGOW_HASKELL__ >= 611
|
|
(_,_,herr,_) <- runInteractiveProcess (ghc opt) ["--make","-Wall","-fno-warn-unused-do-bind",file,"-outputdir",outdir,"-o",outfile,"-i..","-i../..","-i../../..","-i../../../..","-i../../../../.."] Nothing Nothing
|
|
#else
|
|
(_,_,herr,_) <- runInteractiveProcess (ghc opt) ["--make","-Wall",file,"-outputdir",outdir,"-o",outfile,"-i..","-i../..","-i../../..","-i../../../..","-i../../../../.."] Nothing Nothing
|
|
#endif
|
|
hSetBinaryMode herr False
|
|
refine <$> hGetContents herr
|
|
where
|
|
refine = unfoldLines . remove . lines
|
|
remove = filter (\x -> not ("Linking" `isPrefixOf` x))
|
|
. filter (\x -> not ("[" `isPrefixOf` x))
|
|
. filter (/="")
|
|
|
|
unfoldLines :: [String] -> String
|
|
unfoldLines [] = ""
|
|
unfoldLines (x:xs) = x ++ unfold xs
|
|
where
|
|
unfold [] = "\n"
|
|
unfold (l:ls)
|
|
| isAlpha (head l) = ('\n':l) ++ unfold ls
|
|
| otherwise = drop 4 l ++ "\0" ++ unfold ls
|
|
|
|
----------------------------------------------------------------
|
|
|
|
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
|
|
|
|
objectFile :: FilePath -> FilePath -> FilePath
|
|
objectFile dir hsfile = dir </> replaceExtension hsfile ".o"
|