Allow setting "columns: null" to disable all wrapping

Author: chris-martin

data/stylish-haskell.yaml

@@ -223,7 +223,11 @@ steps:
   # - squash: {}
 
 # A common setting is the number of columns (parts of) code will be wrapped
-# to. Different steps take this into account. Default: 80.
+# to. Different steps take this into account.
+#
+# Set this to null to disable all line wrapping.
+#
+# Default: 80.
 columns: 80
 
 # By default, line endings are converted according to the OS. You can override

lib/Language/Haskell/Stylish.hs

@@ -40,21 +40,21 @@ import           Paths_stylish_haskell                            (version)
 
 
 --------------------------------------------------------------------------------
-simpleAlign :: Int  -- ^ Columns
+simpleAlign :: Maybe Int  -- ^ Columns
             -> SimpleAlign.Config
             -> Step
 simpleAlign = SimpleAlign.step
 
 
 --------------------------------------------------------------------------------
-imports :: Int -- ^ columns
+imports :: Maybe Int -- ^ columns
         -> Imports.Options
         -> Step
 imports = Imports.step
 
 
 --------------------------------------------------------------------------------
-languagePragmas :: Int -- ^ columns
+languagePragmas :: Maybe Int -- ^ columns
                 -> LanguagePragmas.Style
                 -> Bool -- ^ Pad to same length in vertical mode?
                 -> Bool -- ^ remove redundant?

lib/Language/Haskell/Stylish/Align.hs

@@ -55,16 +55,21 @@ data Alignable a = Alignable
 --------------------------------------------------------------------------------
 -- | Create changes that perform the alignment.
 align
-    :: Int                    -- ^ Max columns
+    :: Maybe Int              -- ^ Max columns
     -> [Alignable H.SrcSpan]  -- ^ Alignables
     -> [Change String]        -- ^ Changes performing the alignment.
 align _ [] = []
 align maxColumns alignment
     -- Do not make any change if we would go past the maximum number of columns.
-    | longestLeft + longestRight > maxColumns = []
-    | not (fixable alignment)                 = []
-    | otherwise                               = map align' alignment
+    | exceedsColumns (longestLeft + longestRight) = []
+    | not (fixable alignment)                     = []
+    | otherwise                                   = map align' alignment
   where
+    exceedsColumns i = case maxColumns of
+        Nothing -> False  -- No number exceeds a maximum column count of
+                          -- Nothing, because there is no limit to exceed.
+        Just c -> i > c
+
     -- The longest thing in the left column.
     longestLeft = maximum $ map (H.srcSpanEndColumn . aLeft) alignment
 

lib/Language/Haskell/Stylish/Config.hs

@@ -52,7 +52,7 @@ type Extensions = [String]
 --------------------------------------------------------------------------------
 data Config = Config
     { configSteps              :: [Step]
-    , configColumns            :: Int
+    , configColumns            :: Maybe Int
     , configLanguageExtensions :: [String]
     , configNewline            :: IO.Newline
     , configCabal              :: Bool
@@ -119,7 +119,7 @@ parseConfig (A.Object o) = do
     -- First load the config without the actual steps
     config <- Config
         <$> pure []
-        <*> (o A..:? "columns"             A..!= 80)
+        <*> (o A..:! "columns"             A..!= Just 80)
         <*> (o A..:? "language_extensions" A..!= [])
         <*> (o A..:? "newline"             >>= parseEnum newlines IO.nativeNewline)
         <*> (o A..:? "cabal"               A..!= True)
@@ -253,7 +253,7 @@ mkLanguage :: A.Object -> A.Parser String
 mkLanguage o = do
     lang <- o A..:? "language_prefix"
     maybe (pure "LANGUAGE") validate lang
-    where 
+    where
         validate :: String -> A.Parser String
         validate s
             | fmap toLower s == "language" = pure s

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

@@ -258,7 +258,7 @@ prettyImportSpec separate = prettyImportSpec'
 
 --------------------------------------------------------------------------------
 prettyImport :: (Ord l, Show l) =>
-    Int -> Options -> Bool -> Bool -> Int -> H.ImportDecl l -> [String]
+    Maybe Int -> Options -> Bool -> Bool -> Int -> H.ImportDecl l -> [String]
 prettyImport columns Options{..} padQualified padName longest imp
     | (void `fmap` H.importSpecs imp) == emptyImportSpec = emptyWrap
     | otherwise = case longListAlign of
@@ -277,7 +277,7 @@ prettyImport columns Options{..} padQualified padName longest imp
     longListWrapper shortWrap longWrap
         | listAlign == NewLine
         || length shortWrap > 1
-        || length (head shortWrap) > columns
+        || exceedsColumns (length (head shortWrap))
             = longWrap
         | otherwise = shortWrap
 
@@ -292,22 +292,22 @@ prettyImport columns Options{..} padQualified padName longest imp
         . withLast (++ (maybeSpace ++ ")"))
 
     inlineWrapper = case listAlign of
-        NewLine        -> (paddedNoSpecBase :) . wrapRest columns listPadding'
-        WithModuleName -> wrap columns paddedBase (withModuleNameBaseLength + 4)
-        WithAlias      -> wrap columns paddedBase (inlineBaseLength + 1)
+        NewLine        -> (paddedNoSpecBase :) . wrapRestMaybe columns listPadding'
+        WithModuleName -> wrapMaybe columns paddedBase (withModuleNameBaseLength + 4)
+        WithAlias      -> wrapMaybe columns paddedBase (inlineBaseLength + 1)
         -- Add 1 extra space to ensure same padding as in original code.
         AfterAlias     -> withTail ((' ' : maybeSpace) ++)
-            . wrap columns paddedBase (afterAliasBaseLength + 1)
+            . wrapMaybe columns paddedBase (afterAliasBaseLength + 1)
 
-    inlineWithBreakWrap = paddedNoSpecBase : wrapRest columns listPadding'
+    inlineWithBreakWrap = paddedNoSpecBase : wrapRestMaybe columns listPadding'
         ( mapSpecs
         $ withInit (++ ",")
         . withHead (("(" ++ maybeSpace) ++)
         . withLast (++ (maybeSpace ++ ")")))
 
     inlineToMultilineWrap
         | length inlineWithBreakWrap > 2
-        || any ((> columns) . length) (tail inlineWithBreakWrap)
+        || any (exceedsColumns . length) (tail inlineWithBreakWrap)
             = multilineWrap
         | otherwise = inlineWithBreakWrap
 
@@ -389,9 +389,14 @@ prettyImport columns Options{..} padQualified padName longest imp
         True  -> " "
         False -> ""
 
+    exceedsColumns i = case columns of
+        Nothing -> False  -- No number exceeds a maximum column count of
+                          -- Nothing, because there is no limit to exceed.
+        Just c -> i > c
+
 
 --------------------------------------------------------------------------------
-prettyImportGroup :: Int -> Options -> Bool -> Int
+prettyImportGroup :: Maybe Int -> Options -> Bool -> Int
                   -> [H.ImportDecl LineBlock]
                   -> Lines
 prettyImportGroup columns align fileAlign longest imps =
@@ -415,12 +420,12 @@ prettyImportGroup columns align fileAlign longest imps =
 
 
 --------------------------------------------------------------------------------
-step :: Int -> Options -> Step
+step :: Maybe Int -> Options -> Step
 step columns = makeStep "Imports" . step' columns
 
 
 --------------------------------------------------------------------------------
-step' :: Int -> Options -> Lines -> Module -> Lines
+step' :: Maybe Int -> Options -> Lines -> Module -> Lines
 step' columns align ls (module', _) = applyChanges
     [ change block $ const $
         prettyImportGroup columns align fileAlign longest importGroup

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

@@ -53,23 +53,23 @@ verticalPragmas lg longest align pragmas' =
 
 
 --------------------------------------------------------------------------------
-compactPragmas :: String -> Int -> [String] -> Lines
-compactPragmas lg columns pragmas' = wrap columns ("{-# " ++ lg) 13 $
+compactPragmas :: String -> Maybe Int -> [String] -> Lines
+compactPragmas lg columns pragmas' = wrapMaybe columns ("{-# " ++ lg) 13 $
     map (++ ",") (init pragmas') ++ [last pragmas' ++ " #-}"]
 
 
 --------------------------------------------------------------------------------
-compactLinePragmas :: String -> Int -> Bool -> [String] -> Lines
+compactLinePragmas :: String -> Maybe Int -> Bool -> [String] -> Lines
 compactLinePragmas _  _ _ [] = []
 compactLinePragmas lg columns align pragmas' = map (wrapLanguage . pad) prags
   where
     wrapLanguage ps = "{-# " ++ lg ++ ps ++  " #-}"
-    maxWidth = columns - 16
+    maxWidth = fmap (\c -> c - 16) columns
     longest  = maximum $ map length prags
     pad
       | align = padRight longest
       | otherwise = id
-    prags = map truncateComma $ wrap maxWidth "" 1 $
+    prags = map truncateComma $ wrapMaybe maxWidth "" 1 $
       map (++ ",") (init pragmas') ++ [last pragmas']
 
 
@@ -82,7 +82,7 @@ truncateComma xs
 
 
 --------------------------------------------------------------------------------
-prettyPragmas :: String -> Int -> Int -> Bool -> Style -> [String] -> Lines
+prettyPragmas :: String -> Maybe Int -> Int -> Bool -> Style -> [String] -> Lines
 prettyPragmas lp _    longest align Vertical    = verticalPragmas lp longest align
 prettyPragmas lp cols _       _     Compact     = compactPragmas lp cols
 prettyPragmas lp cols _       align CompactLine = compactLinePragmas lp cols align
@@ -105,12 +105,12 @@ filterRedundant isRedundant' = snd . foldr filterRedundant' (S.empty, [])
         known' = xs' `S.union` known
 
 --------------------------------------------------------------------------------
-step :: Int -> Style -> Bool -> Bool -> String -> Step
+step :: Maybe Int -> Style -> Bool -> Bool -> String -> Step
 step = ((((makeStep "LanguagePragmas" .) .) .) .) . step'
 
 
 --------------------------------------------------------------------------------
-step' :: Int -> Style -> Bool -> Bool -> String -> Lines -> Module -> Lines
+step' :: Maybe Int -> Style -> Bool -> Bool -> String -> Lines -> Module -> Lines
 step' columns style align removeRedundant lngPrefix ls (module', _)
     | null pragmas' = ls
     | otherwise     = applyChanges changes ls

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

@@ -108,7 +108,7 @@ fieldDeclToAlignable (H.FieldDecl ann names ty) = Just $ Alignable
 
 
 --------------------------------------------------------------------------------
-step :: Int -> Config -> Step
+step :: Maybe Int -> Config -> Step
 step maxColumns config = makeStep "Cases" $ \ls (module', _) ->
     let module''               = fmap H.srcInfoSpan module'
         changes search toAlign =

lib/Language/Haskell/Stylish/Util.hs

@@ -10,6 +10,8 @@ module Language.Haskell.Stylish.Util
     , trimRight
     , wrap
     , wrapRest
+    , wrapMaybe
+    , wrapRestMaybe
 
     , withHead
     , withInit
@@ -98,6 +100,27 @@ wrap maxWidth leading ind = wrap' leading
         ((length ss + length str) >= maxWidth && ind + length str  <= maxWidth)
 
 
+--------------------------------------------------------------------------------
+wrapMaybe :: Maybe Int -- ^ Maximum line width (maybe)
+          -> String    -- ^ Leading string
+          -> Int       -- ^ Indentation
+          -> [String]  -- ^ Strings to add/wrap
+          -> Lines     -- ^ Resulting lines
+wrapMaybe (Just maxWidth) = wrap maxWidth
+wrapMaybe Nothing         = noWrap
+
+
+--------------------------------------------------------------------------------
+noWrap :: String    -- ^ Leading string
+       -> Int       -- ^ Indentation
+       -> [String]  -- ^ Strings to add
+       -> Lines     -- ^ Resulting lines
+noWrap leading _ind = noWrap' leading
+  where
+    noWrap' ss [] = [ss]
+    noWrap' ss (str:strs) = noWrap' (ss ++ " " ++ str) strs
+
+
 --------------------------------------------------------------------------------
 wrapRest :: Int
          -> Int
@@ -116,6 +139,29 @@ wrapRest maxWidth ind = reverse . wrapRest' [] ""
     overflows ss str = (length ss + length str + 1) >= maxWidth
 
 
+--------------------------------------------------------------------------------
+wrapRestMaybe :: Maybe Int
+              -> Int
+              -> [String]
+              -> Lines
+wrapRestMaybe (Just maxWidth) = wrapRest maxWidth
+wrapRestMaybe Nothing         = noWrapRest
+
+
+--------------------------------------------------------------------------------
+noWrapRest :: Int
+           -> [String]
+           -> Lines
+noWrapRest ind = reverse . noWrapRest' [] ""
+  where
+    noWrapRest' ls ss []
+        | null ss = ls
+        | otherwise = ss:ls
+    noWrapRest' ls ss (str:strs)
+        | null ss = noWrapRest' ls (indent ind str) strs
+        | otherwise = noWrapRest' ls (ss ++ " " ++ str) strs
+
+
 --------------------------------------------------------------------------------
 withHead :: (a -> a) -> [a] -> [a]
 withHead _ []       = []