Make 'render' work with ghc <8.0
This commit is contained in:
@@ -46,7 +46,7 @@ browse opts pkgmdl = do
|
||||
goPkgModule `G.gcatch` (\(SomeException _) -> goHomeModule)
|
||||
|
||||
logException ex =
|
||||
gmLog GmException "browse" $ showDoc ex
|
||||
gmLog GmException "browse" $ showToDoc ex
|
||||
|
||||
goPkgModule = do
|
||||
runGmPkgGhc $
|
||||
|
||||
@@ -70,7 +70,7 @@ splits file lineNo colNo =
|
||||
where
|
||||
handler (SomeException ex) = do
|
||||
gmLog GmException "splits" $
|
||||
text "" $$ nest 4 (showDoc ex)
|
||||
text "" $$ nest 4 (showToDoc ex)
|
||||
emptyResult =<< outputOpts
|
||||
|
||||
----------------------------------------------------------------
|
||||
|
||||
@@ -36,7 +36,7 @@ import Language.Haskell.GhcMod.DynFlags
|
||||
import Language.Haskell.GhcMod.Monad
|
||||
import Language.Haskell.GhcMod.SrcUtils
|
||||
import Language.Haskell.GhcMod.Logging (gmLog)
|
||||
import Language.Haskell.GhcMod.Pretty (showDoc)
|
||||
import Language.Haskell.GhcMod.Pretty (showToDoc)
|
||||
import Language.Haskell.GhcMod.Doc
|
||||
import Language.Haskell.GhcMod.Types
|
||||
import Language.Haskell.GhcMod.FileMapping (fileModSummaryWithMapping)
|
||||
@@ -378,7 +378,7 @@ refine file lineNo colNo (Expression expr) =
|
||||
where
|
||||
handler (SomeException ex) = do
|
||||
gmLog GmException "refining" $
|
||||
text "" $$ nest 4 (showDoc ex)
|
||||
text "" $$ nest 4 (showToDoc ex)
|
||||
emptyResult =<< outputOpts
|
||||
|
||||
-- Look for the variable in the specified position
|
||||
@@ -475,7 +475,7 @@ auto file lineNo colNo =
|
||||
where
|
||||
handler (SomeException ex) = do
|
||||
gmLog GmException "auto-refining" $
|
||||
text "" $$ nest 4 (showDoc ex)
|
||||
text "" $$ nest 4 (showToDoc ex)
|
||||
emptyResult =<< outputOpts
|
||||
|
||||
-- Functions we do not want in completions
|
||||
|
||||
@@ -31,6 +31,7 @@ module Language.Haskell.GhcMod.Gap (
|
||||
, occNameForUser
|
||||
, deSugar
|
||||
, showDocWith
|
||||
, render
|
||||
, GapThing(..)
|
||||
, fromTyThing
|
||||
, fileModSummary
|
||||
@@ -200,6 +201,21 @@ showDocWith dflags mode = Pretty.showDoc mode (pprCols dflags)
|
||||
showDocWith _ = Pretty.showDocWith
|
||||
#endif
|
||||
|
||||
render :: Pretty.Doc -> String
|
||||
#if __GLASGOW_HASKELL__ >= 800
|
||||
render = Pretty.fullRender Pretty.PageMode 80 1.2 string_txt ""
|
||||
#else
|
||||
render = Pretty.fullRender Pretty.PageMode 80 1.2 string_txt ""
|
||||
#endif
|
||||
where
|
||||
string_txt :: Pretty.TextDetails -> String -> String
|
||||
string_txt (Pretty.Chr c) s = c:s
|
||||
string_txt (Pretty.Str s1) s2 = 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
|
||||
|
||||
|
||||
----------------------------------------------------------------
|
||||
----------------------------------------------------------------
|
||||
|
||||
|
||||
@@ -37,7 +37,7 @@ info file expr =
|
||||
convert' =<< body
|
||||
where
|
||||
handler (SomeException ex) = do
|
||||
gmLog GmException "info" $ text "" $$ nest 4 (showDoc ex)
|
||||
gmLog GmException "info" $ text "" $$ nest 4 (showToDoc ex)
|
||||
convert' "Cannot show info"
|
||||
|
||||
body :: (GhcMonad m, GmState m, GmEnv m) => m String
|
||||
@@ -69,7 +69,7 @@ types withConstraints file lineNo colNo =
|
||||
convert' $ map (toTup dflag st) $ sortBy (cmp `on` fst) srcSpanTypes
|
||||
where
|
||||
handler (SomeException ex) = do
|
||||
gmLog GmException "types" $ showDoc ex
|
||||
gmLog GmException "types" $ showToDoc ex
|
||||
return []
|
||||
|
||||
getSrcSpanType :: (GhcMonad m) => Bool -> G.ModSummary -> Int -> Int -> m [(SrcSpan, G.Type)]
|
||||
|
||||
@@ -32,8 +32,8 @@ import Language.Haskell.GhcMod.Doc (showPage)
|
||||
import Language.Haskell.GhcMod.DynFlags (withDynFlags)
|
||||
import Language.Haskell.GhcMod.Monad.Types
|
||||
import Language.Haskell.GhcMod.Error
|
||||
import Language.Haskell.GhcMod.Utils (mkRevRedirMapFunc)
|
||||
import Language.Haskell.GhcMod.Pretty
|
||||
import Language.Haskell.GhcMod.Utils (mkRevRedirMapFunc)
|
||||
import qualified Language.Haskell.GhcMod.Gap as Gap
|
||||
import Prelude
|
||||
|
||||
|
||||
@@ -14,7 +14,18 @@
|
||||
-- You should have received a copy of the GNU Affero General Public License
|
||||
-- along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
module Language.Haskell.GhcMod.Pretty where
|
||||
module Language.Haskell.GhcMod.Pretty
|
||||
( render
|
||||
, renderSDoc
|
||||
, gmComponentNameDoc
|
||||
, gmLogLevelDoc
|
||||
, (<+>:)
|
||||
, fnDoc
|
||||
, showToDoc
|
||||
, warnDoc
|
||||
, strLnDoc
|
||||
, strDoc
|
||||
) where
|
||||
|
||||
import Control.Arrow hiding ((<+>))
|
||||
import Data.Char
|
||||
@@ -26,12 +37,7 @@ import Outputable (SDoc, withPprStyleDoc)
|
||||
|
||||
import Language.Haskell.GhcMod.Types
|
||||
import Language.Haskell.GhcMod.Doc
|
||||
|
||||
docStyle :: Style
|
||||
docStyle = style { ribbonsPerLine = 1.2 }
|
||||
|
||||
render :: Doc -> String
|
||||
render = renderStyle docStyle
|
||||
import Language.Haskell.GhcMod.Gap (render)
|
||||
|
||||
renderSDoc :: GhcMonad m => SDoc -> m Doc
|
||||
renderSDoc sdoc = do
|
||||
@@ -64,8 +70,8 @@ a <+>: b = (a <> colon) <+> b
|
||||
fnDoc :: FilePath -> Doc
|
||||
fnDoc = doubleQuotes . text
|
||||
|
||||
showDoc :: Show a => a -> Doc
|
||||
showDoc = strLnDoc . show
|
||||
showToDoc :: Show a => a -> Doc
|
||||
showToDoc = strLnDoc . show
|
||||
|
||||
warnDoc :: Doc -> Doc
|
||||
warnDoc d = text "Warning" <+>: d
|
||||
|
||||
Reference in New Issue
Block a user