Fix ghc-7.6 compile time errors

This commit is contained in:
Daniel Gröber 2017-05-12 15:28:08 +02:00
parent b242df63dc
commit d7a00ffcca
6 changed files with 22 additions and 20 deletions

View File

@ -60,7 +60,7 @@ debugInfo = do
, "System GHC Version: " ++ ghcVersion , "System GHC Version: " ++ ghcVersion
, "Root directory: " ++ cradleRootDir , "Root directory: " ++ cradleRootDir
, "Current directory: " ++ cradleCurrentDir , "Current directory: " ++ cradleCurrentDir
, "GHC Package flags:\n" ++ render (nest 4 $ , "GHC Package flags:\n" ++ renderGm (nest 4 $
fsep $ map text pkgOpts) fsep $ map text pkgOpts)
, "GHC System libraries: " ++ ghcLibDir , "GHC System libraries: " ++ ghcLibDir
] ++ cabal ] ++ cabal
@ -98,17 +98,17 @@ cabalDebug ghcPkgPath = do
return $ return $
[ "cabal-install Version: " ++ cabalInstVersion [ "cabal-install Version: " ++ cabalInstVersion
, "Cabal Library Versions:\n" ++ render (nest 4 $ , "Cabal Library Versions:\n" ++ renderGm (nest 4 $
fsep $ map text cabalPackages) fsep $ map text cabalPackages)
, "Cabal file: " ++ show cradleCabalFile , "Cabal file: " ++ show cradleCabalFile
, "Project: " ++ show cradleProject , "Project: " ++ show cradleProject
, "Cabal entrypoints:\n" ++ render (nest 4 $ , "Cabal entrypoints:\n" ++ renderGm (nest 4 $
mapDoc gmComponentNameDoc smpDoc entrypoints) mapDoc gmComponentNameDoc smpDoc entrypoints)
, "Cabal components:\n" ++ render (nest 4 $ , "Cabal components:\n" ++ renderGm (nest 4 $
mapDoc gmComponentNameDoc graphDoc graphs) mapDoc gmComponentNameDoc graphDoc graphs)
, "GHC Cabal options:\n" ++ render (nest 4 $ , "GHC Cabal options:\n" ++ renderGm (nest 4 $
mapDoc gmComponentNameDoc (fsep . map text) opts) mapDoc gmComponentNameDoc (fsep . map text) opts)
, "GHC search path options:\n" ++ render (nest 4 $ , "GHC search path options:\n" ++ renderGm (nest 4 $
mapDoc gmComponentNameDoc (fsep . map text) srcOpts) mapDoc gmComponentNameDoc (fsep . map text) srcOpts)
] ]
@ -126,11 +126,11 @@ componentInfo ts = do
opts <- targetGhcOptions crdl sefnmn opts <- targetGhcOptions crdl sefnmn
return $ unlines $ return $ unlines $
[ "Matching Components:\n" ++ render (nest 4 $ [ "Matching Components:\n" ++ renderGm (nest 4 $
alistDoc (either text mnDoc) (setDoc gmComponentNameDoc) mdlcs) alistDoc (either text mnDoc) (setDoc gmComponentNameDoc) mdlcs)
, "Picked Component:\n" ++ render (nest 4 $ , "Picked Component:\n" ++ renderGm (nest 4 $
gmComponentNameDoc cn) gmComponentNameDoc cn)
, "GHC Cabal options:\n" ++ render (nest 4 $ fsep $ map text opts) , "GHC Cabal options:\n" ++ renderGm (nest 4 $ fsep $ map text opts)
] ]
where where
zipMap f l = l `zip` (f `map` l) zipMap f l = l `zip` (f `map` l)

View File

@ -31,7 +31,7 @@ module Language.Haskell.GhcMod.Gap (
, occNameForUser , occNameForUser
, deSugar , deSugar
, showDocWith , showDocWith
, render , renderGm
, GapThing(..) , GapThing(..)
, fromTyThing , fromTyThing
, fileModSummary , fileModSummary
@ -201,19 +201,21 @@ showDocWith dflags mode = Pretty.showDoc mode (pprCols dflags)
showDocWith _ = Pretty.showDocWith showDocWith _ = Pretty.showDocWith
#endif #endif
render :: Pretty.Doc -> String renderGm :: Pretty.Doc -> String
#if __GLASGOW_HASKELL__ >= 800 #if __GLASGOW_HASKELL__ >= 800
render = Pretty.fullRender Pretty.PageMode 80 1.2 string_txt "" renderGm = Pretty.fullRender Pretty.PageMode 80 1.2 string_txt ""
#else #else
render = Pretty.fullRender Pretty.PageMode 80 1.2 string_txt "" renderGm = Pretty.fullRender Pretty.PageMode 80 1.2 string_txt ""
#endif #endif
where where
string_txt :: Pretty.TextDetails -> String -> String string_txt :: Pretty.TextDetails -> String -> String
string_txt (Pretty.Chr c) s = c:s string_txt (Pretty.Chr c) s = c:s
string_txt (Pretty.Str s1) s2 = s1 ++ s2 string_txt (Pretty.Str s1) s2 = s1 ++ s2
string_txt (Pretty.PStr s1) s2 = unpackFS s1 ++ s2 string_txt (Pretty.PStr s1) s2 = unpackFS s1 ++ s2
string_txt (Pretty.ZStr s1) s2 = zString s1 ++ s2
string_txt (Pretty.LStr s1 _) s2 = unpackLitString s1 ++ s2 string_txt (Pretty.LStr s1 _) s2 = unpackLitString s1 ++ s2
#if __GLASGOW_HASKELL__ >= 708
string_txt (Pretty.ZStr s1) s2 = zString s1 ++ s2
#endif
---------------------------------------------------------------- ----------------------------------------------------------------

View File

@ -99,7 +99,7 @@ withLogger' env action = do
let setLogger df = Gap.setLogAction df $ appendLogRef rfm df logref let setLogger df = Gap.setLogAction df $ appendLogRef rfm df logref
handlers = [ handlers = [
GHandler $ \ex -> return $ Left $ runReader (sourceError ex) gpe, GHandler $ \ex -> return $ Left $ runReader (sourceError ex) gpe,
GHandler $ \ex -> return $ Left [render $ ghcExceptionDoc ex] GHandler $ \ex -> return $ Left [renderGm $ ghcExceptionDoc ex]
] ]
gpe = GmPprEnv { gpe = GmPprEnv {
gpeDynFlags = hsc_dflags env gpeDynFlags = hsc_dflags env

View File

@ -78,7 +78,7 @@ gmLog level loc' doc = do
let loc | loc' == "" = empty let loc | loc' == "" = empty
| otherwise = text loc' <+>: empty | otherwise = text loc' <+>: empty
msgDoc = sep [loc, doc] msgDoc = sep [loc, doc]
msg = dropWhileEnd isSpace $ render $ gmLogLevelDoc level <+>: msgDoc msg = dropWhileEnd isSpace $ renderGm $ gmLogLevelDoc level <+>: msgDoc
when (level <= level') $ gmErrStrLn msg when (level <= level') $ gmErrStrLn msg
gmLogQuiet level loc' doc gmLogQuiet level loc' doc

View File

@ -15,7 +15,7 @@
-- along with this program. If not, see <http://www.gnu.org/licenses/>. -- along with this program. If not, see <http://www.gnu.org/licenses/>.
module Language.Haskell.GhcMod.Pretty module Language.Haskell.GhcMod.Pretty
( render ( renderGm
, renderSDoc , renderSDoc
, gmComponentNameDoc , gmComponentNameDoc
, gmLogLevelDoc , gmLogLevelDoc
@ -37,7 +37,7 @@ import Outputable (SDoc, withPprStyleDoc)
import Language.Haskell.GhcMod.Types import Language.Haskell.GhcMod.Types
import Language.Haskell.GhcMod.Doc import Language.Haskell.GhcMod.Doc
import Language.Haskell.GhcMod.Gap (render) import Language.Haskell.GhcMod.Gap (renderGm)
renderSDoc :: GhcMonad m => SDoc -> m Doc renderSDoc :: GhcMonad m => SDoc -> m Doc
renderSDoc sdoc = do renderSDoc sdoc = do

View File

@ -39,7 +39,7 @@ main =
hSetEncoding stdin enc hSetEncoding stdin enc
catches (progMain res) [ catches (progMain res) [
Handler $ \(e :: GhcModError) -> Handler $ \(e :: GhcModError) ->
runGmOutT globalOptions $ exitError $ render (gmeDoc e) runGmOutT globalOptions $ exitError $ renderGm (gmeDoc e)
] ]
progMain :: (Options, GhcModCommands) -> IO () progMain :: (Options, GhcModCommands) -> IO ()
@ -121,7 +121,7 @@ wrapGhcCommands opts cmd =
Right _ -> Right _ ->
return () return ()
Left ed -> Left ed ->
exitError $ render (gmeDoc ed) exitError $ renderGm (gmeDoc ed)
loadMMappedFiles from (Just to) = loadMappedFile from to loadMMappedFiles from (Just to) = loadMappedFile from to
loadMMappedFiles from (Nothing) = do loadMMappedFiles from (Nothing) = do