diff options
author | Alec Theriault <alec.theriault@gmail.com> | 2020-03-28 12:04:16 -0400 |
---|---|---|
committer | Alec Theriault <alec.theriault@gmail.com> | 2020-03-28 13:36:25 -0400 |
commit | 730a2163245cf7aaf389458113e6fa338eca7865 (patch) | |
tree | 8822a3ed69620eb56e01f185d46787d280f51032 /haddock-api/src/Haddock/Interface/Specialize.hs | |
parent | e68cc0f05c102193660466d611640aec922bc9a9 (diff) |
Use TTG empty extensions to remove some `error`'s
None of these error cases should ever have been reachable, so this is
just a matter of leveraging the type system to assert this.
* Use the `NoExtCon` and `noExtCon` to handle case matches for no
extension constructors, instead of throwing an `error`.
* Use the extension field of `HsSpliceTy` to ensure that this variant
of `HsType` cannot exist in an `HsType DocNameI`.
Diffstat (limited to 'haddock-api/src/Haddock/Interface/Specialize.hs')
-rw-r--r-- | haddock-api/src/Haddock/Interface/Specialize.hs | 17 |
1 files changed, 5 insertions, 12 deletions
diff --git a/haddock-api/src/Haddock/Interface/Specialize.hs b/haddock-api/src/Haddock/Interface/Specialize.hs index 03cc1b7e..19b03596 100644 --- a/haddock-api/src/Haddock/Interface/Specialize.hs +++ b/haddock-api/src/Haddock/Interface/Specialize.hs @@ -9,6 +9,7 @@ module Haddock.Interface.Specialize ) where +import Haddock.GhcUtils ( hsTyVarBndrName ) import Haddock.Syb import Haddock.Types @@ -56,13 +57,9 @@ specialize specs = go spec_map0 -- Again, it is just a convenience function around 'specialize'. Note that -- length of type list should be the same as the number of binders. specializeTyVarBndrs :: LHsQTyVars GhcRn -> [HsType GhcRn] -> HsType GhcRn -> HsType GhcRn -specializeTyVarBndrs bndrs typs = - specialize $ zip bndrs' typs +specializeTyVarBndrs bndrs typs = specialize $ zip bndrs' typs where - bndrs' = map (bname . unLoc) . hsq_explicit $ bndrs - bname (UserTyVar _ (L _ name)) = name - bname (KindedTyVar _ (L _ name) _) = name - bname (XTyVarBndr _) = error "haddock:specializeTyVarBndrs" + bndrs' = map (hsTyVarBndrName . unLoc) . hsq_explicit $ bndrs @@ -212,7 +209,7 @@ freeVariables = | getName name `Set.member` ctx -> (Set.empty, ctx) | otherwise -> (Set.singleton $ getName name, ctx) _ -> (Set.empty, ctx) - bndrsNames = Set.fromList . map (getName . tyVarName . unLoc) + bndrsNames = Set.fromList . map (getName . hsTyVarBndrName . unLoc) -- | Make given type visually unambiguous. @@ -295,7 +292,7 @@ renameBinder :: HsTyVarBndr GhcRn -> Rename (IdP GhcRn) (HsTyVarBndr GhcRn) renameBinder (UserTyVar x lname) = UserTyVar x <$> located renameName lname renameBinder (KindedTyVar x lname lkind) = KindedTyVar x <$> located renameName lname <*> located renameType lkind -renameBinder (XTyVarBndr _) = error "haddock:renameBinder" +renameBinder (XTyVarBndr nec) = noExtCon nec -- | Core renaming logic. renameName :: (Eq name, SetName name) => name -> Rename name name @@ -349,7 +346,3 @@ located :: Functor f => (a -> f b) -> Located a -> f (Located b) located f (L loc e) = L loc <$> f e -tyVarName :: HsTyVarBndr name -> IdP name -tyVarName (UserTyVar _ name) = unLoc name -tyVarName (KindedTyVar _ (L _ name) _) = name -tyVarName (XTyVarBndr _ ) = error "haddock:tyVarName" |