Move Cases step to SimpleAlign

4 files changed, 47 insertions, 19 deletions

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