From 37e355fea57133302f0fc4b27cc358b5b3745466 Mon Sep 17 00:00:00 2001
From: Lennart Spitzner <hexagoxel@hexagoxel.de>
Date: Thu, 28 Dec 2017 21:38:31 +0100
Subject: [PATCH] Support hanging type signature config option

---
 src-literatetests/Main.hs                     |  1 +
 src-unittests/TestUtils.hs                    |  1 +
 .../Haskell/Brittany/Internal/Config.hs       |  2 +
 .../Haskell/Brittany/Internal/Config/Types.hs | 11 +++++
 .../Brittany/Internal/Layouters/Decl.hs       | 48 ++++++++++++-------
 5 files changed, 47 insertions(+), 16 deletions(-)

diff --git a/src-literatetests/Main.hs b/src-literatetests/Main.hs
index 938aca6..5567e68 100644
--- a/src-literatetests/Main.hs
+++ b/src-literatetests/Main.hs
@@ -173,6 +173,7 @@ defaultTestConfig = Config
     , _lconfig_columnAlignMode           = coerce (ColumnAlignModeMajority 0.7)
     , _lconfig_alignmentLimit            = coerce (30 :: Int)
     , _lconfig_alignmentBreakOnMultiline = coerce True
+    , _lconfig_hangingTypeSignature      = coerce False
     }
   , _conf_errorHandling = (_conf_errorHandling staticDefaultConfig)
     { _econf_omit_output_valid_check = coerce True
diff --git a/src-unittests/TestUtils.hs b/src-unittests/TestUtils.hs
index 30eac3e..1ee5203 100644
--- a/src-unittests/TestUtils.hs
+++ b/src-unittests/TestUtils.hs
@@ -55,6 +55,7 @@ defaultTestConfig = Config
     , _lconfig_columnAlignMode           = coerce (ColumnAlignModeMajority 0.7)
     , _lconfig_alignmentLimit            = coerce (30 :: Int)
     , _lconfig_alignmentBreakOnMultiline = coerce True
+    , _lconfig_hangingTypeSignature      = coerce False
     }
   , _conf_errorHandling = (_conf_errorHandling staticDefaultConfig)
     { _econf_ExactPrintFallback = coerce ExactPrintFallbackModeNever
diff --git a/src/Language/Haskell/Brittany/Internal/Config.hs b/src/Language/Haskell/Brittany/Internal/Config.hs
index baaca1f..f225545 100644
--- a/src/Language/Haskell/Brittany/Internal/Config.hs
+++ b/src/Language/Haskell/Brittany/Internal/Config.hs
@@ -63,6 +63,7 @@ staticDefaultConfig = Config
     , _lconfig_columnAlignMode           = coerce (ColumnAlignModeMajority 0.7)
     , _lconfig_alignmentLimit            = coerce (30 :: Int)
     , _lconfig_alignmentBreakOnMultiline = coerce True
+    , _lconfig_hangingTypeSignature      = coerce False
     }
   , _conf_errorHandling = ErrorHandlingConfig
     { _econf_produceOutputOnErrors   = coerce False
@@ -156,6 +157,7 @@ configParser = do
       , _lconfig_columnAlignMode           = mempty
       , _lconfig_alignmentLimit            = mempty
       , _lconfig_alignmentBreakOnMultiline = mempty
+      , _lconfig_hangingTypeSignature      = mempty
       }
     , _conf_errorHandling = ErrorHandlingConfig
       { _econf_produceOutputOnErrors   = wrapLast $ falseToNothing outputOnErrors
diff --git a/src/Language/Haskell/Brittany/Internal/Config/Types.hs b/src/Language/Haskell/Brittany/Internal/Config/Types.hs
index d726d8a..f2530b0 100644
--- a/src/Language/Haskell/Brittany/Internal/Config/Types.hs
+++ b/src/Language/Haskell/Brittany/Internal/Config/Types.hs
@@ -73,6 +73,17 @@ data CLayoutConfig f = LayoutConfig
     --     short <- some more stuff
     --       that requires two lines
     --     loooooooong <- stuff
+  , _lconfig_hangingTypeSignature :: f (Last Bool)
+    -- Do not put "::" in a new line, and use hanging indentation for the
+    -- signature, i.e.:
+    -- func :: SomeLongStuff
+    --      -> SomeLongStuff
+    -- instead of the usual
+    -- func
+    --   :: SomeLongStuff
+    --   -> SomeLongStuff
+    -- As usual for hanging indentation, the result will be
+    -- context-sensitive (in the function name).
   }
   deriving (Generic)
 
diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs
index 30e26c2..8724291 100644
--- a/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs
+++ b/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs
@@ -52,23 +52,39 @@ layoutSig lsig@(L _loc sig) = case sig of
     let nameStr = Text.intercalate (Text.pack ", ") $ nameStrs
     typeDoc     <- docSharedWrapper layoutType typ
     hasComments <- hasAnyCommentsBelow lsig
-    docAlt
-      $  [ docSeq
-           [ appSep $ docWrapNodeRest lsig $ docLit nameStr
-           , appSep $ docLit $ Text.pack "::"
-           , docForceSingleline typeDoc
-           ]
-         | not hasComments
-         ]
-      ++ [ docAddBaseY BrIndentRegular $ docPar
-           (docWrapNodeRest lsig $ docLit nameStr)
-           ( docCols
-             ColTyOpPrefix
-             [ docLit $ Text.pack ":: "
-             , docAddBaseY (BrIndentSpecial 3) $ typeDoc
+    shouldBeHanging <- mAsk
+      <&> _conf_layout
+      .>  _lconfig_hangingTypeSignature
+      .>  confUnpack
+    if shouldBeHanging
+      then docSeq
+        [ appSep $ docWrapNodeRest lsig $ docLit nameStr
+        , docSetBaseY $ docLines
+          [ docCols
+            ColTyOpPrefix
+            [ docLit $ Text.pack ":: "
+            , docAddBaseY (BrIndentSpecial 3) $ typeDoc
+            ]
+          ]
+        ]
+      else
+        docAlt
+          $  [ docSeq
+               [ appSep $ docWrapNodeRest lsig $ docLit nameStr
+               , appSep $ docLit $ Text.pack "::"
+               , docForceSingleline typeDoc
+               ]
+             | not hasComments
+             ]
+          ++ [ docAddBaseY BrIndentRegular $ docPar
+               (docWrapNodeRest lsig $ docLit nameStr)
+               ( docCols
+                 ColTyOpPrefix
+                 [ docLit $ Text.pack ":: "
+                 , docAddBaseY (BrIndentSpecial 3) $ typeDoc
+                 ]
+               )
              ]
-           )
-         ]
   InlineSig name (InlinePragma _ spec _arity phaseAct conlike) ->
     docWrapNode lsig $ do
       nameStr <- lrdrNameToTextAnn name