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 | |
parent | ba5456a9f2c16524ea93c0b038dafc1af8aaaf0e (diff) | |
download | stylish-haskell-1a869950eba47e30ebe84e118f404ef9a62e9cc6.tar.gz |
Allow setting "columns: null" to disable all wrapping
-rw-r--r-- | data/stylish-haskell.yaml | 6 | ||||
-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 | ||||
-rw-r--r-- | tests/Language/Haskell/Stylish/Config/Tests.hs | 89 | ||||
-rw-r--r-- | tests/Language/Haskell/Stylish/Step/Imports/Tests.hs | 89 | ||||
-rw-r--r-- | tests/Language/Haskell/Stylish/Step/LanguagePragmas/Tests.hs | 39 | ||||
-rw-r--r-- | tests/Language/Haskell/Stylish/Step/SimpleAlign/Tests.hs | 37 |
12 files changed, 282 insertions, 94 deletions
diff --git a/data/stylish-haskell.yaml b/data/stylish-haskell.yaml index 5200299..2a17cb5 100644 --- a/data/stylish-haskell.yaml +++ b/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 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 diff --git a/tests/Language/Haskell/Stylish/Config/Tests.hs b/tests/Language/Haskell/Stylish/Config/Tests.hs index f62b571..ebaef54 100644 --- a/tests/Language/Haskell/Stylish/Config/Tests.hs +++ b/tests/Language/Haskell/Stylish/Config/Tests.hs @@ -25,6 +25,12 @@ tests = testGroup "Language.Haskell.Stylish.Config" testExtensionsFromDotStylish , testCase "Extensions extracted correctly from .stylish-haskell.yaml and .cabal files" testExtensionsFromBoth + , testCase "Correctly read .stylish-haskell.yaml file with default max column number" + testDefaultColumns + , testCase "Correctly read .stylish-haskell.yaml file with specified max column number" + testSpecifiedColumns + , testCase "Correctly read .stylish-haskell.yaml file with no max column number" + testNoColumns ] -------------------------------------------------------------------------------- @@ -55,8 +61,8 @@ withTestDirTree action = bracket -- | Put an example config files (.cabal/.stylish-haskell.yaml/both) -- into the current directory and extract extensions from it. -createFilesAndGetExtensions :: [(FilePath, String)] -> IO Extensions -createFilesAndGetExtensions files = withTestDirTree $ do +createFilesAndGetConfig :: [(FilePath, String)] -> IO Config +createFilesAndGetConfig files = withTestDirTree $ do mapM_ (\(k, v) -> writeFile k v) files -- create an empty directory and change into it createDirectory "src" @@ -64,34 +70,58 @@ createFilesAndGetExtensions files = withTestDirTree $ do -- from that directory read the config file and extract extensions -- to make sure the search for .cabal file works config <- loadConfig (const (pure ())) Nothing - pure $ configLanguageExtensions config + pure config -------------------------------------------------------------------------------- testExtensionsFromDotCabal :: Assertion testExtensionsFromDotCabal = - assert $ (expected ==) . Set.fromList <$> - createFilesAndGetExtensions [("test.cabal", dotCabal True)] + assert $ (expected ==) . Set.fromList . configLanguageExtensions <$> + createFilesAndGetConfig [("test.cabal", dotCabal True)] where expected = Set.fromList ["ScopedTypeVariables", "DataKinds"] -------------------------------------------------------------------------------- testExtensionsFromDotStylish :: Assertion testExtensionsFromDotStylish = - assert $ (expected ==) . Set.fromList <$> - createFilesAndGetExtensions [(".stylish-haskell.yaml", dotStylish)] + assert $ (expected ==) . Set.fromList . configLanguageExtensions <$> + createFilesAndGetConfig [(".stylish-haskell.yaml", dotStylish)] where expected = Set.fromList ["TemplateHaskell", "QuasiQuotes"] -------------------------------------------------------------------------------- testExtensionsFromBoth :: Assertion testExtensionsFromBoth = - assert $ (expected ==) . Set.fromList <$> - createFilesAndGetExtensions [ ("test.cabal", dotCabal True) - , (".stylish-haskell.yaml", dotStylish)] + assert $ (expected ==) . Set.fromList . configLanguageExtensions <$> + createFilesAndGetConfig [ ("test.cabal", dotCabal True) + , (".stylish-haskell.yaml", dotStylish)] where expected = Set.fromList ["ScopedTypeVariables", "DataKinds", "TemplateHaskell", "QuasiQuotes"] +-------------------------------------------------------------------------------- +testSpecifiedColumns :: Assertion +testSpecifiedColumns = + assert $ (expected ==) . configColumns <$> + createFilesAndGetConfig [(".stylish-haskell.yaml", dotStylish)] + where + expected = Just 110 + +-------------------------------------------------------------------------------- +testDefaultColumns :: Assertion +testDefaultColumns = + assert $ (expected ==) . configColumns <$> + createFilesAndGetConfig [(".stylish-haskell.yaml", dotStylish2)] + where + expected = Just 80 + +-------------------------------------------------------------------------------- +testNoColumns :: Assertion +testNoColumns = + assert $ (expected ==) . configColumns <$> + createFilesAndGetConfig [(".stylish-haskell.yaml", dotStylish3)] + where + expected = Nothing + -- | Example cabal file borrowed from -- https://www.haskell.org/cabal/users-guide/developing-packages.html -- with some default-extensions added @@ -140,3 +170,42 @@ dotStylish = unlines $ , " - TemplateHaskell" , " - QuasiQuotes" ] + +-- | Example .stylish-haskell.yaml +dotStylish2 :: String +dotStylish2 = unlines $ + [ "steps:" + , " - imports:" + , " align: none" + , " list_align: after_alias" + , " long_list_align: inline" + , " separate_lists: true" + , " - language_pragmas:" + , " style: vertical" + , " align: false" + , " remove_redundant: true" + , " - trailing_whitespace: {}" + , "language_extensions:" + , " - TemplateHaskell" + , " - QuasiQuotes" + ] + +-- | Example .stylish-haskell.yaml +dotStylish3 :: String +dotStylish3 = unlines $ + [ "steps:" + , " - imports:" + , " align: none" + , " list_align: after_alias" + , " long_list_align: inline" + , " separate_lists: true" + , " - language_pragmas:" + , " style: vertical" + , " align: false" + , " remove_redundant: true" + , " - trailing_whitespace: {}" + , "columns: null" + , "language_extensions:" + , " - TemplateHaskell" + , " - QuasiQuotes" + ] diff --git a/tests/Language/Haskell/Stylish/Step/Imports/Tests.hs b/tests/Language/Haskell/Stylish/Step/Imports/Tests.hs index 760018a..22031d4 100644 --- a/tests/Language/Haskell/Stylish/Step/Imports/Tests.hs +++ b/tests/Language/Haskell/Stylish/Step/Imports/Tests.hs @@ -58,6 +58,7 @@ tests = testGroup "Language.Haskell.Stylish.Step.Imports.Tests" , testCase "case 24" case24 , testCase "case 25" case25 , testCase "case 26 (issue 185)" case26 + , testCase "case 27" case27 ] @@ -82,7 +83,7 @@ input = unlines -------------------------------------------------------------------------------- case01 :: Assertion -case01 = expected @=? testStep (step 80 $ fromImportAlign Global) input +case01 = expected @=? testStep (step (Just 80) $ fromImportAlign Global) input where expected = unlines [ "module Herp where" @@ -104,7 +105,7 @@ case01 = expected @=? testStep (step 80 $ fromImportAlign Global) input -------------------------------------------------------------------------------- case02 :: Assertion -case02 = expected @=? testStep (step 80 $ fromImportAlign Group) input +case02 = expected @=? testStep (step (Just 80) $ fromImportAlign Group) input where expected = unlines [ "module Herp where" @@ -125,7 +126,7 @@ case02 = expected @=? testStep (step 80 $ fromImportAlign Group) input -------------------------------------------------------------------------------- case03 :: Assertion -case03 = expected @=? testStep (step 80 $ fromImportAlign None) input +case03 = expected @=? testStep (step (Just 80) $ fromImportAlign None) input where expected = unlines [ "module Herp where" @@ -146,7 +147,7 @@ case03 = expected @=? testStep (step 80 $ fromImportAlign None) input -------------------------------------------------------------------------------- case04 :: Assertion -case04 = expected @=? testStep (step 80 $ fromImportAlign Global) input' +case04 = expected @=? testStep (step (Just 80) $ fromImportAlign Global) input' where input' = "import Data.Aeson.Types (object, typeMismatch, FromJSON(..)," ++ @@ -161,7 +162,7 @@ case04 = expected @=? testStep (step 80 $ fromImportAlign Global) input' -------------------------------------------------------------------------------- case05 :: Assertion -case05 = input' @=? testStep (step 80 $ fromImportAlign Group) input' +case05 = input' @=? testStep (step (Just 80) $ fromImportAlign Group) input' where input' = "import Distribution.PackageDescription.Configuration " ++ "(finalizePackageDescription)\n" @@ -169,7 +170,7 @@ case05 = input' @=? testStep (step 80 $ fromImportAlign Group) input' -------------------------------------------------------------------------------- case06 :: Assertion -case06 = input' @=? testStep (step 80 $ fromImportAlign File) input' +case06 = input' @=? testStep (step (Just 80) $ fromImportAlign File) input' where input' = unlines [ "import Bar.Qux" @@ -179,7 +180,7 @@ case06 = input' @=? testStep (step 80 $ fromImportAlign File) input' -------------------------------------------------------------------------------- case07 :: Assertion -case07 = expected @=? testStep (step 80 $ fromImportAlign File) input' +case07 = expected @=? testStep (step (Just 80) $ fromImportAlign File) input' where input' = unlines [ "import Bar.Qux" @@ -197,7 +198,7 @@ case07 = expected @=? testStep (step 80 $ fromImportAlign File) input' -------------------------------------------------------------------------------- case08 :: Assertion case08 = expected - @=? testStep (step 80 $ Options Global WithAlias True Inline Inherit (LPConstant 4) True False) input + @=? testStep (step (Just 80) $ Options Global WithAlias True Inline Inherit (LPConstant 4) True False) input where expected = unlines [ "module Herp where" @@ -220,7 +221,7 @@ case08 = expected -------------------------------------------------------------------------------- case08b :: Assertion case08b = expected - @=? testStep (step 80 $ Options Global WithModuleName True Inline Inherit (LPConstant 4) True False) input + @=? testStep (step (Just 80) $ Options Global WithModuleName True Inline Inherit (LPConstant 4) True False) input where expected = unlines ["module Herp where" @@ -242,7 +243,7 @@ case08b = expected -------------------------------------------------------------------------------- case09 :: Assertion case09 = expected - @=? testStep (step 80 $ Options Global WithAlias True Multiline Inherit (LPConstant 4) True False) input + @=? testStep (step (Just 80) $ Options Global WithAlias True Multiline Inherit (LPConstant 4) True False) input where expected = unlines [ "module Herp where" @@ -276,7 +277,7 @@ case09 = expected -------------------------------------------------------------------------------- case10 :: Assertion case10 = expected - @=? testStep (step 40 $ Options Group WithAlias True Multiline Inherit (LPConstant 4) True False) input + @=? testStep (step (Just 40) $ Options Group WithAlias True Multiline Inherit (LPConstant 4) True False) input where expected = unlines [ "module Herp where" @@ -315,7 +316,7 @@ case10 = expected -------------------------------------------------------------------------------- case11 :: Assertion case11 = expected - @=? testStep (step 80 $ Options Group NewLine True Inline Inherit (LPConstant 4) True False) input + @=? testStep (step (Just 80) $ Options Group NewLine True Inline Inherit (LPConstant 4) True False) input where expected = unlines [ "module Herp where" @@ -342,7 +343,7 @@ case11 = expected case11b :: Assertion case11b = expected - @=? testStep (step 80 $ Options Group WithModuleName True Inline Inherit (LPConstant 4) True False) input + @=? testStep (step (Just 80) $ Options Group WithModuleName True Inline Inherit (LPConstant 4) True False) input where expected = unlines [ "module Herp where" @@ -364,7 +365,7 @@ case11b = expected -------------------------------------------------------------------------------- case12 :: Assertion case12 = expected - @=? testStep (step 80 $ Options Group NewLine True Inline Inherit (LPConstant 2) True False) input' + @=? testStep (step (Just 80) $ Options Group NewLine True Inline Inherit (LPConstant 2) True False) input' where input' = unlines [ "import Data.List (map)" @@ -379,7 +380,7 @@ case12 = expected -------------------------------------------------------------------------------- case12b :: Assertion case12b = expected - @=? testStep (step 80 $ Options Group WithModuleName True Inline Inherit (LPConstant 2) True False) input' + @=? testStep (step (Just 80) $ Options Group WithModuleName True Inline Inherit (LPConstant 2) True False) input' where input' = unlines [ "import Data.List (map)" @@ -391,7 +392,7 @@ case12b = expected -------------------------------------------------------------------------------- case13 :: Assertion case13 = expected - @=? testStep (step 80 $ Options None WithAlias True InlineWithBreak Inherit (LPConstant 4) True False) input' + @=? testStep (step (Just 80) $ Options None WithAlias True InlineWithBreak Inherit (LPConstant 4) True False) input' where input' = unlines [ "import qualified Data.List as List (concat, foldl, foldr, head, init," @@ -408,7 +409,7 @@ case13 = expected -------------------------------------------------------------------------------- case13b :: Assertion case13b = expected - @=? testStep (step 80 $ Options None WithModuleName True InlineWithBreak Inherit (LPConstant 4) True False) input' + @=? testStep (step (Just 80) $ Options None WithModuleName True InlineWithBreak Inherit (LPConstant 4) True False) input' where input' = unlines [ "import qualified Data.List as List (concat, foldl, foldr, head, init," @@ -426,7 +427,7 @@ case13b = expected case14 :: Assertion case14 = expected @=? testStep - (step 80 $ Options None WithAlias True InlineWithBreak Inherit (LPConstant 10) True False) expected + (step (Just 80) $ Options None WithAlias True InlineWithBreak Inherit (LPConstant 10) True False) expected where expected = unlines [ "import qualified Data.List as List (concat, map, null, reverse, tail, (++))" @@ -436,7 +437,7 @@ case14 = expected -------------------------------------------------------------------------------- case15 :: Assertion case15 = expected - @=? testStep (step 80 $ Options None AfterAlias True Multiline Inherit (LPConstant 4) True False) input' + @=? testStep (step (Just 80) $ Options None AfterAlias True Multiline Inherit (LPConstant 4) True False) input' where expected = unlines [ "import Data.Acid (AcidState)" @@ -462,7 +463,7 @@ case15 = expected -------------------------------------------------------------------------------- case16 :: Assertion case16 = expected - @=? testStep (step 80 $ Options None AfterAlias True Multiline Inherit (LPConstant 4) False False) input' + @=? testStep (step (Just 80) $ Options None AfterAlias True Multiline Inherit (LPConstant 4) False False) input' where expected = unlines [ "import Data.Acid (AcidState)" @@ -486,7 +487,7 @@ case16 = expected -------------------------------------------------------------------------------- case17 :: Assertion case17 = expected - @=? testStep (step 80 $ Options None AfterAlias True Multiline Inherit (LPConstant 4) True False) input' + @=? testStep (step (Just 80) $ Options None AfterAlias True Multiline Inherit (LPConstant 4) True False) input' where expected = unlines [ "import Control.Applicative (Applicative (pure, (<*>)))" @@ -504,7 +505,7 @@ case17 = expected -------------------------------------------------------------------------------- case18 :: Assertion case18 = expected @=? testStep - (step 40 $ Options None AfterAlias True InlineToMultiline Inherit (LPConstant 4) True False) input' + (step (Just 40) $ Options None AfterAlias True InlineToMultiline Inherit (LPConstant 4) True False) input' where expected = unlines ---------------------------------------- @@ -532,7 +533,7 @@ case18 = expected @=? testStep -------------------------------------------------------------------------------- case19 :: Assertion case19 = expected @=? testStep - (step 40 $ Options Global NewLine True InlineWithBreak RightAfter (LPConstant 17) True False) case19input + (step (Just 40) $ Options Global NewLine True InlineWithBreak RightAfter (LPConstant 17) True False) case19input where expected = unlines ---------------------------------------- @@ -548,7 +549,7 @@ case19 = expected @=? testStep case19b :: Assertion case19b = expected @=? testStep - (step 40 $ Options File NewLine True InlineWithBreak RightAfter (LPConstant 17) True False) case19input + (step (Just 40) $ Options File NewLine True InlineWithBreak RightAfter (LPConstant 17) True False) case19input where expected = unlines ---------------------------------------- @@ -564,7 +565,7 @@ case19b = expected @=? testStep case19c :: Assertion case19c = expected @=? testStep - (step 40 $ Options File NewLine True InlineWithBreak RightAfter LPModuleName True False) case19input + (step (Just 40) $ Options File NewLine True InlineWithBreak RightAfter LPModuleName True False) case19input where expected = unlines ---------------------------------------- @@ -580,7 +581,7 @@ case19c = expected @=? testStep case19d :: Assertion case19d = expected @=? testStep - (step 40 $ Options Global NewLine True InlineWithBreak RightAfter LPModuleName True False) case19input + (step (Just 40) $ Options Global NewLine True InlineWithBreak RightAfter LPModuleName True False) case19input where expected = unlines ---------------------------------------- @@ -606,7 +607,7 @@ case19input = unlines -------------------------------------------------------------------------------- case20 :: Assertion case20 = expected - @=? testStep (step 80 defaultOptions) input' + @=? testStep (step (Just 80) defaultOptions) input' where expected = unlines [ "import {-# SOURCE #-} Data.ByteString as BS" @@ -625,7 +626,7 @@ case20 = expected -------------------------------------------------------------------------------- case21 :: Assertion case21 = expected - @=? testStep (step 80 defaultOptions) input' + @=? testStep (step (Just 80) defaultOptions) input' where expected = unlines [ "{-# LANGUAGE ExplicitNamespaces #-}" @@ -656,7 +657,7 @@ case21 = expected -------------------------------------------------------------------------------- case22 :: Assertion case22 = expected - @=? testStep (step 80 defaultOptions) input' + @=? testStep (step (Just 80) defaultOptions) input' where expected = unlines [ "{-# LANGUAGE PackageImports #-}" @@ -683,7 +684,7 @@ case22 = expected -------------------------------------------------------------------------------- case23 :: Assertion case23 = expected - @=? testStep (step 40 $ Options None AfterAlias False Inline Inherit (LPConstant 4) True True) input' + @=? testStep (step (Just 40) $ Options None AfterAlias False Inline Inherit (LPConstant 4) True True) input' where expected = unlines [ "import Data.Acid ( AcidState )" @@ -708,7 +709,7 @@ case23 = expected -------------------------------------------------------------------------------- case23b :: Assertion case23b = expected - @=? testStep (step 40 $ Options None WithModuleName False Inline Inherit (LPConstant 4) True True) input' + @=? testStep (step (Just 40) $ Options None WithModuleName False Inline Inherit (LPConstant 4) True True) input' where expected = unlines [ "import Data.Acid ( AcidState )" @@ -734,7 +735,7 @@ case23b = expected -------------------------------------------------------------------------------- case24 :: Assertion case24 = expected - @=? testStep (step 40 $ Options None AfterAlias False InlineWithBreak Inherit (LPConstant 4) True True) input' + @=? testStep (step (Just 40) $ Options None AfterAlias False InlineWithBreak Inherit (LPConstant 4) True True) input' where expected = unlines [ "import Data.Acid ( AcidState )" @@ -758,7 +759,7 @@ case24 = expected -------------------------------------------------------------------------------- case25 :: Assertion case25 = expected - @=? testStep (step 80 $ Options Group AfterAlias False Multiline Inherit (LPConstant 4) False False) input' + @=? testStep (step (Just 80) $ Options Group AfterAlias False Multiline Inherit (LPConstant 4) False False) input' where expected = unlines [ "import Data.Acid (AcidState)" @@ -783,7 +784,7 @@ case25 = expected -------------------------------------------------------------------------------- case26 :: Assertion case26 = expected - @=? testStep (step 80 options ) input' + @=? testStep (step (Just 80) options ) input' where options = defaultOptions { listAlign = NewLine, longListAlign = Multiline } input' = unlines @@ -792,3 +793,23 @@ case26 = expected expected = unlines [ "import Data.List" ] + + +-------------------------------------------------------------------------------- +case27 :: Assertion +case27 = expected @=? testStep (step Nothing $ fromImportAlign Global) input + where + expected = unlines + [ "module Herp where" + , "" + , "import Control.Monad" + , "import Data.List as List (concat, foldl, foldr, head, init, last, length, map, null, reverse, tail, (++))" + , "import Data.Map (Map, insert, lookup, (!))" + , "import qualified Data.Map as M" + , "import Only.Instances ()" + , "" + , "import Foo (Bar (..))" + , "import Herp.Derp.Internals hiding (foo)" + , "" + , "herp = putStrLn \"import Hello world\"" + ] diff --git a/tests/Language/Haskell/Stylish/Step/LanguagePragmas/Tests.hs b/tests/Language/Haskell/Stylish/Step/LanguagePragmas/Tests.hs index 7afbdfc..0ede803 100644 --- a/tests/Language/Haskell/Stylish/Step/LanguagePragmas/Tests.hs +++ b/tests/Language/Haskell/Stylish/Step/LanguagePragmas/Tests.hs @@ -29,6 +29,7 @@ tests = testGroup "Language.Haskell.Stylish.Step.LanguagePragmas.Tests" , testCase "case 09" case09 , testCase "case 10" case10 , testCase "case 11" case11 + , testCase "case 12" case12 ] lANG :: String @@ -36,7 +37,7 @@ lANG = "LANGUAGE" -------------------------------------------------------------------------------- case01 :: Assertion -case01 = expected @=? testStep (step 80 Vertical True False lANG) input +case01 = expected @=? testStep (step (Just 80) Vertical True False lANG) input where input = unlines [ "{-# LANGUAGE ViewPatterns #-}" @@ -55,7 +56,7 @@ case01 = expected @=? testStep (step 80 Vertical True False lANG) input -------------------------------------------------------------------------------- case02 :: Assertion -case02 = expected @=? testStep (step 80 Vertical True True lANG) input +case02 = expected @=? testStep (step (Just 80) Vertical True True lANG) input where input = unlines [ "{-# LANGUAGE BangPatterns #-}" @@ -71,7 +72,7 @@ case02 = expected @=? testStep (step 80 Vertical True True lANG) input -------------------------------------------------------------------------------- case03 :: Assertion -case03 = expected @=? testStep (step 80 Vertical True True lANG) input +case03 = expected @=? testStep (step (Just 80) Vertical True True lANG) input where input = unlines [ "{-# LANGUAGE BangPatterns #-}" @@ -87,7 +88,7 @@ case03 = expected @=? testStep (step 80 Vertical True True lANG) input -------------------------------------------------------------------------------- case04 :: Assertion -case04 = expected @=? testStep (step 80 Compact True False lANG) input +case04 = expected @=? testStep (step (Just 80) Compact True False lANG) input where input = unlines [ "{-# LANGUAGE TypeOperators, StandaloneDeriving, DeriveDataTypeable," @@ -104,7 +105,7 @@ case04 = expected @=? testStep (step 80 Compact True False lANG) input -------------------------------------------------------------------------------- case05 :: Assertion -case05 = expected @=? testStep (step 80 Vertical True False lANG) input +case05 = expected @=? testStep (step (Just 80) Vertical True False lANG) input where input = unlines [ "{-# LANGUAGE CPP #-}" @@ -125,7 +126,7 @@ case05 = expected @=? testStep (step 80 Vertical True False lANG) input -------------------------------------------------------------------------------- case06 :: Assertion -case06 = expected @=? testStep (step 80 CompactLine True False lANG) input +case06 = expected @=? testStep (step (Just 80) CompactLine True False lANG) input where input = unlines [ "{-# LANGUAGE TypeOperators, StandaloneDeriving, DeriveDataTypeable," @@ -140,7 +141,7 @@ case06 = expected @=? testStep (step 80 CompactLine True False lANG) input -------------------------------------------------------------------------------- case07 :: Assertion -case07 = expected @=? testStep (step 80 Vertical False False lANG) input +case07 = expected @=? testStep (step (Just 80) Vertical False False lANG) input where input = unlines [ "{-# LANGUAGE ViewPatterns #-}" @@ -160,7 +161,7 @@ case07 = expected @=? testStep (step 80 Vertical False False lANG) input -------------------------------------------------------------------------------- case08 :: Assertion -case08 = expected @=? testStep (step 80 CompactLine False False lANG) input +case08 = expected @=? testStep (step (Just 80) CompactLine False False lANG) input where input = unlines [ "{-# LANGUAGE TypeOperators, StandaloneDeriving, DeriveDataTypeable," @@ -176,7 +177,7 @@ case08 = expected @=? testStep (step 80 CompactLine False False lANG) input -------------------------------------------------------------------------------- case09 :: Assertion -case09 = expected @=? testStep (step 80 Compact True False lANG) input +case09 = expected @=? testStep (step (Just 80) Compact True False lANG) input where input = unlines [ "{-# LANGUAGE DefaultSignatures, FlexibleInstances, LambdaCase, " ++ @@ -190,7 +191,7 @@ case09 = expected @=? testStep (step 80 Compact True False lANG) input -------------------------------------------------------------------------------- case10 :: Assertion -case10 = expected @=? testStep (step 80 Compact True False lANG) input +case10 = expected @=? testStep (step (Just 80) Compact True False lANG) input where input = unlines [ "{-# LANGUAGE NondecreasingIndentation, ScopedTypeVariables," @@ -203,7 +204,7 @@ case10 = expected @=? testStep (step 80 Compact True False lANG) input -------------------------------------------------------------------------------- case11 :: Assertion -case11 = expected @=? testStep (step 80 Vertical False False "language") input +case11 = expected @=? testStep (step (Just 80) Vertical False False "language") input where input = unlines [ "{-# LANGUAGE ViewPatterns #-}" @@ -219,3 +220,19 @@ case11 = expected @=? testStep (step 80 Vertical False False "language") input , "{-# language ViewPatterns #-}" , "module Main where" ] + +-------------------------------------------------------------------------------- +case12 :: Assertion +case12 = expected @=? testStep (step Nothing Compact False False "language") input + where + input = unlines + [ "{-# LANGUAGE ViewPatterns, OverloadedStrings #-}" + , "{-# LANGUAGE TemplateHaskell, ViewPatterns #-}" + , "{-# LANGUAGE ScopedTypeVariables, NoImplicitPrelude #-}" + , "module Main where" + ] + + expected = unlines + [ "{-# language NoImplicitPrelude, OverloadedStrings, ScopedTypeVariables, TemplateHaskell, ViewPatterns #-}" + , "module Main where" + ] diff --git a/tests/Language/Haskell/Stylish/Step/SimpleAlign/Tests.hs b/tests/Language/Haskell/Stylish/Step/SimpleAlign/Tests.hs index b8afab4..a2a51fc 100644 --- a/tests/Language/Haskell/Stylish/Step/SimpleAlign/Tests.hs +++ b/tests/Language/Haskell/Stylish/Step/SimpleAlign/Tests.hs @@ -26,12 +26,13 @@ tests = testGroup "Language.Haskell.Stylish.Step.SimpleAlign.Tests" , testCase "case 06" case06 , testCase "case 07" case07 , testCase "case 08" case08 + , testCase "case 09" case09 ] -------------------------------------------------------------------------------- case01 :: Assertion -case01 = expected @=? testStep (step 80 defaultConfig) input +case01 = expected @=? testStep (step (Just 80) defaultConfig) input where input = unlines [ "eitherToMaybe e = case e of" @@ -48,7 +49,7 @@ case01 = expected @=? testStep (step 80 defaultConfig) input -------------------------------------------------------------------------------- case02 :: Assertion -case02 = expected @=? testStep (step 80 defaultConfig) input +case02 = expected @=? testStep (step (Just 80) defaultConfig) input where input = unlines [ "eitherToMaybe (Left _) = Nothing" @@ -63,7 +64,7 @@ case02 = expected @=? testStep (step 80 defaultConfig) input -------------------------------------------------------------------------------- case03 :: Assertion -case03 = expected @=? testStep (step 80 defaultConfig) input +case03 = expected @=? testStep (step (Just 80) defaultConfig) input where input = unlines [ "heady def [] = def" @@ -78,7 +79,7 @@ case03 = expected @=? testStep (step 80 defaultConfig) input -------------------------------------------------------------------------------- case04 :: Assertion -case04 = expected @=? testStep (step 80 defaultConfig) input +case04 = expected @=? testStep (step (Just 80) defaultConfig) input where input = unlines [ "data Foo = Foo" @@ -97,7 +98,7 @@ case04 = expected @=? testStep (step 80 defaultConfig) input -------------------------------------------------------------------------------- case05 :: Assertion -case05 = input @=? testStep (step 80 defaultConfig) input +case05 = input @=? testStep (step (Just 80) defaultConfig) input where -- Don't attempt to align this since a field spans multiple lines input = unlines @@ -113,7 +114,7 @@ case05 = input @=? testStep (step 80 defaultConfig) input case06 :: Assertion case06 = -- 22 max columns is /just/ enough to align this stuff. - expected @=? testStep (step 22 defaultConfig) input + expected @=? testStep (step (Just 22) defaultConfig) input where input = unlines [ "data Foo = Foo" @@ -134,7 +135,7 @@ case06 = case07 :: Assertion case07 = -- 21 max columns is /just NOT/ enough to align this stuff. - expected @=? testStep (step 21 defaultConfig) input + expected @=? testStep (step (Just 21) defaultConfig) input where input = unlines [ "data Foo = Foo" @@ -153,7 +154,7 @@ case07 = -------------------------------------------------------------------------------- case08 :: Assertion -case08 = expected @=? testStep (step 80 defaultConfig) input +case08 = expected @=? testStep (step (Just 80) defaultConfig) input where input = unlines [ "canDrink mbAge = case mbAge of" @@ -166,3 +167,23 @@ case08 = expected @=? testStep (step 80 defaultConfig) input , " Just age | age > 18 -> True" , " _ -> False" ] + + +-------------------------------------------------------------------------------- +case09 :: Assertion +case09 = + expected @=? testStep (step Nothing defaultConfig) input + where + input = unlines + [ "data Foo = Foo" + , " { foo :: String" + , " , barqux :: Int" + , " }" + ] + + expected = unlines + [ "data Foo = Foo" + , " { foo :: String" + , " , barqux :: Int" + , " }" + ] |