lineSeparator are only used in toList/toPlain.

Language/Haskell/GhcMod/ErrMsg.hs

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

Language/Haskell/GhcMod/Lint.hs

@@ -2,7 +2,6 @@ module Language.Haskell.GhcMod.Lint where
 
 import Control.Applicative ((<$>))
 import Language.Haskell.GhcMod.Types
-import Language.Haskell.GhcMod.Utils (replace)
 import Language.Haskell.HLint (hlint)
 
 -- | Checking syntax of a target file using hlint.
@@ -12,6 +11,5 @@ lintSyntax :: Options
            -> IO String
 lintSyntax opt file = pack <$> hlint (file : "--quiet" : hopts)
   where
-    LineSeparator lsep = lineSeparator opt
+    pack = convert opt . map (init . show) -- init drops the last \n.
-    pack = convert opt . map (replace '\n' lsep . init . show)
     hopts = hlintOpts opt

Language/Haskell/GhcMod/Types.hs

@@ -47,62 +47,73 @@ defaultOptions = Options {
 ----------------------------------------------------------------
 
 convert :: ToString a => Options -> a -> String
-convert Options{ outputStyle = LispStyle  } = toLisp
+ -- fixme: builder
-convert Options{ outputStyle = PlainStyle } = toPlain
+convert opt@Options { outputStyle = LispStyle  } x = toLisp  opt x ++ "\n"
+convert opt@Options { outputStyle = PlainStyle } x = toPlain opt x ++ "\n"
 
 class ToString a where
-    toLisp  :: a -> String
+    toLisp  :: Options -> a -> String
-    toPlain :: a -> String
+    toPlain :: Options -> a -> String
+
+lineSep :: Options -> String
+lineSep opt = lsep
+  where
+    LineSeparator lsep = lineSeparator opt
 
 -- |
 --
--- >>> toLisp "fo\"o"
+-- >>> toLisp defaultOptions "fo\"o"
--- "\"fo\\\"o\"\n"
+-- "\"fo\\\"o\""
--- >>> toPlain "foo"
+-- >>> toPlain defaultOptions "foo"
--- "foo\n"
+-- "foo"
 instance ToString String where
-    toLisp  = addNewLine . quote
+    toLisp  opt = quote opt
-    toPlain = addNewLine
+    toPlain opt = replace '\n' (lineSep opt)
 
 -- |
 --
--- >>> toLisp ["foo", "bar", "ba\"z"]
+-- >>> toLisp defaultOptions ["foo", "bar", "ba\"z"]
--- "(\"foo\" \"bar\" \"ba\\\"z\")\n"
+-- "(\"foo\" \"bar\" \"ba\\\"z\")"
--- >>> toPlain ["foo", "bar", "baz"]
+-- >>> toPlain defaultOptions ["foo", "bar", "baz"]
--- "foo\nbar\nbaz\n"
+-- "foo\nbar\nbaz"
 instance ToString [String] where
-    toLisp  = addNewLine . toSexp True
+    toLisp  opt = toSexp opt True
-    toPlain = unlines
+    toPlain opt = intercalate "\n" . map (toPlain opt)
 
 -- |
 --
 -- >>> let inp = [((1,2,3,4),"foo"),((5,6,7,8),"bar")] :: [((Int,Int,Int,Int),String)]
--- >>> toLisp inp
+-- >>> toLisp defaultOptions inp
--- "((1 2 3 4 \"foo\") (5 6 7 8 \"bar\"))\n"
+-- "((1 2 3 4 \"foo\") (5 6 7 8 \"bar\"))"
--- >>> toPlain inp
+-- >>> toPlain defaultOptions inp
--- "1 2 3 4 \"foo\"\n5 6 7 8 \"bar\"\n"
+-- "1 2 3 4 \"foo\"\n5 6 7 8 \"bar\""
 instance ToString [((Int,Int,Int,Int),String)] where
-    toLisp  = addNewLine . toSexp False . map toS
+    toLisp  opt = toSexp opt False . map toS
       where
-        toS x = "(" ++ tupToString x ++ ")"
+        toS x = "(" ++ tupToString opt x ++ ")"
-    toPlain = unlines . map tupToString
+    toPlain opt = intercalate "\n" . map (tupToString opt)
 
-toSexp :: Bool -> [String] -> String
+toSexp :: Options -> Bool -> [String] -> String
-toSexp False ss = "(" ++ unwords ss ++ ")"
+toSexp _   False ss = "(" ++ unwords ss ++ ")"
-toSexp True ss  = "(" ++ unwords (map quote ss) ++ ")"
+toSexp opt True ss  = "(" ++ unwords (map (quote opt) ss) ++ ")"
 
-tupToString :: ((Int,Int,Int,Int),String) -> String
+tupToString :: Options -> ((Int,Int,Int,Int),String) -> String
-tupToString ((a,b,c,d),s) = show a ++ " "
+tupToString opt ((a,b,c,d),s) = show a ++ " "
-                         ++ show b ++ " "
+                             ++ show b ++ " "
-                         ++ show c ++ " "
+                             ++ show c ++ " "
-                         ++ show d ++ " "
+                             ++ show d ++ " "
-                         ++ quote s -- fixme: quote is not necessary
+                             ++ quote opt s -- fixme: quote is not necessary
 
-quote :: String -> String
+quote :: Options -> String -> String
-quote x = "\"" ++ replace '"' "\\\"" x ++ "\""
+quote opt str = "\"" ++ quote' str ++ "\"" -- fixme: builder
-
+  where
-addNewLine :: String -> String
+    lsep = lineSep opt
-addNewLine = (++ "\n")
+    quote' [] = []
+    quote' (x:xs)
+      | x == '\n' = lsep   ++ quote' xs
+      | x == '\\' = "\\\\" ++ quote' xs
+      | x == '"'  = "\\\"" ++ quote' xs
+      | otherwise = x       : quote' xs
 
 ----------------------------------------------------------------
 

src/GHCModi.hs

@@ -180,12 +180,11 @@ checkStx opt set file readLog = do
         mdel <- removeMainTarget
         when add $ addTargetFiles [file]
         void $ G.load LoadAllTargets
-        msgs <- liftIO readLog
+        ret <- liftIO readLog
         let set1 = if add then S.insert file set else set
             set2 = case mdel of
                 Nothing    -> set1
                 Just delfl -> S.delete delfl set1
-        let ret = convert opt msgs
         return (ret, True, set2)
   where
     handler :: SourceError -> Ghc (String, Bool, Set FilePath)
@@ -213,7 +212,7 @@ findSym :: Options -> Set FilePath -> String -> MVar DB
         -> Ghc (String, Bool, Set FilePath)
 findSym opt set sym mvar = do
     db <- liftIO $ readMVar mvar
-    let ret = convert opt $ fromMaybe [] (M.lookup sym db)
+    let ret = convert opt $ fromMaybe [] (M.lookup sym db) -- fixme
     return (ret, True, set)
 
 lintStx :: Options -> Set FilePath -> FilePath