diff options
author | Chris Martin <ch.martin@gmail.com> | 2020-01-18 08:49:58 -0700 |
---|---|---|
committer | Jasper Van der Jeugt <m@jaspervdj.be> | 2020-01-18 10:49:57 -0500 |
commit | 1a869950eba47e30ebe84e118f404ef9a62e9cc6 (patch) | |
tree | 7a4e6fa41732da77ffb1d7c47f4b6381d8c6393c /lib | |
parent | ba5456a9f2c16524ea93c0b038dafc1af8aaaf0e (diff) | |
download | stylish-haskell-1a869950eba47e30ebe84e118f404ef9a62e9cc6.tar.gz |
Allow setting "columns: null" to disable all wrapping
Diffstat (limited to 'lib')
-rw-r--r-- | lib/Language/Haskell/Stylish.hs | 6 | ||||
-rw-r--r-- | lib/Language/Haskell/Stylish/Align.hs | 13 | ||||
-rw-r--r-- | lib/Language/Haskell/Stylish/Config.hs | 6 | ||||
-rw-r--r-- | lib/Language/Haskell/Stylish/Step/Imports.hs | 27 | ||||
-rw-r--r-- | lib/Language/Haskell/Stylish/Step/LanguagePragmas.hs | 16 | ||||
-rw-r--r-- | lib/Language/Haskell/Stylish/Step/SimpleAlign.hs | 2 | ||||
-rw-r--r-- | lib/Language/Haskell/Stylish/Util.hs | 46 |
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 |