Add Pattern Synonyms for GHC 8.6.4

Author: fendor

hie-plugin-api/Haskell/Ide/Engine/Compat.hs

@@ -1,6 +1,14 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE ViewPatterns #-}
 module Haskell.Ide.Engine.Compat where
 
+
+import qualified GHC
+import qualified Type
+import qualified TcHsSyn
+import qualified TysWiredIn
+
 #if MIN_VERSION_filepath(1,4,2)
 #else
 import Data.List
@@ -27,3 +35,35 @@ isExtensionOf :: String -> FilePath -> Bool
 isExtensionOf ext@('.':_) = isSuffixOf ext . takeExtensions
 isExtensionOf ext         = isSuffixOf ('.':ext) . takeExtensions
 #endif
+
+
+#if MIN_VERSION_ghc(8, 6, 0)
+
+pattern HsOverLitType :: Type.Type -> GHC.HsExpr GHC.GhcTc
+pattern HsOverLitType t <- GHC.HsOverLit _ (GHC.overLitType -> t)
+
+pattern HsLitType :: Type.Type -> GHC.HsExpr GHC.GhcTc
+pattern HsLitType t <- GHC.HsLit     _ (TcHsSyn.hsLitType -> t)
+
+pattern HsLamType :: Type.Type -> GHC.HsExpr GHC.GhcTc
+pattern HsLamType t <- GHC.HsLam _ ((\(GHC.MG { GHC.mg_ext = groupTy }) -> matchGroupType groupTy) -> t)
+
+pattern HsLamCaseType :: Type.Type -> GHC.HsExpr GHC.GhcTc
+pattern HsLamCaseType t <- GHC.HsLamCase _ ((\(GHC.MG { GHC.mg_ext = groupTy }) -> matchGroupType groupTy) -> t)
+
+pattern HsCaseType :: Type.Type -> GHC.HsExpr GHC.GhcTc
+pattern HsCaseType t <- GHC.HsCase _ _ ((\(GHC.MG { GHC.mg_ext = groupTy }) -> matchGroupType groupTy) -> t)
+
+pattern ExplicitListType :: Type.Type -> GHC.HsExpr GHC.GhcTc
+pattern ExplicitListType t <- GHC.ExplicitList (TysWiredIn.mkListTy -> t) _ _
+
+pattern ExplicitSumType :: Type.Type -> GHC.HsExpr GHC.GhcTc
+pattern ExplicitSumType t <- GHC.ExplicitSum (TysWiredIn.mkSumTy -> t) _ _ _
+
+pattern HsMultiIfType :: Type.Type -> GHC.HsExpr GHC.GhcTc
+pattern HsMultiIfType t <- GHC.HsMultiIf t _
+
+matchGroupType :: GHC.MatchGroupTc -> GHC.Type
+matchGroupType (GHC.MatchGroupTc args res) = Type.mkFunTys args res
+
+#endif

hie-plugin-api/Haskell/Ide/Engine/TypeMap.hs

@@ -15,10 +15,10 @@ import           Data.Data                     as Data
 import           Control.Monad.IO.Class
 import           Data.Maybe
 import qualified TcHsSyn
-import qualified TysWiredIn
 import qualified CoreUtils
 import qualified Type
 import qualified Desugar
+import           Haskell.Ide.Engine.Compat
 
 import           Haskell.Ide.Engine.ArtifactMap
 
@@ -118,20 +118,14 @@ getType hs_env e@(GHC.L spn e') =
   -- Some expression forms have their type immediately available
   let
     tyOpt = case e' of
-      GHC.HsLit     _ l -> Just (TcHsSyn.hsLitType l)
-      GHC.HsOverLit _ o -> Just (GHC.overLitType o)
-
-      GHC.HsLam _ GHC.MG { GHC.mg_ext = groupTy } ->
-        Just (matchGroupType groupTy)
-      GHC.HsLamCase _ GHC.MG { GHC.mg_ext = groupTy } ->
-        Just (matchGroupType groupTy)
-      GHC.HsCase _ _ GHC.MG { GHC.mg_ext = groupTy } ->
-        Just (GHC.mg_res_ty groupTy)
-
-      GHC.ExplicitList ty _ _  -> Just (TysWiredIn.mkListTy ty)
-      GHC.ExplicitSum ty _ _ _ -> Just (TysWiredIn.mkSumTy ty)
-      GHC.HsDo ty _ _          -> Just ty
-      GHC.HsMultiIf ty _       -> Just ty
+      HsOverLitType t -> Just t
+      HsLitType t -> Just t
+      HsLamType t -> Just t
+      HsLamCaseType t -> Just t
+      HsCaseType t -> Just t
+      ExplicitListType t -> Just t
+      ExplicitSumType t -> Just t
+      HsMultiIfType t -> Just t
 
       _                        -> Nothing
   in  case tyOpt of
@@ -142,8 +136,6 @@ getType hs_env e@(GHC.L spn e') =
             let res = (spn, ) . CoreUtils.exprType <$> mbe
             pure res
  where
-  matchGroupType :: GHC.MatchGroupTc -> GHC.Type
-  matchGroupType (GHC.MatchGroupTc args res) = Type.mkFunTys args res
   -- | Skip desugaring of these expressions for performance reasons.
   --
   -- See impact on Haddock output (esp. missing type annotations or links)