More liberal way of aligning matches

src/Floskell/Pretty.hs

@@ -111,7 +111,7 @@
     if nl
         then do
             printCommentsBefore True ast
-            onside $ prettyPrint ast
+            onside $ cut $ prettyPrint ast
             printCommentsAfter ast
         else onside $ pretty ast
 
@@ -181,7 +181,7 @@
 
 printCommentsAfter :: Annotated ast => ast NodeInfo -> Printer ()
 printCommentsAfter ast = unless (null comments) $ suppressOnside $ do
     let distance = srcSpanStartLine (commentSpan (head comments))
             - srcSpanEndLine (nodeSpan ast)
     when (distance > 0) $ do
         ensureNewline
@@ -193,8 +193,8 @@
 
 printCommentsInternal :: Int -> [Comment] -> Printer ()
 printCommentsInternal correction comments = do
     printComment correction (head comments)
     forM_ (zip (tail comments) (map (srcSpanEndLine . commentSpan) comments)) $
         \(comment, prevLine) -> do
             let nextLine = srcSpanStartLine $ commentSpan comment
             replicateM_ (nextLine - prevLine) newline
@@ -414,7 +414,9 @@
 measure' p = fmap (: []) <$> measure p
 
 measureMatch :: Match NodeInfo -> Printer (Maybe [Int])
-measureMatch (Match _ name pats _ Nothing) = measure' (prettyApp name pats)
+measureMatch (Match _ name pats rhs _) = case rhs of
+    UnGuardedRhs _ _ -> measure' (prettyApp name pats)
+    GuardedRhss _ grhss -> fmap sequence (mapM measureGuardedRhs grhss)
 measureMatch (InfixMatch _ pat name pats _ Nothing) = measure' go
   where
     go = do
@@ -426,6 +428,12 @@
         inter spaceOrNewline $ map pretty pats
 measureMatch _ = return Nothing
 
+measureGuardedRhs :: GuardedRhs NodeInfo -> Printer (Maybe Int)
+measureGuardedRhs (GuardedRhs _ stmts _) = measure $
+    withIndentConfig cfgIndentMultiIf (space >> aligned p) (flip indented p)
+  where
+    p = prettyGuard stmts
+
 measureDecl :: Decl NodeInfo -> Printer (Maybe [Int])
 measureDecl (PatBind _ pat _ Nothing) = measure' (pretty pat)
 measureDecl (FunBind _ matches) =
@@ -524,7 +532,9 @@
     _ -> False
 
 skipBlankDecl :: Decl NodeInfo -> Decl NodeInfo -> Bool
-skipBlankDecl a _ = skipBlankAfterDecl a
+skipBlankDecl a b = case (a, b) of
+    (PatBind{}, PatBind{}) -> True
+    _ -> skipBlankAfterDecl a
 
 skipBlankClassDecl :: ClassDecl NodeInfo -> ClassDecl NodeInfo -> Bool
 skipBlankClassDecl a _ = case a of
@@ -712,6 +722,16 @@
     write "where"
     withIndent cfgIndentWhereBinds $ pretty binds
 
+prettyGuard :: [Stmt NodeInfo] -> Printer ()
+prettyGuard stmts = do
+    operatorSectionR Pattern "|" $ write "|"
+    withLayout cfgLayoutDeclaration flex vertical
+  where
+    flex = listAutoWrap' pat sep stmts
+    vertical = list' pat sep stmts
+    pat = Pattern
+    sep = ","
+
 instance Pretty Module where
     prettyPrint (Module _ mhead pragmas imports decls) = inter blankline $
         catMaybes [ ifNotEmpty prettyPragmas pragmas
@@ -1294,20 +1314,14 @@
         withIndent cfgIndentMultiIf $ linedOnside guardedrhss
 
 instance Pretty GuardedRhs where
-    prettyPrint (GuardedRhs _ stmts expr) =
-        withLayout cfgLayoutDeclaration flex vertical
+    prettyPrint (GuardedRhs _ stmts expr) = do
+        prettyGuard stmts
+        atTabStop stopRhs
+        withLayout cfgLayoutDeclaration (operator d op) (operatorV d op)
+        pretty expr
       where
-        flex = do
-            operatorSectionR Pattern "|" $ write "|"
-            listAutoWrap' Pattern "," stmts
-            operator Declaration "="
-            pretty expr
-
-        vertical = do
-            operatorSectionR Pattern "|" $ write "|"
-            list' Pattern "," stmts
-            operatorV Declaration "="
-            pretty expr
+        d = Declaration
+        op = "="
 
 instance Pretty Context where
     prettyPrint (CxSingle _ asst) = do

src/Floskell/Printers.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module Floskell.Printers
@@ -65,7 +66,9 @@ import           Control.Monad.State.Strict ( get, gets, modify )
 
 import           Data.List                  ( intersperse )
 import qualified Data.Map.Strict            as Map
+#if __GLASGOW_HASKELL__ <= 802
 import           Data.Monoid                ( (<>) )
+#endif
 import           Data.Text                  ( Text )
 import qualified Data.Text                  as T