refactoring for lineSeparator.

Language/Haskell/GhcMod/ErrMsg.hs

@@ -18,6 +18,7 @@ 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(..), Options(..), convert)
+import Language.Haskell.GhcMod.Utils (replace)
 import Outputable (PprStyle, SDoc)
 import System.FilePath (normalise)
 
@@ -41,9 +42,9 @@ readAndClearLogRef opt (LogRef ref) = do
     writeIORef ref id
     return $! convert opt (b [])
 
-appendLogRef :: DynFlags -> LineSeparator -> LogRef -> DynFlags -> Severity -> SrcSpan -> PprStyle -> SDoc -> IO ()
+appendLogRef :: DynFlags -> Options -> LogRef -> DynFlags -> Severity -> SrcSpan -> PprStyle -> SDoc -> IO ()
-appendLogRef df ls (LogRef ref) _ sev src style msg = do
+appendLogRef df opt (LogRef ref) _ sev src style msg = do
-        let !l = ppMsg src sev df ls style msg
+        let !l = ppMsg src sev df opt style msg
         modifyIORef ref (\b -> b . (l:))
 
 ----------------------------------------------------------------
@@ -54,10 +55,8 @@ setLogger False df _ = return (newdf, undefined)
     newdf = Gap.setLogAction df $ \_ _ _ _ _ -> return ()
 setLogger True  df opt = do
     logref <- newLogRef
-    let newdf = Gap.setLogAction df $ appendLogRef df ls logref
+    let newdf = Gap.setLogAction df $ appendLogRef df opt logref
     return (newdf, readAndClearLogRef opt logref)
-  where
-    ls = lineSeparator opt
 
 ----------------------------------------------------------------
 
@@ -66,27 +65,25 @@ handleErrMsg :: Options -> SourceError -> Ghc String
 handleErrMsg opt err = do
     dflag <- G.getSessionDynFlags
     style <- getStyle
-    let ret = convert opt . errBagToStrList dflag ls style . srcErrorMessages $ err
+    let ret = convert opt . errBagToStrList dflag opt style . srcErrorMessages $ err
     return ret
-  where
-    ls = lineSeparator opt
 
-errBagToStrList :: DynFlags -> LineSeparator -> PprStyle -> Bag ErrMsg -> [String]
+errBagToStrList :: DynFlags -> Options -> PprStyle -> Bag ErrMsg -> [String]
-errBagToStrList dflag ls style = map (ppErrMsg dflag ls style) . reverse . bagToList
+errBagToStrList dflag opt style = map (ppErrMsg dflag opt style) . reverse . bagToList
 
 ----------------------------------------------------------------
 
-ppErrMsg :: DynFlags -> LineSeparator -> PprStyle -> ErrMsg -> String
+ppErrMsg :: DynFlags -> Options -> PprStyle -> ErrMsg -> String
-ppErrMsg dflag ls style err = ppMsg spn SevError dflag ls style msg ++ ext
+ppErrMsg dflag opt style err = ppMsg spn SevError dflag opt style msg ++ ext
    where
      spn = Gap.errorMsgSpan err
      msg = errMsgShortDoc err
-     ext = showMsg dflag ls style (errMsgExtraInfo err)
+     ext = showMsg dflag opt style (errMsgExtraInfo err)
 
-ppMsg :: SrcSpan -> Severity-> DynFlags -> LineSeparator -> PprStyle -> SDoc -> String
+ppMsg :: SrcSpan -> Severity-> DynFlags -> Options -> PprStyle -> SDoc -> String
-ppMsg spn sev dflag ls style msg = prefix ++ cts
+ppMsg spn sev dflag opt style msg = prefix ++ cts
   where
-    cts  = showMsg dflag ls style msg
+    cts  = showMsg dflag opt style msg
     defaultPrefix
       | dopt Gap.dumpSplicesFlag dflag = ""
       | otherwise                      = "Dummy:0:0:Error:"
@@ -98,9 +95,7 @@ ppMsg spn sev dflag ls style msg = prefix ++ cts
 
 ----------------------------------------------------------------
 
-showMsg :: DynFlags -> LineSeparator -> PprStyle -> SDoc -> String
+showMsg :: DynFlags -> Options -> PprStyle -> SDoc -> String
-showMsg dflag (LineSeparator lsep) style sdoc = replaceNull $ showPage dflag style sdoc
+showMsg dflag opt style sdoc = replace '\n' lsep $ showPage dflag style sdoc
   where
-    replaceNull []        = []
+    LineSeparator lsep = lineSeparator opt
-    replaceNull ('\n':xs) = lsep ++ replaceNull xs
-    replaceNull (x:xs)    = x : replaceNull xs

Language/Haskell/GhcMod/Lint.hs

@@ -1,8 +1,8 @@
 module Language.Haskell.GhcMod.Lint where
 
 import Control.Applicative ((<$>))
-import Data.List (intercalate)
 import Language.Haskell.GhcMod.Types
+import Language.Haskell.GhcMod.Utils (replace)
 import Language.Haskell.HLint (hlint)
 
 -- | Checking syntax of a target file using hlint.
@@ -10,8 +10,8 @@ import Language.Haskell.HLint (hlint)
 lintSyntax :: Options
            -> FilePath  -- ^ A target file.
            -> IO String
-lintSyntax opt file = pack . map show <$> hlint (file : "--quiet" : hopts)
+lintSyntax opt file = pack <$> hlint (file : "--quiet" : hopts)
   where
     LineSeparator lsep = lineSeparator opt
-    pack = convert opt . map (intercalate lsep . lines)
+    pack = convert opt . map (replace '\n' lsep . init . show)
     hopts = hlintOpts opt

Language/Haskell/GhcMod/Types.hs

@@ -2,7 +2,8 @@
 
 module Language.Haskell.GhcMod.Types where
 
-import Data.List
+import Data.List (intercalate)
+import Language.Haskell.GhcMod.Utils (replace)
 
 -- | Output style.
 data OutputStyle = LispStyle  -- ^ S expression style.
@@ -98,11 +99,7 @@ tupToString ((a,b,c,d),s) = show a ++ " "
                          ++ quote s -- fixme: quote is not necessary
 
 quote :: String -> String
-quote x = "\"" ++ escape x ++ "\""
+quote x = "\"" ++ replace '"' "\\\"" x ++ "\""
-  where
-    escape [] = []
-    escape ('"':ys) = '\\':'\"':escape ys
-    escape (y:ys)   = y:escape ys
 
 addNewLine :: String -> String
 addNewLine = (++ "\n")

Language/Haskell/GhcMod/Utils.hs

@@ -3,3 +3,13 @@ module Language.Haskell.GhcMod.Utils where
 -- dropWhileEnd is not provided prior to base 4.5.0.0.
 dropWhileEnd :: (a -> Bool) -> [a] -> [a]
 dropWhileEnd p = foldr (\x xs -> if p x && null xs then [] else x : xs) []
+
+-- |
+--
+-- >>> replace '"' "\\\"" "foo\"bar"
+-- "foo\\\"bar"
+replace :: Char -> String -> String -> String
+replace _ _  [] = []
+replace c cs (x:xs)
+  | x == c    = cs ++ replace c cs xs
+  | otherwise = x   : replace c cs xs