lint in ghc-modi.

This commit is contained in:
Kazu Yamamoto 2014-03-27 10:34:43 +09:00
parent 4ad1c5e276
commit fa4222f727

View File

@ -1,5 +1,14 @@
{-# LANGUAGE BangPatterns, CPP #-} {-# LANGUAGE BangPatterns, CPP #-}
-- Commands:
-- check <file>
-- find <symbol>
-- lint <file> [hlint options]
--
-- Session separators:
-- OK -- success
-- NG -- failure
module Main where module Main where
import Control.Applicative ((<$>)) import Control.Applicative ((<$>))
@ -81,6 +90,7 @@ loop set ls mvar readLog = do
(msgs,ok,set') <- case cmd of (msgs,ok,set') <- case cmd of
"check" -> checkStx set ls readLog arg "check" -> checkStx set ls readLog arg
"find" -> findSym set mvar arg "find" -> findSym set mvar arg
"lint" -> lintStx set ls arg
_ -> return ([], False, set) _ -> return ([], False, set)
mapM_ (liftIO . putStrLn) msgs mapM_ (liftIO . putStrLn) msgs
liftIO $ putStrLn $ if ok then "OK" else "NG" liftIO $ putStrLn $ if ok then "OK" else "NG"
@ -133,3 +143,12 @@ findSym set mvar sym = do
Nothing -> [] Nothing -> []
Just xs -> xs Just xs -> xs
return (ret, True, set) return (ret, True, set)
lintStx :: Set FilePath -> LineSeparator -> FilePath
-> Ghc ([String], Bool, Set FilePath)
lintStx set (LineSeparator lsep) fileOpts = liftIO $ do
msgs <- map (intercalate lsep . lines) <$> lint hopts file
return (msgs, True, set) -- fixme: error handling
where
file = fileOpts -- fixme
hopts = [] -- fixme