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.List
import Data.Maybe (catMaybes)
import DataCon (dataConRepType)
import FastString (mkFastString)
import GHC
import Panic (throwGhcException)
import Language.Haskell.GhcMod.Doc (showUnqualifiedPage)
import Language.Haskell.GhcMod.GHCApi
import Language.Haskell.GhcMod.Gap
import Language.Haskell.GhcMod.Types
import Name
import Outputable
import Panic (throwGhcException)
import TyCon
import Type
import Var
----------------------------------------------------------------
@ -96,15 +94,14 @@ showThing :: DynFlags -> TyThing -> Maybe String
showThing dflag tything = showThing' dflag (fromTyThing tything)
showThing' :: DynFlags -> GapThing -> Maybe String
showThing' dflag (GtI i) = Just $ formatType dflag varType i
showThing' dflag (GtD d) = Just $ formatType dflag dataConRepType d
showThing' dflag (GtA a) = Just $ formatType dflag a
showThing' _ (GtT t) = unwords . toList <$> tyType t
where
toList t' = t' : getOccString t : map getOccString (tyConTyVars t)
showThing' _ _ = Nothing
formatType :: NamedThing a => DynFlags -> (a -> Type) -> a -> String
formatType dflag f x = showOutputable dflag (removeForAlls $ f x)
formatType :: DynFlags -> Type -> String
formatType dflag a = showOutputable dflag (removeForAlls a)
tyType :: TyCon -> Maybe String
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.Monad
import CoreSyn
import Data.List
import Data.Maybe
import Data.Time.Clock
import DataCon (dataConRepType)
import Desugar (deSugarExpr)
import DynFlags
import ErrUtils
@ -48,7 +50,7 @@ import Outputable
import PprTyThing
import StringBuffer
import TcType
import CoreSyn
import Var (varType)
import qualified InstEnv
import qualified Pretty
@ -56,7 +58,7 @@ import qualified StringBuffer as SB
#if __GLASGOW_HASKELL__ >= 707
import FamInstEnv
import ConLike (ConLike(..))
import PatSyn (patSynType)
import PatSyn (PatSyn, patSynType)
#else
import TcRnTypes
#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 (AnId i) = GtI i
fromTyThing (AnId i) = GtA $ varType i
#if __GLASGOW_HASKELL__ >= 707
fromTyThing (AConLike (RealDataCon d)) = GtD d
fromTyThing (AConLike (PatSynCon d)) = GtD d
fromTyThing (AConLike (RealDataCon d)) = GtA $ dataConRepType d
fromTyThing (AConLike (PatSynCon p)) = GtA $ patSynType p
#else
fromTyThing (ADataCon d) = GtD d
fromTyThing (ADataCon d) = GtA $ dataConRepType d
#endif
fromTyThing (ATyCon t) = GtT t
fromTyThing _ = GtN