Merge tag 'v0.12.2.0'

v0.12.2.0

- 0.12.2.0 (2020-10-08)
     *  align: Add a new option for aligning only adjacent items (by 1Computer1)
     *  align: Add support for aligning MultiWayIf syntax (by 1Computer1)
     *  data: Fix some issues with record field padding
     *  module_header: Add separate_lists option
     *  imports: Respect separate_lists for (..) imports
     *  data: Make sorting deriving list optional (by Maxim Koltsov)

1 files changed, 36 insertions, 35 deletions

diff --git a/lib/Language/Haskell/Stylish/Step/Squash.hs b/lib/Language/Haskell/Stylish/Step/Squash.hs
index 0eb4895..23d1e9f 100644
--- a/lib/Language/Haskell/Stylish/Step/Squash.hs
+++ b/lib/Language/Haskell/Stylish/Step/Squash.hs
@@ -1,4 +1,7 @@
 --------------------------------------------------------------------------------
+{-# LANGUAGE PartialTypeSignatures #-}
+{-# LANGUAGE PatternGuards         #-}
+{-# LANGUAGE TypeFamilies          #-}
 module Language.Haskell.Stylish.Step.Squash
     ( step
     ) where
@@ -6,7 +9,8 @@ module Language.Haskell.Stylish.Step.Squash
 
 --------------------------------------------------------------------------------
 import           Data.Maybe                      (mapMaybe)
-import qualified Language.Haskell.Exts           as H
+import qualified GHC.Hs                          as Hs
+import qualified SrcLoc                          as S
 
 
 --------------------------------------------------------------------------------
@@ -17,46 +21,43 @@ import           Language.Haskell.Stylish.Util
 
 --------------------------------------------------------------------------------
 squash
-    :: (H.Annotated l, H.Annotated r)
-    => l H.SrcSpan -> r H.SrcSpan -> Maybe (Change String)
-squash left right
-  | H.srcSpanEndLine lAnn == H.srcSpanStartLine rAnn = Just $
-        changeLine (H.srcSpanEndLine lAnn) $ \str ->
-        let (pre, post) = splitAt (H.srcSpanEndColumn lAnn) str
-        in  [trimRight pre ++ " " ++ trimLeft post]
-  | otherwise = Nothing
-  where
-    lAnn = H.ann left
-    rAnn = H.ann right
-
-
---------------------------------------------------------------------------------
-squashFieldDecl :: H.FieldDecl H.SrcSpan -> Maybe (Change String)
-squashFieldDecl (H.FieldDecl _ names type')
+    :: (S.HasSrcSpan l, S.HasSrcSpan r)
+    => l -> r -> Maybe (Change String)
+squash left right = do
+  lAnn <- toRealSrcSpan $ S.getLoc left
+  rAnn <- toRealSrcSpan $ S.getLoc right
+  if S.srcSpanEndLine lAnn == S.srcSpanStartLine rAnn ||
+      S.srcSpanEndLine lAnn + 1 == S.srcSpanStartLine rAnn
+    then Just $
+          changeLine (S.srcSpanEndLine lAnn) $ \str ->
+          let (pre, post) = splitAt (S.srcSpanEndCol lAnn) str
+          in [trimRight pre ++ " " ++ trimLeft post]
+    else Nothing
+
+
+--------------------------------------------------------------------------------
+squashFieldDecl :: Hs.ConDeclField Hs.GhcPs -> Maybe (Change String)
+squashFieldDecl (Hs.ConDeclField _ names type' _)
   | null names = Nothing
   | otherwise  = squash (last names) type'
+squashFieldDecl (Hs.XConDeclField x) = Hs.noExtCon x
 
 
 --------------------------------------------------------------------------------
-squashMatch :: H.Match H.SrcSpan -> Maybe (Change String)
-squashMatch (H.InfixMatch _ _ _ _ _ _) = Nothing
-squashMatch (H.Match _ name pats rhs _)
-  | null pats = squash name        rhs
-  | otherwise = squash (last pats) rhs
-
-
---------------------------------------------------------------------------------
-squashAlt :: H.Alt H.SrcSpan -> Maybe (Change String)
-squashAlt (H.Alt _ pat rhs _) = squash pat rhs
+squashMatch :: Hs.Match Hs.GhcPs (Hs.LHsExpr Hs.GhcPs) -> Maybe (Change String)
+squashMatch (Hs.Match _ (Hs.FunRhs name _ _) [] grhss) = do
+    body <- unguardedRhsBody grhss
+    squash name body
+squashMatch (Hs.Match _ _ pats grhss) = do
+    body <- unguardedRhsBody grhss
+    squash (last pats) body
+squashMatch (Hs.XMatch x) = Hs.noExtCon x
 
 
 --------------------------------------------------------------------------------
 step :: Step
-step = makeStep "Squash" $ \ls (module', _) ->
-    let module'' = fmap H.srcInfoSpan module'
-        changes  = concat
-            [ mapMaybe squashAlt       (everything module'')
-            , mapMaybe squashMatch     (everything module'')
-            , mapMaybe squashFieldDecl (everything module'')
-            ]
-    in applyChanges changes ls
+step = makeStep "Squash" $ \ls (module') ->
+    let changes =
+            mapMaybe squashFieldDecl (everything module') ++
+            mapMaybe squashMatch (everything module') in
+    applyChanges changes ls