From 8b7b1334e2f4b474051efd770cb17508f3249005 Mon Sep 17 00:00:00 2001
From: Lennart Spitzner <lsp@informatik.uni-kiel.de>
Date: Thu, 18 May 2017 14:18:10 +0200
Subject: [PATCH] Fix forall type signature layouting

---
 src-literatetests/tests.blt                   | 25 ++++++++++++++++++-
 .../Haskell/Brittany/Layouters/Type.hs        | 19 ++++++++++----
 2 files changed, 38 insertions(+), 6 deletions(-)

diff --git a/src-literatetests/tests.blt b/src-literatetests/tests.blt
index 089d007..f7ce7f1 100644
--- a/src-literatetests/tests.blt
+++ b/src-literatetests/tests.blt
@@ -209,9 +209,32 @@ test052 ::  lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
 
 #test forall oneliner
 {-# LANGUAGE ScopedTypeVariables #-}
---this comment is necessary for whatever reason..
 func :: forall (a :: *) b . a -> b
 
+#test forall context multiline
+{-# LANGUAGE ScopedTypeVariables #-}
+func
+  :: forall m
+   . Foo
+  => ColMap2
+  -> ColInfo
+  -> ColInfo
+  -> ColInfo
+  -> ColInfo
+  -> m ()
+
+#test forall no-context multiline
+{-# LANGUAGE ScopedTypeVariables #-}
+func
+  :: forall m
+  .  ColMap2
+  -> ColInfo
+  -> ColInfo
+  -> ColInfo
+  -> ColInfo
+  -> ColInfo
+  -> m ()
+
 #test language pragma issue
 {-# LANGUAGE ScopedTypeVariables #-}
 func :: forall (a :: *) b . a -> b
diff --git a/src/Language/Haskell/Brittany/Layouters/Type.hs b/src/Language/Haskell/Brittany/Layouters/Type.hs
index 1004ec5..2c42029 100644
--- a/src/Language/Haskell/Brittany/Layouters/Type.hs
+++ b/src/Language/Haskell/Brittany/Layouters/Type.hs
@@ -105,7 +105,7 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
               in docSeq ([open]++tyVarDocLineList++[close])
         , docForceSingleline contextDoc
         , docLit $ Text.pack " => "
-        , typeDoc
+        , docForceSingleline typeDoc
         ]
       -- :: forall a b c
       --  . (Foo a b c)
@@ -117,7 +117,7 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
             [ docCols ColTyOpPrefix
               [ docWrapNodeRest ltype $ docLit $ Text.pack " . "
               , docAddBaseY (BrIndentSpecial 3)
-              $ docForceSingleline contextDoc
+              $ contextDoc
               ]
             , docCols ColTyOpPrefix
               [ docLit $ Text.pack "=> "
@@ -133,6 +133,9 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
       (L _ (KindedTyVar lrdrName kind)) -> do
         d <- layoutType kind
         return $ (lrdrNameToText lrdrName, Just $ return d)
+    let maybeForceML = case typ2 of
+          (L _ HsFunTy{}) -> docForceMultiline
+          _               -> id
     let
       tyVarDocLineList = tyVarDocs >>= \case
         (tname, Nothing) -> [docLit $ Text.pack " " <> tname]
@@ -143,6 +146,7 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
                              , docLit $ Text.pack ")"
                              ]
     docAlt
+      -- forall x . x
       [ docSeq
         [ if null bndrs
             then docEmpty
@@ -150,15 +154,20 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
               open = docLit $ Text.pack "forall"
               close = docLit $ Text.pack " . "
               in docSeq ([open]++tyVarDocLineList++[close])
-        , return typeDoc
+        , docForceSingleline $ return $ typeDoc
         ]
+      -- :: forall x
+      -- .  x
       , docPar
           (docSeq $ docLit (Text.pack "forall") : tyVarDocLineList)
           ( docCols ColTyOpPrefix
             [ docWrapNodeRest ltype $ docLit $ Text.pack ". "
-            , return typeDoc
+            , maybeForceML $ return typeDoc
             ]
           )
+      -- :: forall
+      --      (x :: *)
+      -- .  x
       , docPar
           (docLit (Text.pack "forall"))
           (docLines
@@ -179,7 +188,7 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
             )
           ++[ docCols ColTyOpPrefix
               [ docWrapNodeRest ltype $ docLit $ Text.pack ". "
-              , return typeDoc
+              , maybeForceML $ return typeDoc
               ]
             ]
           )