diff options
-rw-r--r-- | data/stylish-haskell.yaml | 8 | ||||
-rw-r--r-- | lib/Language/Haskell/Stylish.hs | 11 | ||||
-rw-r--r-- | lib/Language/Haskell/Stylish/Align.hs | 1 | ||||
-rw-r--r-- | lib/Language/Haskell/Stylish/Config.hs | 17 | ||||
-rw-r--r-- | lib/Language/Haskell/Stylish/Step/SimpleAlign.hs (renamed from lib/Language/Haskell/Stylish/Step/Cases.hs) | 37 | ||||
-rw-r--r-- | stylish-haskell.cabal | 5 | ||||
-rw-r--r-- | tests/Language/Haskell/Stylish/Parse/Tests.hs | 2 | ||||
-rw-r--r-- | tests/Language/Haskell/Stylish/Step/SimpleAlign/Tests.hs (renamed from tests/Language/Haskell/Stylish/Step/Cases/Tests.hs) | 12 | ||||
-rw-r--r-- | tests/TestSuite.hs | 6 |
9 files changed, 65 insertions, 34 deletions
diff --git a/data/stylish-haskell.yaml b/data/stylish-haskell.yaml index d1c55f1..cbeaee0 100644 --- a/data/stylish-haskell.yaml +++ b/data/stylish-haskell.yaml @@ -15,10 +15,12 @@ steps: # # true. # add_language_pragma: true - # Align the right hand side of case statements. This is quite conservative - # and only applies to case statements where each alternative occupies a single + # Align the right hand side of some elements. This is quite conservative + # and only applies to statements where each element occupies a single # line. - - cases: {} + - simple_align: + cases: true + top_level_patterns: true # Import cleanup - imports: diff --git a/lib/Language/Haskell/Stylish.hs b/lib/Language/Haskell/Stylish.hs index 6e54d65..2dbf7fc 100644 --- a/lib/Language/Haskell/Stylish.hs +++ b/lib/Language/Haskell/Stylish.hs @@ -3,7 +3,7 @@ module Language.Haskell.Stylish ( -- * Run runSteps -- * Steps - , cases + , simpleAlign , imports , languagePragmas , records @@ -33,10 +33,10 @@ import Control.Monad (foldM) import Language.Haskell.Stylish.Config import Language.Haskell.Stylish.Parse import Language.Haskell.Stylish.Step -import qualified Language.Haskell.Stylish.Step.Cases as Cases import qualified Language.Haskell.Stylish.Step.Imports as Imports import qualified Language.Haskell.Stylish.Step.LanguagePragmas as LanguagePragmas import qualified Language.Haskell.Stylish.Step.Records as Records +import qualified Language.Haskell.Stylish.Step.SimpleAlign as SimpleAlign import qualified Language.Haskell.Stylish.Step.Tabs as Tabs import qualified Language.Haskell.Stylish.Step.TrailingWhitespace as TrailingWhitespace import qualified Language.Haskell.Stylish.Step.UnicodeSyntax as UnicodeSyntax @@ -45,9 +45,10 @@ import Paths_stylish_haskell (version) -------------------------------------------------------------------------------- -cases :: Int -- ^ Columns - -> Step -cases = Cases.step +simpleAlign :: Int -- ^ Columns + -> SimpleAlign.Config + -> Step +simpleAlign = SimpleAlign.step -------------------------------------------------------------------------------- diff --git a/lib/Language/Haskell/Stylish/Align.hs b/lib/Language/Haskell/Stylish/Align.hs index bfee9d2..c58b133 100644 --- a/lib/Language/Haskell/Stylish/Align.hs +++ b/lib/Language/Haskell/Stylish/Align.hs @@ -89,6 +89,7 @@ align maxColumns alignment -- not overlap. fixable :: [Alignable H.SrcSpan] -> Bool fixable [] = False +fixable [_] = False fixable fields = all singleLine containers && nonOverlapping containers where containers = map aContainer fields diff --git a/lib/Language/Haskell/Stylish/Config.hs b/lib/Language/Haskell/Stylish/Config.hs index b25f343..14f7a04 100644 --- a/lib/Language/Haskell/Stylish/Config.hs +++ b/lib/Language/Haskell/Stylish/Config.hs @@ -14,6 +14,7 @@ import Control.Monad (forM, mzero) import Data.Aeson (FromJSON (..)) import qualified Data.Aeson as A import qualified Data.Aeson.Types as A +import Data.Maybe (fromMaybe) import qualified Data.ByteString as B import Data.List (inits, intercalate) @@ -30,10 +31,10 @@ import qualified System.IO as IO (Newline -------------------------------------------------------------------------------- import Language.Haskell.Stylish.Step -import qualified Language.Haskell.Stylish.Step.Cases as Cases import qualified Language.Haskell.Stylish.Step.Imports as Imports import qualified Language.Haskell.Stylish.Step.LanguagePragmas as LanguagePragmas import qualified Language.Haskell.Stylish.Step.Records as Records +import qualified Language.Haskell.Stylish.Step.SimpleAlign as SimpleAlign import qualified Language.Haskell.Stylish.Step.Tabs as Tabs import qualified Language.Haskell.Stylish.Step.TrailingWhitespace as TrailingWhitespace import qualified Language.Haskell.Stylish.Step.UnicodeSyntax as UnicodeSyntax @@ -137,10 +138,10 @@ parseConfig _ = mzero -------------------------------------------------------------------------------- catalog :: Map String (Config -> A.Object -> A.Parser Step) catalog = M.fromList - [ ("cases", parseCases) - , ("imports", parseImports) + [ ("imports", parseImports) , ("language_pragmas", parseLanguagePragmas) , ("records", parseRecords) + , ("simple_align", parseSimpleAlign) , ("tabs", parseTabs) , ("trailing_whitespace", parseTrailingWhitespace) , ("unicode_syntax", parseUnicodeSyntax) @@ -167,8 +168,14 @@ parseEnum strs _ (Just k) = case lookup k strs of -------------------------------------------------------------------------------- -parseCases :: Config -> A.Object -> A.Parser Step -parseCases c _ = return (Cases.step $ configColumns c) +parseSimpleAlign :: Config -> A.Object -> A.Parser Step +parseSimpleAlign c o = SimpleAlign.step + <$> pure (configColumns c) + <*> (SimpleAlign.Config + <$> withDef SimpleAlign.cCases "cases" + <*> withDef SimpleAlign.cTopLevelPatterns "top_level_patterns") + where + withDef f k = fromMaybe (f SimpleAlign.defaultConfig) <$> (o A..:? k) -------------------------------------------------------------------------------- diff --git a/lib/Language/Haskell/Stylish/Step/Cases.hs b/lib/Language/Haskell/Stylish/Step/SimpleAlign.hs index 5ea30f4..68af224 100644 --- a/lib/Language/Haskell/Stylish/Step/Cases.hs +++ b/lib/Language/Haskell/Stylish/Step/SimpleAlign.hs @@ -1,12 +1,14 @@ -------------------------------------------------------------------------------- -module Language.Haskell.Stylish.Step.Cases - ( step +module Language.Haskell.Stylish.Step.SimpleAlign + ( Config (..) + , defaultConfig + , step ) where -------------------------------------------------------------------------------- import Data.Data (Data) -import Data.Maybe (maybeToList) +import Data.Maybe (maybeToList) import qualified Language.Haskell.Exts.Annotated as H @@ -18,6 +20,21 @@ import Language.Haskell.Stylish.Util -------------------------------------------------------------------------------- +data Config = Config + { cCases :: !Bool + , cTopLevelPatterns :: !Bool + } deriving (Show) + + +-------------------------------------------------------------------------------- +defaultConfig :: Config +defaultConfig = Config + { cCases = True + , cTopLevelPatterns = True + } + + +-------------------------------------------------------------------------------- cases :: Data l => H.Module l -> [[H.Alt l]] cases modu = [alts | H.Case _ _ alts <- everything modu] @@ -52,16 +69,18 @@ matchToAlignable (H.Match ann name pats rhs Nothing) = Just $ Alignable -------------------------------------------------------------------------------- -step :: Int -> Step -step maxColumns = makeStep "Cases" $ \ls (module', _) -> +step :: Int -> Config -> Step +step maxColumns config = makeStep "Cases" $ \ls (module', _) -> let module'' = fmap H.srcInfoSpan module' changes search toAlign = [ change_ | case_ <- search module'' , aligns <- maybeToList (mapM toAlign case_) , change_ <- align maxColumns aligns - ] in + ] + + configured = concat $ + [changes cases altToAlignable | cCases config] ++ + [changes tlpats matchToAlignable | cTopLevelPatterns config] - applyChanges - (changes cases altToAlignable ++ changes tlpats matchToAlignable) - ls + in applyChanges configured ls diff --git a/stylish-haskell.cabal b/stylish-haskell.cabal index f945264..3678315 100644 --- a/stylish-haskell.cabal +++ b/stylish-haskell.cabal @@ -36,7 +36,7 @@ Library Language.Haskell.Stylish.Editor Language.Haskell.Stylish.Parse Language.Haskell.Stylish.Step - Language.Haskell.Stylish.Step.Cases + Language.Haskell.Stylish.Step.SimpleAlign Language.Haskell.Stylish.Step.Imports Language.Haskell.Stylish.Step.LanguagePragmas Language.Haskell.Stylish.Step.Records @@ -94,7 +94,8 @@ Test-suite stylish-haskell-tests Language.Haskell.Stylish.Parse Language.Haskell.Stylish.Parse.Tests Language.Haskell.Stylish.Step - Language.Haskell.Stylish.Step.Cases + Language.Haskell.Stylish.Step.SimpleAlign + Language.Haskell.Stylish.Step.SimpleAlign.Tests Language.Haskell.Stylish.Step.Imports Language.Haskell.Stylish.Step.Imports.Tests Language.Haskell.Stylish.Step.LanguagePragmas diff --git a/tests/Language/Haskell/Stylish/Parse/Tests.hs b/tests/Language/Haskell/Stylish/Parse/Tests.hs index 1e6b992..4d3400c 100644 --- a/tests/Language/Haskell/Stylish/Parse/Tests.hs +++ b/tests/Language/Haskell/Stylish/Parse/Tests.hs @@ -24,7 +24,7 @@ tests = testGroup "Language.Haskell.Stylish.Parse" , testCase "ShebangExt" testShebangExt , testCase "GADTs extension" testGADTs , testCase "KindSignatures extension" testKindSignatures - , testCase "StandalonDeriving extension" testKindSignatures + , testCase "StandalonDeriving extension" testStandaloneDeriving , testCase "UnicodeSyntax extension" testUnicodeSyntax ] diff --git a/tests/Language/Haskell/Stylish/Step/Cases/Tests.hs b/tests/Language/Haskell/Stylish/Step/SimpleAlign/Tests.hs index 6a104f8..b36f5d9 100644 --- a/tests/Language/Haskell/Stylish/Step/Cases/Tests.hs +++ b/tests/Language/Haskell/Stylish/Step/SimpleAlign/Tests.hs @@ -1,5 +1,5 @@ -------------------------------------------------------------------------------- -module Language.Haskell.Stylish.Step.Cases.Tests +module Language.Haskell.Stylish.Step.SimpleAlign.Tests ( tests ) where @@ -11,13 +11,13 @@ import Test.HUnit (Assertion, (@=?)) -------------------------------------------------------------------------------- -import Language.Haskell.Stylish.Step.Cases +import Language.Haskell.Stylish.Step.SimpleAlign import Language.Haskell.Stylish.Tests.Util -------------------------------------------------------------------------------- tests :: Test -tests = testGroup "Language.Haskell.Stylish.Step.Records.Tests" +tests = testGroup "Language.Haskell.Stylish.Step.SimpleAlign.Tests" [ testCase "case 01" case01 , testCase "case 02" case02 , testCase "case 03" case03 @@ -26,7 +26,7 @@ tests = testGroup "Language.Haskell.Stylish.Step.Records.Tests" -------------------------------------------------------------------------------- case01 :: Assertion -case01 = expected @=? testStep (step 80) input +case01 = expected @=? testStep (step 80 defaultConfig) input where input = unlines [ "eitherToMaybe e = case e of" @@ -43,7 +43,7 @@ case01 = expected @=? testStep (step 80) input -------------------------------------------------------------------------------- case02 :: Assertion -case02 = expected @=? testStep (step 80) input +case02 = expected @=? testStep (step 80 defaultConfig) input where input = unlines [ "eitherToMaybe (Left _) = Nothing" @@ -58,7 +58,7 @@ case02 = expected @=? testStep (step 80) input -------------------------------------------------------------------------------- case03 :: Assertion -case03 = expected @=? testStep (step 80) input +case03 = expected @=? testStep (step 80 defaultConfig) input where input = unlines [ "heady def [] = def" diff --git a/tests/TestSuite.hs b/tests/TestSuite.hs index 27f9851..d739760 100644 --- a/tests/TestSuite.hs +++ b/tests/TestSuite.hs @@ -5,15 +5,15 @@ module Main -------------------------------------------------------------------------------- -import Test.Framework (defaultMain) +import Test.Framework (defaultMain) -------------------------------------------------------------------------------- import qualified Language.Haskell.Stylish.Parse.Tests -import qualified Language.Haskell.Stylish.Step.Cases.Tests import qualified Language.Haskell.Stylish.Step.Imports.Tests import qualified Language.Haskell.Stylish.Step.LanguagePragmas.Tests import qualified Language.Haskell.Stylish.Step.Records.Tests +import qualified Language.Haskell.Stylish.Step.SimpleAlign.Tests import qualified Language.Haskell.Stylish.Step.Tabs.Tests import qualified Language.Haskell.Stylish.Step.TrailingWhitespace.Tests import qualified Language.Haskell.Stylish.Step.UnicodeSyntax.Tests @@ -23,10 +23,10 @@ import qualified Language.Haskell.Stylish.Step.UnicodeSyntax.Tests main :: IO () main = defaultMain [ Language.Haskell.Stylish.Parse.Tests.tests - , Language.Haskell.Stylish.Step.Cases.Tests.tests , Language.Haskell.Stylish.Step.Imports.Tests.tests , Language.Haskell.Stylish.Step.LanguagePragmas.Tests.tests , Language.Haskell.Stylish.Step.Records.Tests.tests + , Language.Haskell.Stylish.Step.SimpleAlign.Tests.tests , Language.Haskell.Stylish.Step.Tabs.Tests.tests , Language.Haskell.Stylish.Step.TrailingWhitespace.Tests.tests , Language.Haskell.Stylish.Step.UnicodeSyntax.Tests.tests |