summaryrefslogtreecommitdiffhomepage
path: root/lib
diff options
context:
space:
mode:
authorChris Martin <ch.martin@gmail.com>2020-01-18 08:49:58 -0700
committerJasper Van der Jeugt <m@jaspervdj.be>2020-01-18 10:49:57 -0500
commit1a869950eba47e30ebe84e118f404ef9a62e9cc6 (patch)
tree7a4e6fa41732da77ffb1d7c47f4b6381d8c6393c /lib
parentba5456a9f2c16524ea93c0b038dafc1af8aaaf0e (diff)
downloadstylish-haskell-1a869950eba47e30ebe84e118f404ef9a62e9cc6.tar.gz
Allow setting "columns: null" to disable all wrapping
Diffstat (limited to 'lib')
-rw-r--r--lib/Language/Haskell/Stylish.hs6
-rw-r--r--lib/Language/Haskell/Stylish/Align.hs13
-rw-r--r--lib/Language/Haskell/Stylish/Config.hs6
-rw-r--r--lib/Language/Haskell/Stylish/Step/Imports.hs27
-rw-r--r--lib/Language/Haskell/Stylish/Step/LanguagePragmas.hs16
-rw-r--r--lib/Language/Haskell/Stylish/Step/SimpleAlign.hs2
-rw-r--r--lib/Language/Haskell/Stylish/Util.hs46
7 files changed, 86 insertions, 30 deletions
diff --git a/lib/Language/Haskell/Stylish.hs b/lib/Language/Haskell/Stylish.hs
index 7d7fb98..a40a7d2 100644
--- a/lib/Language/Haskell/Stylish.hs
+++ b/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?
diff --git a/lib/Language/Haskell/Stylish/Align.hs b/lib/Language/Haskell/Stylish/Align.hs
index 53549b9..1f28d7a 100644
--- a/lib/Language/Haskell/Stylish/Align.hs
+++ b/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
diff --git a/lib/Language/Haskell/Stylish/Config.hs b/lib/Language/Haskell/Stylish/Config.hs
index e4adaf5..725a465 100644
--- a/lib/Language/Haskell/Stylish/Config.hs
+++ b/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
diff --git a/lib/Language/Haskell/Stylish/Step/Imports.hs b/lib/Language/Haskell/Stylish/Step/Imports.hs
index 4ceb802..7cb78d4 100644
--- a/lib/Language/Haskell/Stylish/Step/Imports.hs
+++ b/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,14 +292,14 @@ 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) ++)
@@ -307,7 +307,7 @@ prettyImport columns Options{..} padQualified padName longest imp
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
diff --git a/lib/Language/Haskell/Stylish/Step/LanguagePragmas.hs b/lib/Language/Haskell/Stylish/Step/LanguagePragmas.hs
index 34d05dc..c9d461f 100644
--- a/lib/Language/Haskell/Stylish/Step/LanguagePragmas.hs
+++ b/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
diff --git a/lib/Language/Haskell/Stylish/Step/SimpleAlign.hs b/lib/Language/Haskell/Stylish/Step/SimpleAlign.hs
index 924d6c5..5e61123 100644
--- a/lib/Language/Haskell/Stylish/Step/SimpleAlign.hs
+++ b/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 =
diff --git a/lib/Language/Haskell/Stylish/Util.hs b/lib/Language/Haskell/Stylish/Util.hs
index c634043..9883f4b 100644
--- a/lib/Language/Haskell/Stylish/Util.hs
+++ b/lib/Language/Haskell/Stylish/Util.hs
@@ -10,6 +10,8 @@ module Language.Haskell.Stylish.Util
, trimRight
, wrap
, wrapRest
+ , wrapMaybe
+ , wrapRestMaybe
, withHead
, withInit
@@ -99,6 +101,27 @@ wrap maxWidth leading ind = wrap' leading
--------------------------------------------------------------------------------
+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
-> [String]
@@ -117,6 +140,29 @@ wrapRest maxWidth ind = reverse . wrapRest' [] ""
--------------------------------------------------------------------------------
+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 _ [] = []
withHead f (x : xs) = f x : xs