Move Cases step to SimpleAlign

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