diff --git a/src/Language/Haskell/Brittany/LayoutBasics.hs b/src/Language/Haskell/Brittany/LayoutBasics.hs index 181f4a6..f44c130 100644 --- a/src/Language/Haskell/Brittany/LayoutBasics.hs +++ b/src/Language/Haskell/Brittany/LayoutBasics.hs @@ -12,6 +12,7 @@ module Language.Haskell.Brittany.LayoutBasics , rdrNameToText , lrdrNameToText , lrdrNameToTextAnn + , lrdrNameToTextAnnTypeEqualityIsSpecial , askIndent , layoutWriteAppend , layoutWriteAppendMultiline @@ -192,6 +193,15 @@ lrdrNameToTextAnn ast@(L _ n) = do _ | any (hasUni AnnOpenP) aks -> Text.pack "(" <> t <> Text.pack ")" _ | otherwise -> t +lrdrNameToTextAnnTypeEqualityIsSpecial + :: (MonadMultiReader Config m, MonadMultiReader (Map AnnKey Annotation) m) + => GenLocated SrcSpan RdrName + -> m Text +lrdrNameToTextAnnTypeEqualityIsSpecial ast = do + x <- lrdrNameToTextAnn ast + return $ if x == Text.pack "Data.Type.Equality~" + then Text.pack "~" -- rraaaahhh special casing rraaahhhhhh + else x askIndent :: (MonadMultiReader Config m) => m Int askIndent = runIdentity . _lconfig_indentAmount . _conf_layout <$> mAsk @@ -369,6 +379,7 @@ layoutWriteEnsureNewlineBlock = do Right i -> Right $ max 1 i , _lstate_addSepSpace = Just $ _lstate_baseY state , _lstate_inhibitMTEL = False + , _lstate_commentCol = Nothing } layoutWriteEnsureBlock :: (MonadMultiWriter diff --git a/src/Language/Haskell/Brittany/Layouters/Type.hs b/src/Language/Haskell/Brittany/Layouters/Type.hs index 515514d..efac1ff 100644 --- a/src/Language/Haskell/Brittany/Layouters/Type.hs +++ b/src/Language/Haskell/Brittany/Layouters/Type.hs @@ -29,7 +29,7 @@ layoutType :: ToBriDoc HsType layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of -- _ | traceShow (ExactPrint.Types.mkAnnKey ltype) False -> error "impossible" HsTyVar name -> do - let t = lrdrNameToText name + t <- lrdrNameToTextAnn name docLit t HsForAllTy bndrs (L _ (HsQualTy (L _ cntxts@(_:_)) typ2)) -> do typeDoc <- docSharedWrapper layoutType typ2 @@ -284,7 +284,7 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of HsAppsTy [L _ (HsAppPrefix typ1)] -> do typeDoc1 <- docSharedWrapper layoutType typ1 typeDoc1 - HsAppsTy [L l (HsAppInfix name)] -> do + HsAppsTy [_lname@(L _ (HsAppInfix name))] -> do -- this redirection is somewhat hacky, but whatever. -- TODO: a general problem when doing deep inspections on -- the type (and this is not the only instance) @@ -292,8 +292,9 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of -- the middle constructors. i have no idea under which -- circumstances exactly important annotations (comments) -- would be assigned to such constructors. - typeDoc1 <- docSharedWrapper layoutType $ (L l $ HsTyVar name) - typeDoc1 + typeDoc1 <- -- docSharedWrapper layoutType $ (L l $ HsTyVar name) + lrdrNameToTextAnnTypeEqualityIsSpecial name + docLit typeDoc1 HsAppsTy (L _ (HsAppPrefix typHead):typRestA) | Just typRest <- mapM (\case L _ (HsAppPrefix t) -> Just t _ -> Nothing) typRestA -> do @@ -316,7 +317,7 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of ] where layoutAppType (L _ (HsAppPrefix t)) = layoutType t - layoutAppType (L _ (HsAppInfix t)) = docLit =<< lrdrNameToTextAnn t + layoutAppType (L _ (HsAppInfix t)) = docLit =<< lrdrNameToTextAnnTypeEqualityIsSpecial t HsListTy typ1 -> do typeDoc1 <- docSharedWrapper layoutType typ1 docAlt