f0bfcb8811
Not doing this makes having GhcModT pretty pointless as users of the library wouldn't be able to use custom inner monads as evey function for dealing with GhcModT's would be constraint to (GhcModT IO) thus only allowing IO as the inner monad.
23 lines
782 B
Haskell
23 lines
782 B
Haskell
module Language.Haskell.GhcMod.Lint where
|
|
|
|
import Exception (ghandle)
|
|
import Control.Exception (SomeException(..))
|
|
import CoreMonad (liftIO)
|
|
import Language.Haskell.GhcMod.Logger (checkErrorPrefix)
|
|
import Language.Haskell.GhcMod.Convert
|
|
import Language.Haskell.GhcMod.Monad
|
|
import Language.Haskell.GhcMod.Types
|
|
import Language.Haskell.HLint (hlint)
|
|
|
|
-- | Checking syntax of a target file using hlint.
|
|
-- Warnings and errors are returned.
|
|
lint :: IOish m
|
|
=> FilePath -- ^ A target file.
|
|
-> GhcModT m String
|
|
lint file = do
|
|
opt <- options
|
|
ghandle handler . pack =<< (liftIO $ hlint $ file : "--quiet" : hlintOpts opt)
|
|
where
|
|
pack = convert' . map (init . show) -- init drops the last \n.
|
|
handler (SomeException e) = return $ checkErrorPrefix ++ show e ++ "\n"
|