Record alignment takes max columns into account

5 files changed, 91 insertions, 11 deletions

diff --git a/lib/Language/Haskell/Stylish.hs b/lib/Language/Haskell/Stylish.hs
index 103306c..cfc7807 100644
--- a/lib/Language/Haskell/Stylish.hs
+++ b/lib/Language/Haskell/Stylish.hs
@@ -59,7 +59,8 @@ languagePragmas = LanguagePragmas.step
 
 
 --------------------------------------------------------------------------------
-records :: Step
+records :: Int   -- ^ columns
+        -> Step
 records = Records.step
 
 
diff --git a/lib/Language/Haskell/Stylish/Config.hs b/lib/Language/Haskell/Stylish/Config.hs
index fee7594..2f72958 100644
--- a/lib/Language/Haskell/Stylish/Config.hs
+++ b/lib/Language/Haskell/Stylish/Config.hs
@@ -205,7 +205,7 @@ parseLanguagePragmas config o = LanguagePragmas.step
 
 --------------------------------------------------------------------------------
 parseRecords :: Config -> A.Object -> A.Parser Step
-parseRecords _ _ = return Records.step
+parseRecords c _ = return (Records.step $ configColumns c)
 
 
 --------------------------------------------------------------------------------
diff --git a/lib/Language/Haskell/Stylish/Step/Records.hs b/lib/Language/Haskell/Stylish/Step/Records.hs
index c8f6d19..1c46024 100644
--- a/lib/Language/Haskell/Stylish/Step/Records.hs
+++ b/lib/Language/Haskell/Stylish/Step/Records.hs
@@ -31,6 +31,10 @@ data Alignable a = Alignable
     { aContainer :: !a
     , aLeft      :: !a
     , aRight     :: !a
+    -- | This is the minimal number of columns we need for the leading part not
+    -- included in our right string.  For example, for datatype alignment, this
+    -- leading part is the string ":: " so we use 3.
+    , aRightLead :: !Int
     } deriving (Show)
 
 
@@ -40,20 +44,38 @@ fieldDeclToAlignable (H.FieldDecl ann names ty) = Alignable
     { aContainer = ann
     , aLeft      = H.ann (last names)
     , aRight     = H.ann ty
+    , aRightLead = length ":: "
     }
 
 
 --------------------------------------------------------------------------------
 -- | Align the type of a field
-align :: [Alignable H.SrcSpan] -> [Change String]
-align alignment = map align' alignment
+align :: Int -> [Alignable H.SrcSpan] -> [Change String]
+align maxColumns alignment
+    -- Do not make any change if we would go past the maximum number of columns.
+    | longestLeft + longestRight > maxColumns = info []
+    | otherwise                               = info $ map align' alignment
   where
-    longest = maximum $ map (H.srcSpanEndColumn . aLeft) alignment
+    info =
+        id
+        -- trace ("Alignable: " ++ show alignment) .
+        -- trace ("longestLeft: " ++ show longestLeft) .
+        -- trace ("longestRight: " ++ show longestRight)
+
+    -- The longest thing in the left column.
+    longestLeft = maximum $ map (H.srcSpanEndColumn . aLeft) alignment
+
+    -- The longest thing in the right column.
+    longestRight = maximum
+        [ H.srcSpanEndColumn (aRight a) - H.srcSpanStartColumn (aRight a)
+            + aRightLead a
+        | a <- alignment
+        ]
 
     align' a = changeLine (H.srcSpanStartLine $ aContainer a) $ \str ->
         let column      = H.srcSpanEndColumn $ aLeft a
             (pre, post) = splitAt column str
-        in [padRight longest (trimRight pre) ++ trimLeft post]
+        in [padRight longestLeft (trimRight pre) ++ trimLeft post]
 
     trimLeft  = dropWhile isSpace
     trimRight = reverse . trimLeft . reverse
@@ -72,8 +94,8 @@ fixable fields = all singleLine containers && nonOverlapping containers
 
 
 --------------------------------------------------------------------------------
-step :: Step
-step = makeStep "Records" $ \ls (module', _) ->
+step :: Int -> Step
+step maxColumns = makeStep "Records" $ \ls (module', _) ->
     let module''       = fmap H.srcInfoSpan module'
         fixableRecords = filter fixable $ records module''
-    in applyChanges (fixableRecords >>= align) ls
+    in applyChanges (fixableRecords >>= align maxColumns) ls
diff --git a/stylish-haskell.cabal b/stylish-haskell.cabal
index 2fed0d1..4b9b2b0 100644
--- a/stylish-haskell.cabal
+++ b/stylish-haskell.cabal
@@ -85,14 +85,27 @@ Test-suite stylish-haskell-tests
   Type:           exitcode-stdio-1.0
 
   Other-modules:
+    Language.Haskell.Stylish.Block
+    Language.Haskell.Stylish.Config
+    Language.Haskell.Stylish.Editor
+    Language.Haskell.Stylish.Parse
     Language.Haskell.Stylish.Parse.Tests
+    Language.Haskell.Stylish.Step
+    Language.Haskell.Stylish.Step.Imports
     Language.Haskell.Stylish.Step.Imports.Tests
+    Language.Haskell.Stylish.Step.LanguagePragmas
     Language.Haskell.Stylish.Step.LanguagePragmas.Tests
+    Language.Haskell.Stylish.Step.Records
     Language.Haskell.Stylish.Step.Records.Tests
+    Language.Haskell.Stylish.Step.Tabs
     Language.Haskell.Stylish.Step.Tabs.Tests
+    Language.Haskell.Stylish.Step.TrailingWhitespace
     Language.Haskell.Stylish.Step.TrailingWhitespace.Tests
+    Language.Haskell.Stylish.Step.UnicodeSyntax
     Language.Haskell.Stylish.Step.UnicodeSyntax.Tests
     Language.Haskell.Stylish.Tests.Util
+    Language.Haskell.Stylish.Util
+    Language.Haskell.Stylish.Verbose
 
   Build-depends:
     HUnit                >= 1.2 && < 1.4,
diff --git a/tests/Language/Haskell/Stylish/Step/Records/Tests.hs b/tests/Language/Haskell/Stylish/Step/Records/Tests.hs
index 312c6fa..5b24c2f 100644
--- a/tests/Language/Haskell/Stylish/Step/Records/Tests.hs
+++ b/tests/Language/Haskell/Stylish/Step/Records/Tests.hs
@@ -20,12 +20,14 @@ tests :: Test
 tests = testGroup "Language.Haskell.Stylish.Step.Records.Tests"
     [ testCase "case 01" case01
     , testCase "case 02" case02
+    , testCase "case 03" case03
+    , testCase "case 04" case04
     ]
 
 
 --------------------------------------------------------------------------------
 case01 :: Assertion
-case01 = expected @=? testStep step input
+case01 = expected @=? testStep (step 80) input
   where
     input = unlines
         [ "data Foo = Foo"
@@ -44,7 +46,7 @@ case01 = expected @=? testStep step input
 
 --------------------------------------------------------------------------------
 case02 :: Assertion
-case02 = input @=? testStep step input
+case02 = input @=? testStep (step 80) input
   where
     -- Don't attempt to align this since a field spans multiple lines
     input = unlines
@@ -54,3 +56,45 @@ case02 = input @=? testStep step input
         , "         :: String"
         , "    } deriving (Show)"
         ]
+
+
+--------------------------------------------------------------------------------
+case03 :: Assertion
+case03 =
+    -- 22 max columns is /just/ enough to align this stuff.
+    expected @=? testStep (step 22) input
+  where
+    input = unlines
+        [ "data Foo = Foo"
+        , "    { foo :: String"
+        , "    , barqux :: Int"
+        , "    }"
+        ]
+
+    expected = unlines
+        [ "data Foo = Foo"
+        , "    { foo    :: String"
+        , "    , barqux :: Int"
+        , "    }"
+        ]
+
+
+--------------------------------------------------------------------------------
+case04 :: Assertion
+case04 =
+    -- 21 max columns is /just NOT/ enough to align this stuff.
+    expected @=? testStep (step 21) input
+  where
+    input = unlines
+        [ "data Foo = Foo"
+        , "    { foo :: String"
+        , "    , barqux :: Int"
+        , "    }"
+        ]
+
+    expected = unlines
+        [ "data Foo = Foo"
+        , "    { foo :: String"
+        , "    , barqux :: Int"
+        , "    }"
+        ]