implementing fromTyThing.
This commit is contained in:
parent
629cf409ae
commit
45154e6eb1
@ -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)
|
||||||
|
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user