aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Interface/Specialize.hs
diff options
context:
space:
mode:
authorAlec Theriault <alec.theriault@gmail.com>2020-03-28 12:04:16 -0400
committerAlec Theriault <alec.theriault@gmail.com>2020-03-28 13:36:25 -0400
commit730a2163245cf7aaf389458113e6fa338eca7865 (patch)
tree8822a3ed69620eb56e01f185d46787d280f51032 /haddock-api/src/Haddock/Interface/Specialize.hs
parente68cc0f05c102193660466d611640aec922bc9a9 (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.hs17
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"