Fix some issues with record field padding

See #318 and #319

Author: jaspervdj

lib/Language/Haskell/Stylish/Printer.hs

@@ -44,6 +44,7 @@ module Language.Haskell.Stylish.Printer
   , space
   , spaces
   , suffix
+  , pad
 
     -- ** Advanced combinators
   , withColumns
@@ -323,6 +324,13 @@ prefix pa pb = pa >> pb
 suffix :: P a -> P b -> P a
 suffix pa pb = pb >> pa
 
+-- | Indent to a given number of spaces.  If the current line already exceeds
+-- that number in length, nothing happens.
+pad :: Int -> P ()
+pad n = do
+    len <- length <$> getCurrentLine
+    spaces $ n - len
+
 -- | Gets comment on supplied 'line' and removes it from the state
 removeLineComment :: Int -> P (Maybe AnnotationComment)
 removeLineComment line =

lib/Language/Haskell/Stylish/Step/Data.hs

@@ -1,10 +1,12 @@
-{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE BlockArguments  #-}
 {-# LANGUAGE DoAndIfThenElse #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE LambdaCase      #-}
+{-# LANGUAGE NamedFieldPuns  #-}
 {-# LANGUAGE RecordWildCards #-}
 module Language.Haskell.Stylish.Step.Data
   ( Config(..)
+  , defaultConfig
+
   , Indent(..)
   , MaxColumns(..)
   , step
@@ -22,19 +24,24 @@ import           Data.Maybe                       (listToMaybe)
 
 --------------------------------------------------------------------------------
 import           ApiAnnotation                    (AnnotationComment)
-import           BasicTypes                       (LexicalFixity(..))
-import           GHC.Hs.Decls                     (HsDecl(..), HsDataDefn(..))
-import           GHC.Hs.Decls                     (TyClDecl(..), NewOrData(..))
-import           GHC.Hs.Decls                     (HsDerivingClause(..), DerivStrategy(..))
-import           GHC.Hs.Decls                     (ConDecl(..))
-import           GHC.Hs.Extension                 (GhcPs, NoExtField(..), noExtCon)
-import           GHC.Hs.Types                     (ConDeclField(..), HsContext)
-import           GHC.Hs.Types                     (HsType(..), ForallVisFlag(..))
-import           GHC.Hs.Types                     (LHsQTyVars(..), HsTyVarBndr(..))
-import           GHC.Hs.Types                     (HsConDetails(..), HsImplicitBndrs(..))
+import           BasicTypes                       (LexicalFixity (..))
+import           GHC.Hs.Decls                     (ConDecl (..),
+                                                   DerivStrategy (..),
+                                                   HsDataDefn (..), HsDecl (..),
+                                                   HsDerivingClause (..),
+                                                   NewOrData (..),
+                                                   TyClDecl (..))
+import           GHC.Hs.Extension                 (GhcPs, NoExtField (..),
+                                                   noExtCon)
+import           GHC.Hs.Types                     (ConDeclField (..),
+                                                   ForallVisFlag (..),
+                                                   HsConDetails (..), HsContext,
+                                                   HsImplicitBndrs (..),
+                                                   HsTyVarBndr (..),
+                                                   HsType (..), LHsQTyVars (..))
 import           RdrName                          (RdrName)
-import           SrcLoc                           (Located, RealLocated)
-import           SrcLoc                           (GenLocated(..))
+import           SrcLoc                           (GenLocated (..), Located,
+                                                   RealLocated)
 
 --------------------------------------------------------------------------------
 import           Language.Haskell.Stylish.Block
@@ -76,6 +83,21 @@ data Config = Config
     , cMaxColumns              :: !MaxColumns
     } deriving (Show)
 
+-- | TODO: pass in MaxColumns?
+defaultConfig :: Config
+defaultConfig = Config
+    { cEquals          = Indent 4
+    , cFirstField      = Indent 4
+    , cFieldComment    = 2
+    , cDeriving        = 4
+    , cBreakEnums      = True
+    , cBreakSingleConstructors = False
+    , cVia             = Indent 4
+    , cSortDeriving    = True
+    , cMaxColumns      = NoMaxColumns
+    , cCurriedContext    = False
+    }
+
 step :: Config -> Step
 step cfg = makeStep "Data" \ls m -> applyChanges (changes m) ls
   where
@@ -190,19 +212,19 @@ formatDataDecl cfg@Config{..} m ldecl@(L declPos decl) =
 data DataDecl = MkDataDecl
   { dataDeclName :: Located RdrName
   , dataTypeVars :: LHsQTyVars GhcPs
-  , dataDefn :: HsDataDefn GhcPs
-  , dataFixity :: LexicalFixity
+  , dataDefn     :: HsDataDefn GhcPs
+  , dataFixity   :: LexicalFixity
   }
 
 putDeriving :: Config -> Located (HsDerivingClause GhcPs) -> P ()
 putDeriving Config{..} (L pos clause) = do
   putText "deriving"
 
   forM_ (deriv_clause_strategy clause) \case
-    L _ StockStrategy -> space >> putText "stock"
+    L _ StockStrategy    -> space >> putText "stock"
     L _ AnyclassStrategy -> space >> putText "anyclass"
-    L _ NewtypeStrategy -> space >> putText "newtype"
-    L _ (ViaStrategy _) -> pure ()
+    L _ NewtypeStrategy  -> space >> putText "newtype"
+    L _ (ViaStrategy _)  -> pure ()
 
   putCond
     withinColumns
@@ -224,13 +246,13 @@ putDeriving Config{..} (L pos clause) = do
 
   where
     getType = \case
-      HsIB _ tp -> tp
+      HsIB _ tp          -> tp
       XHsImplicitBndrs x -> noExtCon x
 
     withinColumns PrinterState{currentLine} =
       case cMaxColumns of
         MaxColumns maxCols -> length currentLine <= maxCols
-        NoMaxColumns -> True
+        NoMaxColumns       -> True
 
     oneLinePrint = do
       space
@@ -361,8 +383,10 @@ putConstructor cfg consIndent (L _ cons) = case cons of
         sep space (fmap putOutputable xs)
       RecCon (L recPos (L posFirst firstArg : args)) -> do
         putRdrName con_name
-        skipToBrace >> putText "{"
+        skipToBrace
         bracePos <- getCurrentLineLength
+        putText "{"
+        let fieldPos = bracePos + 2
         space
 
         -- Unless everything's configured to be on the same line, put pending
@@ -371,7 +395,7 @@ putConstructor cfg consIndent (L _ cons) = case cons of
           removeCommentTo posFirst >>= mapM_ \c -> putComment c >> sepDecl bracePos
 
         -- Put first decl field
-        putConDeclField cfg firstArg
+        pad fieldPos >> putConDeclField cfg firstArg
         unless (cFirstField cfg == SameLine) (putEolComment posFirst)
 
         -- Put tail decl fields
@@ -395,19 +419,21 @@ putConstructor cfg consIndent (L _ cons) = case cons of
         skipToBrace >> putText "}"
 
     where
+      -- Jump to the first brace of the first record of the first constructor.
       skipToBrace = case (cEquals cfg, cFirstField cfg) of
         (_, Indent y) | not (cBreakSingleConstructors cfg) -> newline >> spaces y
         (SameLine, SameLine) -> space
         (Indent x, Indent y) -> newline >> spaces (x + y + 2)
         (SameLine, Indent y) -> newline >> spaces (consIndent + y)
         (Indent _, SameLine) -> space
 
+      -- Jump to the next declaration.
       sepDecl bracePos = newline >> spaces case (cEquals cfg, cFirstField cfg) of
         (_, Indent y) | not (cBreakSingleConstructors cfg) -> y
-        (SameLine, SameLine) -> bracePos - 1 -- back one from brace pos to place comma
+        (SameLine, SameLine) -> bracePos
         (Indent x, Indent y) -> x + y + 2
-        (SameLine, Indent y) -> bracePos - 1 + y - 2
-        (Indent x, SameLine) -> bracePos - 1 + x - 2
+        (SameLine, Indent y) -> bracePos + y - 2
+        (Indent x, SameLine) -> bracePos + x - 2
 
 putNewtypeConstructor :: Config -> Located (ConDecl GhcPs) -> P ()
 putNewtypeConstructor cfg (L _ cons) = case cons of
@@ -493,7 +519,7 @@ isGADT = any isGADTCons . dd_cons . dataDefn
   where
     isGADTCons = \case
       L _ (ConDeclGADT {}) -> True
-      _ -> False
+      _                    -> False
 
 isNewtype :: DataDecl -> Bool
 isNewtype = (== NewType) . dd_ND . dataDefn
@@ -507,7 +533,7 @@ isEnum = all isUnary . dd_cons . dataDefn
     isUnary = \case
       L _ (ConDeclH98 {..}) -> case con_args of
         PrefixCon [] -> True
-        _ -> False
+        _            -> False
       _ -> False
 
 hasConstructors :: DataDecl -> Bool

lib/Language/Haskell/Stylish/Step/ModuleHeader.hs

@@ -182,9 +182,7 @@ printExportList conf (L srcLoc exports) = do
     -- > xxxxyyfoo
     -- > xxxx) where
     doIndent = spaces (indent conf)
-    doHang = do
-        len <- length <$> getCurrentLine
-        spaces $ indent conf + 2 - len
+    doHang = pad (indent conf + 2)
 
     doSort = if sort conf then NonEmpty.sortBy compareLIE else id