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

implementing fromTyThing.

This commit is contained in:
Kazu Yamamoto 2014-02-06 21:34:40 +09:00
parent 629cf409ae
commit 45154e6eb1
2 changed files with 21 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -11,6 +11,7 @@ import GHC
import Panic (throwGhcException) 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.Types import Language.Haskell.GhcMod.Types
import Name import Name
import Outputable import Outputable
@ -92,12 +93,15 @@ showExport opt minfo e = do
justIf _ False = Nothing justIf _ False = Nothing
showThing :: DynFlags -> TyThing -> Maybe String showThing :: DynFlags -> TyThing -> Maybe String
showThing dflag (AnId i) = Just $ formatType dflag varType i showThing dflag tything = showThing' dflag (fromTyThing tything)
showThing dflag (ADataCon d) = Just $ formatType dflag dataConRepType d
showThing _ (ATyCon t) = unwords . toList <$> tyType t showThing' :: DynFlags -> GapThing -> Maybe String
showThing' dflag (GtI i) = Just $ formatType dflag varType i
showThing' dflag (GtD d) = Just $ formatType dflag dataConRepType d
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 :: NamedThing a => DynFlags -> (a -> Type) -> a -> String
formatType dflag f x = showOutputable dflag (removeForAlls $ f x) formatType dflag f x = showOutputable dflag (removeForAlls $ f x)

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

@ -27,6 +27,8 @@ module Language.Haskell.GhcMod.Gap (
, module Pretty , module Pretty
#endif #endif
, showDocWith , showDocWith
, GapThing(..)
, fromTyThing
) where ) where
import Control.Applicative hiding (empty) import Control.Applicative hiding (empty)
@ -329,3 +331,14 @@ deSugar tcm e hs_env = snd <$> deSugarExpr hs_env modu rn_env ty_env e
rn_env = tcg_rdr_env tcgEnv rn_env = tcg_rdr_env tcgEnv
ty_env = tcg_type_env tcgEnv ty_env = tcg_type_env tcgEnv
#endif #endif
----------------------------------------------------------------
----------------------------------------------------------------
data GapThing = GtI Id | GtD DataCon | GtT TyCon | GtN
fromTyThing :: TyThing -> GapThing
fromTyThing (AnId i) = GtI i
fromTyThing (ADataCon d) = GtD d
fromTyThing (ATyCon t) = GtT t
fromTyThing _ = GtN