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/Backends | |
| 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/Backends')
| -rw-r--r-- | haddock-api/src/Haddock/Backends/LaTeX.hs | 5 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Xhtml/Decl.hs | 3 |
2 files changed, 5 insertions, 3 deletions
diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs index 63b12a14..d52c136f 100644 --- a/haddock-api/src/Haddock/Backends/LaTeX.hs +++ b/haddock-api/src/Haddock/Backends/LaTeX.hs @@ -39,6 +39,7 @@ import Data.Char import Control.Monad import Data.Maybe import Data.List ( sort ) +import Data.Void ( absurd ) import Prelude hiding ((<>)) import Haddock.Doc (combineDocumentation) @@ -530,7 +531,7 @@ ppTyVars unicode = map (ppHsTyVarBndr unicode . unLoc) tyvarNames :: LHsQTyVars DocNameI -> [Name] -tyvarNames = map (getName . hsLTyVarNameI) . hsQTvExplicit +tyvarNames = map (getName . hsTyVarBndrName . unLoc) . hsQTvExplicit declWithDoc :: LaTeX -> Maybe LaTeX -> LaTeX @@ -1080,7 +1081,7 @@ ppr_mono_ty (HsSumTy _ tys) u = sumParens (map (ppLType u) tys) ppr_mono_ty (HsKindSig _ ty kind) u = ppr_mono_lty ty u <+> dcolon u <+> ppLKind u kind ppr_mono_ty (HsListTy _ ty) u = brackets (ppr_mono_lty ty u) ppr_mono_ty (HsIParamTy _ (L _ n) ty) u = ppIPName n <+> dcolon u <+> ppr_mono_lty ty u -ppr_mono_ty (HsSpliceTy {}) _ = error "ppr_mono_ty HsSpliceTy" +ppr_mono_ty (HsSpliceTy v _) _ = absurd v ppr_mono_ty (HsRecTy {}) _ = text "{..}" ppr_mono_ty (XHsType (NHsCoreTy {})) _ = error "ppr_mono_ty HsCoreTy" ppr_mono_ty (HsExplicitListTy _ IsPromoted tys) u = Pretty.quote $ brackets $ hsep $ punctuate comma $ map (ppLType u) tys diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs index b450dc94..25669ca7 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs @@ -32,6 +32,7 @@ import Haddock.Doc (combineDocumentation) import Data.List ( intersperse, sort ) import qualified Data.Map as Map import Data.Maybe +import Data.Void ( absurd ) import Text.XHtml hiding ( name, title, p, quote ) import BasicTypes (PromotionFlag(..), isPromoted) @@ -1215,7 +1216,7 @@ ppr_mono_ty (HsKindSig _ ty kind) u q e = ppr_mono_ty (HsListTy _ ty) u q _ = brackets (ppr_mono_lty ty u q HideEmptyContexts) ppr_mono_ty (HsIParamTy _ (L _ n) ty) u q _ = ppIPName n <+> dcolon u <+> ppr_mono_lty ty u q HideEmptyContexts -ppr_mono_ty (HsSpliceTy {}) _ _ _ = error "ppr_mono_ty HsSpliceTy" +ppr_mono_ty (HsSpliceTy v _) _ _ _ = absurd v ppr_mono_ty (HsRecTy {}) _ _ _ = toHtml "{..}" -- Can now legally occur in ConDeclGADT, the output here is to provide a -- placeholder in the signature, which is followed by the field |