From b1c6be7acd3a65bd55667388288ea15c1ea31cba Mon Sep 17 00:00:00 2001
From: Lennart Spitzner <hexagoxel@hexagoxel.de>
Date: Sun, 15 Oct 2017 00:23:14 +0200
Subject: [PATCH] Fix parentheses around kind signatures, fixes #64

---
 src-literatetests/15-regressions.blt          |  9 +++
 .../Brittany/Internal/LayouterBasics.hs       | 14 +++++
 .../Brittany/Internal/Layouters/Type.hs       | 56 +++++++++++++++----
 3 files changed, 67 insertions(+), 12 deletions(-)

diff --git a/src-literatetests/15-regressions.blt b/src-literatetests/15-regressions.blt
index 2a7185b..bea97cc 100644
--- a/src-literatetests/15-regressions.blt
+++ b/src-literatetests/15-regressions.blt
@@ -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)
+
diff --git a/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs b/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs
index 14a0510..a0a3c7b 100644
--- a/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs
+++ b/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs
@@ -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
diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs
index 9fa7262..a5148f5 100644
--- a/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs
+++ b/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs
@@ -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