diff --git a/source/library/Language/Haskell/Brittany/Internal/Layouters/Type.hs b/source/library/Language/Haskell/Brittany/Internal/Layouters/Type.hs index b680984..a384078 100644 --- a/source/library/Language/Haskell/Brittany/Internal/Layouters/Type.hs +++ b/source/library/Language/Haskell/Brittany/Internal/Layouters/Type.hs @@ -1,10 +1,11 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE ViewPatterns #-} module Language.Haskell.Brittany.Internal.Layouters.Type where import qualified Data.Text as Text -import GHC (AnnKeywordId(..), GenLocated(L)) +import GHC (GenLocated(L)) import GHC.Hs import qualified GHC.OldList as List import GHC.Types.Basic @@ -18,8 +19,8 @@ import Language.Haskell.Brittany.Internal.Utils (FirstLastView(..), splitFirstLast) - -layoutType :: ToBriDoc ann HsType +--- XXX: maybe push `Anno (sym GhcPs)` into ToBriDoc definition in place of a typevar +layoutType :: ToBriDoc AnnListItem HsType layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of -- _ | traceShow (ExactPrint.Types.mkAnnKey ltype) False -> error "impossible" HsTyVar _ promoted name -> do @@ -27,7 +28,7 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of case promoted of IsPromoted -> docSeq [docSeparator, docTick, docWrapNode name $ docLit t] NotPromoted -> docWrapNode name $ docLit t - HsForAllTy _ hsf (L _ (HsQualTy _ (L _ cntxts) typ2)) -> do + HsForAllTy _ hsf (L _ (HsQualTy _ (fromMaybeContext -> cntxts) typ2)) -> do let bndrs = getBinders hsf typeDoc <- docSharedWrapper layoutType typ2 tyVarDocs <- layoutTyVarBndrs bndrs @@ -160,7 +161,7 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of ] ) ] - HsQualTy _ lcntxts@(L _ cntxts) typ1 -> do + HsQualTy _ (fromMaybe (noLocA []) -> lcntxts@(L _ cntxts)) typ1 -> do typeDoc <- docSharedWrapper layoutType typ1 cntxtDocs <- cntxts `forM` docSharedWrapper layoutType let @@ -578,6 +579,9 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of HsStrTy (GHC.Types.SourceText.SourceText srctext) _ -> docLit $ Text.pack srctext HsStrTy GHC.Types.SourceText.NoSourceText _ -> error "overLitValBriDoc: literal with no SourceText" + HsCharTy (GHC.Types.SourceText.SourceText srctext) _ -> docLit $ Text.pack srctext + HsCharTy GHC.Types.SourceText.NoSourceText _ -> + error "overLitValBriDoc: literal with no SourceText" HsWildCardTy _ -> docLit $ Text.pack "_" HsSumTy{} -> -- TODO briDocByExactInlineOnly "HsSumTy{}" ltype @@ -621,14 +625,12 @@ processTyVarBndrsSingleline bndrDocs = bndrDocs >>= \case , docLit $ Text.pack ")" ] -getBinders :: HsForAllTelescope pass -> [LHsTyVarBndr () pass] +getBinders :: HsForAllTelescope (GhcPass pass) -> [LHsTyVarBndr () (GhcPass pass)] getBinders x = case x of HsForAllVis _ b -> b HsForAllInvis _ b -> fmap withoutSpecificity b - XHsForAllTelescope _ -> [] -withoutSpecificity :: LHsTyVarBndr flag pass -> LHsTyVarBndr () pass +withoutSpecificity :: LHsTyVarBndr flag (GhcPass pass) -> LHsTyVarBndr () (GhcPass pass) withoutSpecificity = fmap $ \case UserTyVar a _ c -> UserTyVar a () c KindedTyVar a _ c d -> KindedTyVar a () c d - XTyVarBndr a -> XTyVarBndr a