Add a setting for the number of columns

4 files changed, 49 insertions, 35 deletions

diff --git a/.stylish-haskell.yaml b/.stylish-haskell.yaml
index 0700d0b..4be6dc7 100644
--- a/.stylish-haskell.yaml
+++ b/.stylish-haskell.yaml
@@ -54,6 +54,10 @@ steps:
   # Remove trailing whitespace
   - trailing_whitespace: {}
 
+# A common setting is the number of columns (parts of) code will be wrapped
+# to. Different steps take this into account. Default: 80.
+columns: 80
+
 # Sometimes, language extensions are specified in a cabal file or from the
 # command line instead of using language pragmas in the file. stylish-haskell
 # needs to be aware of these, so it can parse the file correctly.
diff --git a/src/StylishHaskell/Config.hs b/src/StylishHaskell/Config.hs
index b9d9bca..559d058 100644
--- a/src/StylishHaskell/Config.hs
+++ b/src/StylishHaskell/Config.hs
@@ -10,7 +10,7 @@ module StylishHaskell.Config
 
 
 --------------------------------------------------------------------------------
-import           Control.Applicative                    ((<$>), (<*>))
+import           Control.Applicative                    (pure, (<$>), (<*>))
 import           Control.Monad                          (forM, msum, mzero)
 import           Data.Aeson                             (FromJSON(..))
 import qualified Data.Aeson                             as A
@@ -42,6 +42,7 @@ type Extensions = [String]
 --------------------------------------------------------------------------------
 data Config = Config
     { configSteps              :: [Step]
+    , configColumns            :: Int
     , configLanguageExtensions :: [String]
     }
 
@@ -53,7 +54,7 @@ instance FromJSON Config where
 
 --------------------------------------------------------------------------------
 emptyConfig :: Config
-emptyConfig = Config [] []
+emptyConfig = Config [] 80 []
 
 
 --------------------------------------------------------------------------------
@@ -105,14 +106,21 @@ loadConfig verbose mfp = do
 
 --------------------------------------------------------------------------------
 parseConfig :: A.Value -> A.Parser Config
-parseConfig (A.Object o) = Config
-    <$> (o A..: "steps" >>= fmap concat . mapM parseSteps)
-    <*> (o A..:? "language_extensions" A..!= [])
+parseConfig (A.Object o) = do
+    -- First load the config without the actual steps
+    config <- Config
+        <$> pure []
+        <*> (o A..:? "columns"             A..!= 80)
+        <*> (o A..:? "language_extensions" A..!= [])
+
+    -- Then fill in the steps based on the partial config we already have
+    steps <- (o A..:  "steps" >>= fmap concat . mapM (parseSteps config))
+    return config {configSteps = steps}
 parseConfig _            = mzero
 
 
 --------------------------------------------------------------------------------
-catalog :: Map String (A.Object -> A.Parser Step)
+catalog :: Map String (Config -> A.Object -> A.Parser Step)
 catalog = M.fromList
     [ ("imports",             parseImports)
     , ("language_pragmas",    parseLanguagePragmas)
@@ -123,11 +131,11 @@ catalog = M.fromList
 
 
 --------------------------------------------------------------------------------
-parseSteps :: A.Value -> A.Parser [Step]
-parseSteps val = do
+parseSteps :: Config -> A.Value -> A.Parser [Step]
+parseSteps config val = do
     map' <- parseJSON val :: A.Parser (Map String A.Value)
     forM (M.toList map') $ \(k, v) -> case (M.lookup k catalog, v) of
-        (Just parser, A.Object o) -> parser o
+        (Just parser, A.Object o) -> parser config o
         _                         -> fail $ "Invalid declaration for " ++ k
 
 
@@ -142,9 +150,10 @@ parseEnum strs _   (Just k) = case lookup k strs of
 
 
 --------------------------------------------------------------------------------
-parseImports :: A.Object -> A.Parser Step
-parseImports o = Imports.step
-    <$> (o A..:? "align" >>= parseEnum aligns Imports.Global)
+parseImports :: Config -> A.Object -> A.Parser Step
+parseImports config o = Imports.step
+    <$> pure (configColumns config)
+    <*> (o A..:? "align" >>= parseEnum aligns Imports.Global)
   where
     aligns =
         [ ("global", Imports.Global)
@@ -154,8 +163,8 @@ parseImports o = Imports.step
 
 
 --------------------------------------------------------------------------------
-parseLanguagePragmas :: A.Object -> A.Parser Step
-parseLanguagePragmas o = LanguagePragmas.step
+parseLanguagePragmas :: Config -> A.Object -> A.Parser Step
+parseLanguagePragmas _ o = LanguagePragmas.step
     <$> (o A..:? "style" >>= parseEnum styles LanguagePragmas.Vertical)
     <*> o A..:? "remove_redundant" A..!= True
   where
@@ -166,17 +175,17 @@ parseLanguagePragmas o = LanguagePragmas.step
 
 
 --------------------------------------------------------------------------------
-parseTabs :: A.Object -> A.Parser Step
-parseTabs o = Tabs.step
+parseTabs :: Config -> A.Object -> A.Parser Step
+parseTabs _ o = Tabs.step
     <$> o A..:? "spaces" A..!= 8
 
 
 --------------------------------------------------------------------------------
-parseTrailingWhitespace :: A.Object -> A.Parser Step
-parseTrailingWhitespace _ = return TrailingWhitespace.step
+parseTrailingWhitespace :: Config -> A.Object -> A.Parser Step
+parseTrailingWhitespace _ _ = return TrailingWhitespace.step
 
 
 --------------------------------------------------------------------------------
-parseUnicodeSyntax :: A.Object -> A.Parser Step
-parseUnicodeSyntax o = UnicodeSyntax.step
+parseUnicodeSyntax :: Config -> A.Object -> A.Parser Step
+parseUnicodeSyntax _ o = UnicodeSyntax.step
     <$> o A..:? "add_language_pragma" A..!= True
diff --git a/src/StylishHaskell/Step/Imports.hs b/src/StylishHaskell/Step/Imports.hs
index 3760e97..1b50d5c 100644
--- a/src/StylishHaskell/Step/Imports.hs
+++ b/src/StylishHaskell/Step/Imports.hs
@@ -91,10 +91,10 @@ sortImportSpecs imp = imp {H.importSpecs = fmap sort $ H.importSpecs imp}
 
 
 --------------------------------------------------------------------------------
-prettyImport :: Bool -> Bool -> Int -> H.ImportDecl l -> String
-prettyImport padQualified padName longest imp =
+prettyImport :: Int -> Bool -> Bool -> Int -> H.ImportDecl l -> String
+prettyImport columns padQualified padName longest imp =
     intercalate "\n" $
-    wrap 80 base (length base + 1) $
+    wrap columns base (length base + 1) $
     (if hiding then ("hiding" :) else id) $
     withInit (++ ",") $
     withHead ("(" ++) $
@@ -123,9 +123,10 @@ prettyImport padQualified padName longest imp =
 
 
 --------------------------------------------------------------------------------
-prettyImportGroup :: Align -> Int -> [H.ImportDecl LineBlock] -> Lines
-prettyImportGroup align longest imps =
-    map (prettyImport padQual padName longest') $ sortBy compareImports imps
+prettyImportGroup :: Int -> Align -> Int -> [H.ImportDecl LineBlock] -> Lines
+prettyImportGroup columns align longest imps =
+    map (prettyImport columns padQual padName longest') $
+    sortBy compareImports imps
   where
     longest' = case align of
         Group -> longestImport imps
@@ -140,14 +141,14 @@ prettyImportGroup align longest imps =
 
 
 --------------------------------------------------------------------------------
-step :: Align -> Step
-step = makeStep "Imports" . step'
+step :: Int -> Align -> Step
+step columns = makeStep "Imports" . step' columns
 
 
 --------------------------------------------------------------------------------
-step' :: Align -> Lines -> Module -> Lines
-step' align ls (module', _) = flip applyChanges ls
-    [ change block (prettyImportGroup align longest importGroup)
+step' :: Int -> Align -> Lines -> Module -> Lines
+step' columns align ls (module', _) = flip applyChanges ls
+    [ change block (prettyImportGroup columns align longest importGroup)
     | (block, importGroup) <- groups
     ]
   where
diff --git a/tests/StylishHaskell/Step/Imports/Tests.hs b/tests/StylishHaskell/Step/Imports/Tests.hs
index c6c0553..6da0af3 100644
--- a/tests/StylishHaskell/Step/Imports/Tests.hs
+++ b/tests/StylishHaskell/Step/Imports/Tests.hs
@@ -43,7 +43,7 @@ input = unlines
 
 --------------------------------------------------------------------------------
 case01 :: Assertion
-case01 = expected @=? testStep (step Global) input
+case01 = expected @=? testStep (step 80 Global) input
   where
     expected = unlines
         [ "module Herp where"
@@ -61,7 +61,7 @@ case01 = expected @=? testStep (step Global) input
 
 --------------------------------------------------------------------------------
 case02 :: Assertion
-case02 = expected @=? testStep (step Group) input
+case02 = expected @=? testStep (step 80 Group) input
   where
     expected = unlines
         [ "module Herp where"
@@ -79,7 +79,7 @@ case02 = expected @=? testStep (step Group) input
 
 --------------------------------------------------------------------------------
 case03 :: Assertion
-case03 = expected @=? testStep (step None) input
+case03 = expected @=? testStep (step 80 None) input
   where
     expected = unlines
         [ "module Herp where"
@@ -97,7 +97,7 @@ case03 = expected @=? testStep (step None) input
 
 --------------------------------------------------------------------------------
 case04 :: Assertion
-case04 = expected @=? testStep (step Global) input'
+case04 = expected @=? testStep (step 80 Global) input'
   where
     input' =
         "import Data.Aeson.Types (object, typeMismatch, FromJSON(..)," ++