cleaning up APIs.

Language/Haskell/GhcMod/Check.hs

@@ -1,6 +1,5 @@
 module Language.Haskell.GhcMod.Check (checkSyntax, check) where
 
-import Control.Applicative ((<$>))
 import Control.Monad (void)
 import CoreMonad (liftIO)
 import GHC (Ghc, LoadHowMuch(LoadAllTargets))
@@ -18,7 +17,7 @@ checkSyntax :: Options
             -> [FilePath]  -- ^ The target files.
             -> IO String
 checkSyntax _   _      []    = error "ghc-mod: checkSyntax: No files given"
-checkSyntax opt cradle files = convert opt <$> withGHC sessionName (check opt cradle files)
+checkSyntax opt cradle files = withGHC sessionName (check opt cradle files)
   where
     sessionName = case files of
       [file] -> file
@@ -31,9 +30,9 @@ checkSyntax opt cradle files = convert opt <$> withGHC sessionName (check opt cr
 check :: Options
       -> Cradle
       -> [FilePath]  -- ^ The target files.
-      -> Ghc [String]
+      -> Ghc String
 check _   _      []        = error "ghc-mod: check: No files given"
-check opt cradle fileNames = checkIt `G.gcatch` handleErrMsg ls
+check opt cradle fileNames = checkIt `G.gcatch` handleErrMsg opt
   where
     checkIt = do
         (readLog,_) <- initializeFlagsWithCradle opt cradle options True
@@ -43,4 +42,3 @@ check opt cradle fileNames = checkIt `G.gcatch` handleErrMsg ls
     options
       | expandSplice opt = "-w:"   : ghcOpts opt
       | otherwise        = "-Wall" : ghcOpts opt
-    ls = lineSeparator opt

Language/Haskell/GhcMod/ErrMsg.hs

@@ -17,14 +17,14 @@ import qualified GHC as G
 import HscTypes (SourceError, srcErrorMessages)
 import Language.Haskell.GhcMod.Doc (showPage, getStyle)
 import qualified Language.Haskell.GhcMod.Gap as Gap
-import Language.Haskell.GhcMod.Types (LineSeparator(..))
+import Language.Haskell.GhcMod.Types (LineSeparator(..), Options(..), convert)
 import Outputable (PprStyle, SDoc)
 import System.FilePath (normalise)
 
 ----------------------------------------------------------------
 
 -- | A means to read the log.
-type LogReader = IO [String]
+type LogReader = IO String
 
 ----------------------------------------------------------------
 
@@ -35,11 +35,11 @@ newtype LogRef = LogRef (IORef Builder)
 newLogRef :: IO LogRef
 newLogRef = LogRef <$> newIORef id
 
-readAndClearLogRef :: LogRef -> IO [String]
+readAndClearLogRef :: Options -> LogRef -> IO String
-readAndClearLogRef (LogRef ref) = do
+readAndClearLogRef opt (LogRef ref) = do
     b <- readIORef ref
     writeIORef ref id
-    return $! b []
+    return $! convert opt (b [])
 
 appendLogRef :: DynFlags -> LineSeparator -> LogRef -> DynFlags -> Severity -> SrcSpan -> PprStyle -> SDoc -> IO ()
 appendLogRef df ls (LogRef ref) _ sev src style msg = do
@@ -48,23 +48,28 @@ appendLogRef df ls (LogRef ref) _ sev src style msg = do
 
 ----------------------------------------------------------------
 
-setLogger :: Bool -> DynFlags -> LineSeparator -> IO (DynFlags, LogReader)
+setLogger :: Bool -> DynFlags -> Options -> IO (DynFlags, LogReader)
 setLogger False df _ = return (newdf, undefined)
   where
     newdf = Gap.setLogAction df $ \_ _ _ _ _ -> return ()
-setLogger True  df ls = do
+setLogger True  df opt = do
     logref <- newLogRef
     let newdf = Gap.setLogAction df $ appendLogRef df ls logref
-    return (newdf, readAndClearLogRef logref)
+    return (newdf, readAndClearLogRef opt logref)
+  where
+    ls = lineSeparator opt
 
 ----------------------------------------------------------------
 
 -- | Converting 'SourceError' to 'String'.
-handleErrMsg :: LineSeparator -> SourceError -> Ghc [String]
+handleErrMsg :: Options -> SourceError -> Ghc String
-handleErrMsg ls err = do
+handleErrMsg opt err = do
     dflag <- G.getSessionDynFlags
     style <- getStyle
-    return . errBagToStrList dflag ls style . srcErrorMessages $ err
+    let ret = convert opt . errBagToStrList dflag ls style . srcErrorMessages $ err
+    return ret
+  where
+    ls = lineSeparator opt
 
 errBagToStrList :: DynFlags -> LineSeparator -> PprStyle -> Bag ErrMsg -> [String]
 errBagToStrList dflag ls style = map (ppErrMsg dflag ls style) . reverse . bagToList

Language/Haskell/GhcMod/GHCApi.hs

@@ -113,12 +113,11 @@ initSession build opt compOpts logging = do
     cmdOpts = ghcOptions compOpts
     idirs   = includeDirs compOpts
     depPkgs = depPackages compOpts
-    ls = lineSeparator opt
     setupDynamicFlags df0 = do
         df1 <- modifyFlagsWithOpts df0 cmdOpts
         let df2 = modifyFlags df1 idirs depPkgs (expandSplice opt) build
         df3 <- modifyFlagsWithOpts df2 $ ghcOpts opt
-        liftIO $ setLogger logging df3 ls
+        liftIO $ setLogger logging df3 opt
 
 ----------------------------------------------------------------
 

Language/Haskell/GhcMod/Ghc.hs

@@ -6,14 +6,12 @@ module Language.Haskell.GhcMod.Ghc (
   , browse
   , check
   , info
-  , typeOf
+  , types
   , modules
-  , lint
   ) where
 
 import Language.Haskell.GhcMod.Browse
 import Language.Haskell.GhcMod.Check
 import Language.Haskell.GhcMod.GHCApi
 import Language.Haskell.GhcMod.Info
-import Language.Haskell.GhcMod.Lint
 import Language.Haskell.GhcMod.List

Language/Haskell/GhcMod/Info.hs

@@ -5,7 +5,7 @@ module Language.Haskell.GhcMod.Info (
     infoExpr
   , info
   , typeExpr
-  , typeOf
+  , types
   ) where
 
 import Control.Applicative ((<$>))
@@ -13,7 +13,7 @@ import Control.Monad (void)
 import CoreMonad (liftIO)
 import CoreUtils (exprType)
 import Data.Function (on)
-import Data.Generics hiding (typeOf)
+import Data.Generics
 import Data.List (sortBy)
 import Data.Maybe (catMaybes, fromMaybe)
 import Data.Ord as O
@@ -72,17 +72,17 @@ typeExpr :: Options
          -> Int          -- ^ Column number.
          -> IO String
 typeExpr opt cradle file lineNo colNo = withGHCDummyFile $
-    inModuleContext opt cradle file (typeOf opt file lineNo colNo) errmsg
+    inModuleContext opt cradle file (types opt file lineNo colNo) errmsg
   where
     errmsg = convert opt ([] :: [((Int,Int,Int,Int),String)])
 
 -- | Obtaining type of a target expression. (GHCi's type:)
-typeOf :: Options
+types :: Options
       -> FilePath     -- ^ A target file.
       -> Int          -- ^ Line number.
       -> Int          -- ^ Column number.
       -> Ghc String
-typeOf opt file lineNo colNo = do
+types opt file lineNo colNo = do
     modSum <- Gap.setCtx file
     (dflag, style) <- getFlagStyle
     srcSpanTypes <- getSrcSpanType modSum lineNo colNo

Language/Haskell/GhcMod/Lint.hs

@@ -10,15 +10,8 @@ import Language.Haskell.HLint (hlint)
 lintSyntax :: Options
            -> FilePath  -- ^ A target file.
            -> IO String
-lintSyntax opt file = pack <$> lint hopts file
+lintSyntax opt file = pack . map show <$> hlint (file : "--quiet" : hopts)
   where
     LineSeparator lsep = lineSeparator opt
     pack = convert opt . map (intercalate lsep . lines)
     hopts = hlintOpts opt
-
--- | Checking syntax of a target file using hlint.
---   Warnings and errors are returned.
-lint :: [String]
-     -> FilePath    -- ^ A target file.
-     -> IO [String]
-lint hopts file = map show <$> hlint (file : "--quiet" : hopts)

src/GHCModi.hs

@@ -56,7 +56,7 @@ import System.IO (hFlush,stdout)
 ----------------------------------------------------------------
 
 type DB = Map String [String]
-type Logger = IO [String]
+type Logger = IO String
 
 ----------------------------------------------------------------
 
@@ -119,12 +119,11 @@ main = handle [GE.Handler cmdHandler, GE.Handler someHandler] $
         cradle0 <- findCradle
         let rootdir = cradleRootDir cradle0
             cradle = cradle0 { cradleCurrentDir = rootdir }
-            ls = lineSeparator opt
         setCurrentDirectory rootdir
         mvar <- liftIO newEmptyMVar
         mlibdir <- getSystemLibDir
         void $ forkIO $ setupDB cradle mlibdir opt mvar
-        run cradle mlibdir opt $ loop opt S.empty ls mvar
+        run cradle mlibdir opt $ loop opt S.empty mvar
 
 ----------------------------------------------------------------
 
@@ -148,17 +147,17 @@ setupDB cradle mlibdir opt mvar = E.handle handler $ do
 
 ----------------------------------------------------------------
 
-loop :: Options -> Set FilePath -> LineSeparator -> MVar DB -> Logger -> Ghc ()
+loop :: Options -> Set FilePath -> MVar DB -> Logger -> Ghc ()
-loop opt set ls mvar readLog  = do
+loop opt set mvar readLog  = do
     cmdArg <- liftIO getLine
     let (cmd,arg') = break (== ' ') cmdArg
         arg = dropWhile (== ' ') arg'
     (ret,ok,set') <- case cmd of
-        "check" -> checkStx opt set ls readLog arg
+        "check" -> checkStx opt set arg readLog
-        "find"  -> findSym  opt set mvar arg
+        "find"  -> findSym  opt set arg mvar
-        "lint"  -> lintStx  opt set ls arg
+        "lint"  -> lintStx  opt set arg
-        "info"  -> showInfo opt set ls readLog arg
+        "info"  -> showInfo opt set arg readLog
-        "type"  -> showType opt set ls readLog arg
+        "type"  -> showType opt set arg readLog
         _       -> return ([], False, set)
     let put = case outputStyle opt of
             LispStyle  -> putStr
@@ -166,17 +165,16 @@ loop opt set ls mvar readLog  = do
     liftIO $ put ret
     liftIO $ putStrLn $ if ok then "OK" else "NG"
     liftIO $ hFlush stdout
-    when ok $ loop opt set' ls mvar readLog
+    when ok $ loop opt set' mvar readLog
 
 ----------------------------------------------------------------
 
 checkStx :: Options
          -> Set FilePath
-         -> LineSeparator
-         -> Logger
          -> FilePath
+         -> Logger
          -> Ghc (String, Bool, Set FilePath)
-checkStx opt set ls readLog file = do
+checkStx opt set file readLog = do
     let add = not $ S.member file set
     GE.ghandle handler $ do
         mdel <- removeMainTarget
@@ -192,8 +190,7 @@ checkStx opt set ls readLog file = do
   where
     handler :: SourceError -> Ghc (String, Bool, Set FilePath)
     handler err = do
-        errmsgs <- handleErrMsg ls err
+        ret <- handleErrMsg opt err
-        let ret = convert opt errmsgs
         return (ret, False, set)
     removeMainTarget = do
         mx <- find isMain <$> G.getModuleGraph
@@ -212,22 +209,22 @@ checkStx opt set ls readLog file = do
                     return $ Just mainfile
     isMain m = G.moduleNameString (G.moduleName (G.ms_mod m)) == "Main"
 
-findSym :: Options -> Set FilePath -> MVar DB -> String
+findSym :: Options -> Set FilePath -> String -> MVar DB
         -> Ghc (String, Bool, Set FilePath)
-findSym opt set mvar sym = do
+findSym opt set sym mvar = do
     db <- liftIO $ readMVar mvar
     let ret = convert opt $ fromMaybe [] (M.lookup sym db)
     return (ret, True, set)
 
-lintStx :: Options -> Set FilePath -> LineSeparator -> FilePath
+lintStx :: Options -> Set FilePath -> FilePath
         -> Ghc (String, Bool, Set FilePath)
-lintStx opt set (LineSeparator lsep) optFile = liftIO $ E.handle handler $ do
+lintStx opt set optFile = liftIO $ E.handle handler $ do
-    msgs <- map (intercalate lsep . lines) <$> lint hopts file
+    ret <-lintSyntax opt' file
-    let ret = convert opt msgs
     return (ret, True, set)
   where
     (opts,file) = parseLintOptions optFile
     hopts = if opts == "" then [] else read opts
+    opt' = opt { hlintOpts = hopts }
     -- let's continue the session
     handler (SomeException e) = do
         print e
@@ -250,26 +247,24 @@ parseLintOptions optFile = case brk (== ']') (dropWhile (/= '[') optFile) of
 
 showInfo :: Options
          -> Set FilePath
-         -> LineSeparator
-         -> Logger
          -> FilePath
+         -> Logger
          -> Ghc (String, Bool, Set FilePath)
-showInfo opt set ls readLog fileArg = do
+showInfo opt set fileArg readLog = do
     let [file, expr] = words fileArg
-    (_, _, set') <- checkStx opt set ls readLog file
+    (_, _, set') <- checkStx opt set file readLog
     ret <- info opt file expr
     _ <- liftIO readLog
     return (ret, True, set')
 
 showType :: Options
          -> Set FilePath
-         -> LineSeparator
-         -> Logger
          -> FilePath
+         -> Logger
          -> Ghc (String, Bool, Set FilePath)
-showType opt set ls readLog fileArg = do
+showType opt set fileArg readLog = do
     let [file, line, column] = words fileArg
-    (_, _, set') <- checkStx opt set ls readLog file
+    (_, _, set') <- checkStx opt set file readLog
-    ret <- typeOf opt file (read line) (read column)
+    ret <- types opt file (read line) (read column)
     _ <- liftIO readLog
     return (ret, True, set')