Fix parentheses around kind signatures, fixes #64

pull/75/head
Lennart Spitzner 2017-10-15 00:23:14 +02:00
parent f86665a251
commit b1c6be7acd
3 changed files with 67 additions and 12 deletions

View File

@ -477,3 +477,12 @@ test :: Proxy '[ 'True]
#pending fix does not work on 8.0.2
test :: Proxy '[Bool]
#test issue 64
{-# LANGUAGE RankNTypes, KindSignatures #-}
func
:: forall m str
. (Str str, Monad m)
=> Int
-> Proxy (str :: [*])
-> m (Tagged str String)

View File

@ -48,6 +48,7 @@ module Language.Haskell.Brittany.Internal.LayouterBasics
, allocateNode
, docSharedWrapper
, hasAnyCommentsBelow
, hasAnnKeyword
)
where
@ -239,6 +240,19 @@ hasAnyCommentsBelow ast@(L l _) = do
$ Map.elems
$ anns
hasAnnKeyword
:: (Data a, MonadMultiReader (Map AnnKey Annotation) m)
=> Located a
-> AnnKeywordId
-> m Bool
hasAnnKeyword ast annKeyword = do
anns <- mAsk
let hasK (ExactPrint.Types.G x, _) = x == annKeyword
hasK _ = False
pure $ case Map.lookup (ExactPrint.Types.mkAnnKey ast) anns of
Nothing -> False
Just (ExactPrint.Types.Ann _ _ _ aks _ _) -> any hasK aks
-- new BriDoc stuff
allocateNode

View File

@ -14,7 +14,11 @@ import Language.Haskell.Brittany.Internal.Types
import Language.Haskell.Brittany.Internal.LayouterBasics
import RdrName ( RdrName(..) )
import GHC ( runGhc, GenLocated(L), moduleNameString )
import GHC ( runGhc
, GenLocated(L)
, moduleNameString
, AnnKeywordId (..)
)
import Language.Haskell.GHC.ExactPrint.Types ( mkAnnKey )
import HsSyn
import Name
@ -521,19 +525,47 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
HsKindSig typ1 kind1 -> do
typeDoc1 <- docSharedWrapper layoutType typ1
kindDoc1 <- docSharedWrapper layoutType kind1
hasParens <- hasAnnKeyword ltype AnnOpenP
docAlt
[ docSeq
[ docForceSingleline typeDoc1
, docLit $ Text.pack " :: "
, docForceSingleline kindDoc1
]
, docPar
[ if hasParens
then docSeq
[ docLit $ Text.pack "("
, docForceSingleline typeDoc1
, docSeparator
, docLit $ Text.pack "::"
, docSeparator
, docForceSingleline kindDoc1
, docLit $ Text.pack ")"
]
else docSeq
[ docForceSingleline typeDoc1
, docSeparator
, docLit $ Text.pack "::"
, docSeparator
, docForceSingleline kindDoc1
]
, if hasParens
then docLines
[ docCols
ColTyOpPrefix
[ docWrapNodeRest ltype $ docParenLSep
, docAddBaseY (BrIndentSpecial 3) $ typeDoc1
]
, docCols
ColTyOpPrefix
[ docWrapNodeRest ltype $ docLit $ Text.pack ":: "
, docAddBaseY (BrIndentSpecial 3) kindDoc1
]
, (docLit $ Text.pack ")")
]
else docPar
typeDoc1
( docCols ColTyOpPrefix
[ docWrapNodeRest ltype
$ docLit $ Text.pack ":: "
, docAddBaseY (BrIndentSpecial 3) kindDoc1
])
( docCols
ColTyOpPrefix
[ docWrapNodeRest ltype $ docLit $ Text.pack ":: "
, docAddBaseY (BrIndentSpecial 3) kindDoc1
]
)
]
HsBangTy{} -> -- TODO
briDocByExactInlineOnly "HsBangTy{}" ltype