hasufell
/
ghc-mod
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

burying the gap.

This commit is contained in:
Kazu Yamamoto 2014-02-06 22:09:00 +09:00
parent 891ddf639b
commit fb0222ff76
2 changed files with 13 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
Language/Haskell/GhcMod/Browse.hs
View File

@ -5,19 +5,17 @@ import Control.Monad (void)
import Data.Char import Data.Char
import Data.List import Data.List
import Data.Maybe (catMaybes) import Data.Maybe (catMaybes)
import DataCon (dataConRepType)
import FastString (mkFastString) import FastString (mkFastString)
import GHC import GHC
import Panic (throwGhcException)
import Language.Haskell.GhcMod.Doc (showUnqualifiedPage) import Language.Haskell.GhcMod.Doc (showUnqualifiedPage)
import Language.Haskell.GhcMod.GHCApi import Language.Haskell.GhcMod.GHCApi
import Language.Haskell.GhcMod.Gap import Language.Haskell.GhcMod.Gap
import Language.Haskell.GhcMod.Types import Language.Haskell.GhcMod.Types
import Name import Name
import Outputable import Outputable
import Panic (throwGhcException)
import TyCon import TyCon
import Type import Type
import Var
---------------------------------------------------------------- ----------------------------------------------------------------
@ -96,15 +94,14 @@ showThing :: DynFlags -> TyThing -> Maybe String
showThing dflag tything = showThing' dflag (fromTyThing tything) showThing dflag tything = showThing' dflag (fromTyThing tything)
showThing' :: DynFlags -> GapThing -> Maybe String showThing' :: DynFlags -> GapThing -> Maybe String
showThing' dflag (GtI i) = Just $ formatType dflag varType i showThing' dflag (GtA a) = Just $ formatType dflag a
showThing' dflag (GtD d) = Just $ formatType dflag dataConRepType d
showThing' _ (GtT t) = unwords . toList <$> tyType t showThing' _ (GtT t) = unwords . toList <$> tyType t
where where
toList t' = t' : getOccString t : map getOccString (tyConTyVars t) toList t' = t' : getOccString t : map getOccString (tyConTyVars t)
showThing' _ _ = Nothing showThing' _ _ = Nothing
formatType :: NamedThing a => DynFlags -> (a -> Type) -> a -> String formatType :: DynFlags -> Type -> String
formatType dflag f x = showOutputable dflag (removeForAlls $ f x) formatType dflag a = showOutputable dflag (removeForAlls a)
tyType :: TyCon -> Maybe String tyType :: TyCon -> Maybe String
tyType typ tyType typ

16
Language/Haskell/GhcMod/Gap.hs
View File

@ -33,9 +33,11 @@ module Language.Haskell.GhcMod.Gap (
import Control.Applicative hiding (empty) import Control.Applicative hiding (empty)
import Control.Monad import Control.Monad
import CoreSyn
import Data.List import Data.List
import Data.Maybe import Data.Maybe
import Data.Time.Clock import Data.Time.Clock
import DataCon (dataConRepType)
import Desugar (deSugarExpr) import Desugar (deSugarExpr)
import DynFlags import DynFlags
import ErrUtils import ErrUtils
@ -48,7 +50,7 @@ import Outputable
import PprTyThing import PprTyThing
import StringBuffer import StringBuffer
import TcType import TcType
import CoreSyn import Var (varType)
import qualified InstEnv import qualified InstEnv
import qualified Pretty import qualified Pretty
@ -56,7 +58,7 @@ import qualified StringBuffer as SB
#if __GLASGOW_HASKELL__ >= 707 #if __GLASGOW_HASKELL__ >= 707
import FamInstEnv import FamInstEnv
import ConLike (ConLike(..)) import ConLike (ConLike(..))
import PatSyn (patSynType) import PatSyn (PatSyn, patSynType)
#else #else
import TcRnTypes import TcRnTypes
#endif #endif
@ -337,15 +339,15 @@ deSugar tcm e hs_env = snd <$> deSugarExpr hs_env modu rn_env ty_env e
---------------------------------------------------------------- ----------------------------------------------------------------
---------------------------------------------------------------- ----------------------------------------------------------------
data GapThing = GtI Id | GtD DataCon | GtT TyCon | GtN data GapThing = GtA Type | GtT TyCon | GtN
fromTyThing :: TyThing -> GapThing fromTyThing :: TyThing -> GapThing
fromTyThing (AnId i) = GtI i fromTyThing (AnId i) = GtA $ varType i
#if __GLASGOW_HASKELL__ >= 707 #if __GLASGOW_HASKELL__ >= 707
fromTyThing (AConLike (RealDataCon d)) = GtD d fromTyThing (AConLike (RealDataCon d)) = GtA $ dataConRepType d
fromTyThing (AConLike (PatSynCon d)) = GtD d fromTyThing (AConLike (PatSynCon p)) = GtA $ patSynType p
#else #else
fromTyThing (ADataCon d) = GtD d fromTyThing (ADataCon d) = GtA $ dataConRepType d
#endif #endif
fromTyThing (ATyCon t) = GtT t fromTyThing (ATyCon t) = GtT t
fromTyThing _ = GtN fromTyThing _ = GtN