diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,5 +1,12 @@ # CHANGELOG +- 0.6.3.0 + * Bump `optparse-applicative` to 0.13.0.0 + * Export Import options & add a default + * Add `list_padding: module_name` option (by Oleg Grenrus) + * Bump `aeson` to 1.0 (by Oleg Grenrus) + * Special setting for empty import lists (by Oleg Grenrus) + - 0.6.2.0 * Bump `haskell-src-exts` to 1.18 diff --git a/data/stylish-haskell.yaml b/data/stylish-haskell.yaml --- a/data/stylish-haskell.yaml +++ b/data/stylish-haskell.yaml @@ -87,8 +87,26 @@ # Default: inline long_list_align: inline + # Align empty list (importing instances) + # + # Empty list align has following options + # + # - inherit: inherit list_align setting + # + # - right_after: () is right after the module name: + # + # > import Vector.Instances () + # + # Default: inherit + empty_list_align: inherit + # List padding determines indentation of import list on lines after import. - # This option affects 'list_align' and 'long_list_align'. + # This option affects 'long_list_align'. + # + # - : constant value + # + # - module_name: align under start of module name. + # Useful for 'file' and 'group' align settings. list_padding: 4 # Separate lists option affects formating of import list for type diff --git a/lib/Language/Haskell/Stylish.hs b/lib/Language/Haskell/Stylish.hs --- a/lib/Language/Haskell/Stylish.hs +++ b/lib/Language/Haskell/Stylish.hs @@ -9,9 +9,6 @@ , tabs , trailingWhitespace , unicodeSyntax - -- ** Data types - , Imports.Align (..) - , LanguagePragmas.Style (..) -- ** Helpers , stepName -- * Config @@ -51,7 +48,7 @@ -------------------------------------------------------------------------------- imports :: Int -- ^ columns - -> Imports.Align + -> Imports.Options -> Step imports = Imports.step diff --git a/lib/Language/Haskell/Stylish/Config.hs b/lib/Language/Haskell/Stylish/Config.hs --- a/lib/Language/Haskell/Stylish/Config.hs +++ b/lib/Language/Haskell/Stylish/Config.hs @@ -181,15 +181,19 @@ parseImports :: Config -> A.Object -> A.Parser Step parseImports config o = Imports.step <$> pure (configColumns config) - <*> (Imports.Align - <$> (o A..:? "align" >>= parseEnum aligns Imports.Global) - <*> (o A..:? "list_align" >>= parseEnum listAligns Imports.AfterAlias) + <*> (Imports.Options + <$> (o A..:? "align" >>= parseEnum aligns (def Imports.importAlign)) + <*> (o A..:? "list_align" >>= parseEnum listAligns (def Imports.listAlign)) <*> (o A..:? "long_list_align" - >>= parseEnum longListAligns Imports.Inline) + >>= parseEnum longListAligns (def Imports.longListAlign)) -- Note that padding has to be at least 1. Default is 4. - <*> (maybe 4 (max 1) <$> o A..:? "list_padding") - <*> o A..:? "separate_lists" A..!= True) + <*> (o A..:? "empty_list_align" + >>= parseEnum emptyListAligns (def Imports.emptyListAlign)) + <*> o A..:? "list_padding" A..!= (def Imports.listPadding) + <*> o A..:? "separate_lists" A..!= (def Imports.separateLists)) where + def f = f Imports.defaultOptions + aligns = [ ("global", Imports.Global) , ("file", Imports.File) @@ -210,6 +214,10 @@ , ("multiline", Imports.Multiline) ] + emptyListAligns = + [ ("inherit", Imports.Inherit) + , ("right_after", Imports.RightAfter) + ] -------------------------------------------------------------------------------- parseLanguagePragmas :: Config -> A.Object -> A.Parser Step diff --git a/lib/Language/Haskell/Stylish/Step/Imports.hs b/lib/Language/Haskell/Stylish/Step/Imports.hs --- a/lib/Language/Haskell/Stylish/Step/Imports.hs +++ b/lib/Language/Haskell/Stylish/Step/Imports.hs @@ -1,21 +1,28 @@ {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE OverloadedStrings #-} -------------------------------------------------------------------------------- module Language.Haskell.Stylish.Step.Imports - ( Align (..) + ( Options (..) + , defaultOptions , ImportAlign (..) , ListAlign (..) , LongListAlign (..) + , EmptyListAlign (..) + , ListPadding (..) , step ) where -------------------------------------------------------------------------------- import Control.Arrow ((&&&)) +import Control.Monad (void) import Data.Char (toLower) import Data.List (intercalate, sortBy) import Data.Maybe (isJust, maybeToList) import Data.Ord (comparing) import qualified Language.Haskell.Exts as H +import qualified Data.Aeson as A +import qualified Data.Aeson.Types as A -------------------------------------------------------------------------------- @@ -25,13 +32,28 @@ import Language.Haskell.Stylish.Util -------------------------------------------------------------------------------- -data Align = Align - { importAlign :: ImportAlign - , listAlign :: ListAlign - , longListAlign :: LongListAlign - , listPadding :: Int - , separateLists :: Bool +data Options = Options + { importAlign :: ImportAlign + , listAlign :: ListAlign + , longListAlign :: LongListAlign + , emptyListAlign :: EmptyListAlign + , listPadding :: ListPadding + , separateLists :: Bool + } deriving (Eq, Show) + +defaultOptions :: Options +defaultOptions = Options + { importAlign = Global + , listAlign = AfterAlias + , longListAlign = Inline + , emptyListAlign = Inherit + , listPadding = LPConstant 4 + , separateLists = True } + +data ListPadding + = LPConstant Int + | LPModuleName deriving (Eq, Show) data ImportAlign @@ -47,6 +69,11 @@ | AfterAlias deriving (Eq, Show) +data EmptyListAlign + = Inherit + | RightAfter + deriving (Eq, Show) + data LongListAlign = Inline | InlineWithBreak @@ -135,14 +162,22 @@ -------------------------------------------------------------------------------- prettyImport :: (Ord l, Show l) => - Int -> Align -> Bool -> Bool -> Int -> H.ImportDecl l -> [String] -prettyImport columns Align{..} padQualified padName longest imp = - case longListAlign of + 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 Inline -> inlineWrap InlineWithBreak -> longListWrapper inlineWrap inlineWithBreakWrap InlineToMultiline -> longListWrapper inlineWrap inlineToMultilineWrap Multiline -> longListWrapper inlineWrap multilineWrap where + emptyImportSpec = Just (H.ImportSpecList () False []) + -- "import" + space + qualifiedLength has space in it. + listPadding' = listPaddingValue (6 + 1 + qualifiedLength) listPadding + where + qualifiedLength = + if null qualified then 0 else 1 + sum (map length qualified) + longListWrapper shortWrap longWrap | listAlign == NewLine || length shortWrap > 1 @@ -150,6 +185,10 @@ = longWrap | otherwise = shortWrap + emptyWrap = case emptyListAlign of + Inherit -> inlineWrap + RightAfter -> [paddedNoSpecBase ++ " ()"] + inlineWrap = inlineWrapper $ mapSpecs $ withInit (++ ",") @@ -157,13 +196,13 @@ . withLast (++ ")") inlineWrapper = case listAlign of - NewLine -> (paddedNoSpecBase :) . wrapRest columns listPadding + NewLine -> (paddedNoSpecBase :) . wrapRest columns listPadding' WithAlias -> wrap columns paddedBase (inlineBaseLength + 1) -- Add 1 extra space to ensure same padding as in original code. AfterAlias -> withTail (' ' :) . wrap columns paddedBase (afterAliasBaseLength + 1) - inlineWithBreakWrap = paddedNoSpecBase : wrapRest columns listPadding + inlineWithBreakWrap = paddedNoSpecBase : wrapRest columns listPadding' ( mapSpecs $ withInit (++ ",") . withHead ("(" ++) @@ -176,7 +215,7 @@ | otherwise = inlineWithBreakWrap -- 'wrapRest 0' ensures that every item of spec list is on new line. - multilineWrap = paddedNoSpecBase : wrapRest 0 listPadding + multilineWrap = paddedNoSpecBase : wrapRest 0 listPadding' ( mapSpecs ( withHead ("( " ++) . withTail (", " ++)) @@ -230,7 +269,7 @@ -------------------------------------------------------------------------------- -prettyImportGroup :: Int -> Align -> Bool -> Int +prettyImportGroup :: Int -> Options -> Bool -> Int -> [H.ImportDecl LineBlock] -> Lines prettyImportGroup columns align fileAlign longest imps = @@ -253,12 +292,12 @@ -------------------------------------------------------------------------------- -step :: Int -> Align -> Step +step :: Int -> Options -> Step step columns = makeStep "Imports" . step' columns -------------------------------------------------------------------------------- -step' :: Int -> Align -> Lines -> Module -> Lines +step' :: Int -> Options -> Lines -> Module -> Lines step' columns align ls (module', _) = applyChanges [ change block $ const $ prettyImportGroup columns align fileAlign longest importGroup @@ -273,3 +312,17 @@ fileAlign = case importAlign align of File -> any H.importQualified imps _ -> False + +-------------------------------------------------------------------------------- +listPaddingValue :: Int -> ListPadding -> Int +listPaddingValue _ (LPConstant n) = n +listPaddingValue n LPModuleName = n + +-------------------------------------------------------------------------------- + +instance A.FromJSON ListPadding where + parseJSON (A.String "module_name") = return LPModuleName + parseJSON (A.Number n) | n' >= 1 = return $ LPConstant n' + where + n' = truncate n + parseJSON v = A.typeMismatch "'module_name' or >=1 number" v diff --git a/stylish-haskell.cabal b/stylish-haskell.cabal --- a/stylish-haskell.cabal +++ b/stylish-haskell.cabal @@ -1,5 +1,5 @@ Name: stylish-haskell -Version: 0.6.2.0 +Version: 0.6.3.0 Synopsis: Haskell code prettifier Homepage: https://github.com/jaspervdj/stylish-haskell License: BSD3 @@ -25,10 +25,18 @@ CHANGELOG Library - Exposed-modules: Language.Haskell.Stylish Hs-source-dirs: lib Ghc-options: -Wall + Exposed-modules: + Language.Haskell.Stylish + Language.Haskell.Stylish.Step.Imports + Language.Haskell.Stylish.Step.LanguagePragmas + Language.Haskell.Stylish.Step.SimpleAlign + Language.Haskell.Stylish.Step.Tabs + Language.Haskell.Stylish.Step.TrailingWhitespace + Language.Haskell.Stylish.Step.UnicodeSyntax + Other-modules: Language.Haskell.Stylish.Align Language.Haskell.Stylish.Block @@ -36,18 +44,12 @@ Language.Haskell.Stylish.Editor Language.Haskell.Stylish.Parse Language.Haskell.Stylish.Step - Language.Haskell.Stylish.Step.SimpleAlign - Language.Haskell.Stylish.Step.Imports - Language.Haskell.Stylish.Step.LanguagePragmas - Language.Haskell.Stylish.Step.Tabs - Language.Haskell.Stylish.Step.TrailingWhitespace - Language.Haskell.Stylish.Step.UnicodeSyntax Language.Haskell.Stylish.Util Language.Haskell.Stylish.Verbose Paths_stylish_haskell Build-depends: - aeson >= 0.6 && < 0.12, + aeson >= 0.6 && < 1.1, base >= 4.8 && < 5, bytestring >= 0.9 && < 0.11, containers >= 0.3 && < 0.6, @@ -66,9 +68,9 @@ Build-depends: stylish-haskell, strict >= 0.3 && < 0.4, - optparse-applicative >= 0.12 && < 0.13, + optparse-applicative >= 0.12 && < 0.14, -- Copied from regular dependencies... - aeson >= 0.6 && < 0.12, + aeson >= 0.6 && < 1.1, base >= 4.8 && < 5, bytestring >= 0.9 && < 0.11, containers >= 0.3 && < 0.6, @@ -114,7 +116,7 @@ test-framework >= 0.4 && < 0.9, test-framework-hunit >= 0.2 && < 0.4, -- Copied from regular dependencies... - aeson >= 0.6 && < 0.12, + aeson >= 0.6 && < 1.1, base >= 4.8 && < 5, bytestring >= 0.9 && < 0.11, containers >= 0.3 && < 0.6, diff --git a/tests/Language/Haskell/Stylish/Step/Imports/Tests.hs b/tests/Language/Haskell/Stylish/Step/Imports/Tests.hs --- a/tests/Language/Haskell/Stylish/Step/Imports/Tests.hs +++ b/tests/Language/Haskell/Stylish/Step/Imports/Tests.hs @@ -15,15 +15,12 @@ import Language.Haskell.Stylish.Tests.Util --------------------------------------------------------------------------------- -defaultAlign :: Align -defaultAlign = Align Global AfterAlias Inline 4 True - -------------------------------------------------------------------------------- -fromImportAlign :: ImportAlign -> Align -fromImportAlign align = defaultAlign { importAlign = align } +fromImportAlign :: ImportAlign -> Options +fromImportAlign align = defaultOptions { importAlign = align } + -------------------------------------------------------------------------------- tests :: Test tests = testGroup "Language.Haskell.Stylish.Step.Imports.Tests" @@ -45,6 +42,10 @@ , testCase "case 16" case16 , testCase "case 17" case17 , testCase "case 18" case18 + , testCase "case 19" case19 + , testCase "case 19b" case19b + , testCase "case 19d" case19c + , testCase "case 19d" case19d ] @@ -184,7 +185,7 @@ -------------------------------------------------------------------------------- case08 :: Assertion case08 = expected - @=? testStep (step 80 $ Align Global WithAlias Inline 4 True) input + @=? testStep (step 80 $ Options Global WithAlias Inline Inherit (LPConstant 4) True) input where expected = unlines [ "module Herp where" @@ -207,7 +208,7 @@ -------------------------------------------------------------------------------- case09 :: Assertion case09 = expected - @=? testStep (step 80 $ Align Global WithAlias Multiline 4 True) input + @=? testStep (step 80 $ Options Global WithAlias Multiline Inherit (LPConstant 4) True) input where expected = unlines [ "module Herp where" @@ -241,7 +242,7 @@ -------------------------------------------------------------------------------- case10 :: Assertion case10 = expected - @=? testStep (step 40 $ Align Group WithAlias Multiline 4 True) input + @=? testStep (step 40 $ Options Group WithAlias Multiline Inherit (LPConstant 4) True) input where expected = unlines [ "module Herp where" @@ -280,7 +281,7 @@ -------------------------------------------------------------------------------- case11 :: Assertion case11 = expected - @=? testStep (step 80 $ Align Group NewLine Inline 4 True) input + @=? testStep (step 80 $ Options Group NewLine Inline Inherit (LPConstant 4) True) input where expected = unlines [ "module Herp where" @@ -308,7 +309,7 @@ -------------------------------------------------------------------------------- case12 :: Assertion case12 = expected - @=? testStep (step 80 $ Align Group NewLine Inline 2 True) input' + @=? testStep (step 80 $ Options Group NewLine Inline Inherit (LPConstant 2) True) input' where input' = unlines [ "import Data.List (map)" @@ -323,7 +324,7 @@ -------------------------------------------------------------------------------- case13 :: Assertion case13 = expected - @=? testStep (step 80 $ Align None WithAlias InlineWithBreak 4 True) input' + @=? testStep (step 80 $ Options None WithAlias InlineWithBreak Inherit (LPConstant 4) True) input' where input' = unlines [ "import qualified Data.List as List (concat, foldl, foldr, head, init," @@ -341,7 +342,7 @@ case14 :: Assertion case14 = expected @=? testStep - (step 80 $ Align None WithAlias InlineWithBreak 10 True) expected + (step 80 $ Options None WithAlias InlineWithBreak Inherit (LPConstant 10) True) expected where expected = unlines [ "import qualified Data.List as List (concat, map, null, reverse, tail, (++))" @@ -351,7 +352,7 @@ -------------------------------------------------------------------------------- case15 :: Assertion case15 = expected - @=? testStep (step 80 $ Align None AfterAlias Multiline 4 True) input' + @=? testStep (step 80 $ Options None AfterAlias Multiline Inherit (LPConstant 4) True) input' where expected = unlines [ "import Data.Acid (AcidState)" @@ -377,7 +378,7 @@ -------------------------------------------------------------------------------- case16 :: Assertion case16 = expected - @=? testStep (step 80 $ Align None AfterAlias Multiline 4 False) input' + @=? testStep (step 80 $ Options None AfterAlias Multiline Inherit (LPConstant 4) False) input' where expected = unlines [ "import Data.Acid (AcidState)" @@ -401,7 +402,7 @@ -------------------------------------------------------------------------------- case17 :: Assertion case17 = expected - @=? testStep (step 80 $ Align None AfterAlias Multiline 4 True) input' + @=? testStep (step 80 $ Options None AfterAlias Multiline Inherit (LPConstant 4) True) input' where expected = unlines [ "import Control.Applicative (Applicative (pure, (<*>)))" @@ -419,7 +420,7 @@ -------------------------------------------------------------------------------- case18 :: Assertion case18 = expected @=? testStep - (step 40 $ Align None AfterAlias InlineToMultiline 4 True) input' + (step 40 $ Options None AfterAlias InlineToMultiline Inherit (LPConstant 4) True) input' where expected = unlines ---------------------------------------- @@ -441,4 +442,73 @@ , "import Data.Identity (Identity (Identity, runIdentity))" , "" , "import Data.Acid as Acid (closeAcidState, createCheckpoint, openLocalStateFrom)" + ] + +-------------------------------------------------------------------------------- +case19 :: Assertion +case19 = expected @=? testStep + (step 40 $ Options Global NewLine InlineWithBreak RightAfter (LPConstant 17) True) case19input + where + expected = unlines + ---------------------------------------- + [ "import Prelude ()" + , "import Prelude.Compat hiding" + , " (foldMap)" + , "" + , "import Data.List" + , " (foldl', intercalate," + , " intersperse)" + ] + +case19b :: Assertion +case19b = expected @=? testStep + (step 40 $ Options File NewLine InlineWithBreak RightAfter (LPConstant 17) True) case19input + where + expected = unlines + ---------------------------------------- + [ "import Prelude ()" + , "import Prelude.Compat hiding" + , " (foldMap)" + , "" + , "import Data.List" + , " (foldl', intercalate," + , " intersperse)" + ] + +case19c :: Assertion +case19c = expected @=? testStep + (step 40 $ Options File NewLine InlineWithBreak RightAfter LPModuleName True) case19input + where + expected = unlines + ---------------------------------------- + [ "import Prelude ()" + , "import Prelude.Compat hiding" + , " (foldMap)" + , "" + , "import Data.List" + , " (foldl', intercalate," + , " intersperse)" + ] + +case19d :: Assertion +case19d = expected @=? testStep + (step 40 $ Options Global NewLine InlineWithBreak RightAfter LPModuleName True) case19input + where + expected = unlines + ---------------------------------------- + [ "import Prelude ()" + , "import Prelude.Compat hiding" + , " (foldMap)" + , "" + , "import Data.List" + , " (foldl', intercalate," + , " intersperse)" + ] + +case19input :: String +case19input = unlines + [ "import Prelude.Compat hiding (foldMap)" + , "import Prelude ()" + , "" + , "import Data.List (foldl', intercalate, intersperse)" ]