implementing fromTyThing.
This commit is contained in:
parent
629cf409ae
commit
45154e6eb1
@ -11,6 +11,7 @@ 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
|
||||
@ -92,12 +93,15 @@ showExport opt minfo e = do
|
||||
justIf _ False = Nothing
|
||||
|
||||
showThing :: DynFlags -> TyThing -> Maybe String
|
||||
showThing dflag (AnId i) = Just $ formatType dflag varType i
|
||||
showThing dflag (ADataCon d) = Just $ formatType dflag dataConRepType d
|
||||
showThing _ (ATyCon t) = unwords . toList <$> tyType t
|
||||
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' _ (GtT t) = unwords . toList <$> tyType t
|
||||
where
|
||||
toList t' = t' : getOccString t : map getOccString (tyConTyVars t)
|
||||
showThing _ _ = Nothing
|
||||
showThing' _ _ = Nothing
|
||||
|
||||
formatType :: NamedThing a => DynFlags -> (a -> Type) -> a -> String
|
||||
formatType dflag f x = showOutputable dflag (removeForAlls $ f x)
|
||||
|
@ -27,6 +27,8 @@ module Language.Haskell.GhcMod.Gap (
|
||||
, module Pretty
|
||||
#endif
|
||||
, showDocWith
|
||||
, GapThing(..)
|
||||
, fromTyThing
|
||||
) where
|
||||
|
||||
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
|
||||
ty_env = tcg_type_env tcgEnv
|
||||
#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
|
||||
|
Loading…
Reference in New Issue
Block a user