list_padding: module_name

haskell · Aug 3, 2016 · 694aea9 · 694aea9
1 parent ab62581
commit 694aea9
Show file tree

Hide file tree

Showing 4 changed files with 102 additions and 21 deletions.
diff --git a/data/stylish-haskell.yaml b/data/stylish-haskell.yaml
@@ -101,7 +101,12 @@ steps:
       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'.
+      #
+      # - <integer>: 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/Config.hs b/lib/Language/Haskell/Stylish/Config.hs
@@ -189,7 +189,7 @@ parseImports config o = Imports.step
         -- Note that padding has to be at least 1. Default is 4.
         <*> (o A..:? "empty_list_align"
             >>= parseEnum emptyListAligns Imports.Inherit)
-        <*> (maybe 4 (max 1) <$> o A..:? "list_padding")
+        <*> o A..:? "list_padding" A..!= Imports.LPConstant 4
         <*> o A..:? "separate_lists" A..!= True)
   where
     aligns =
@@ -217,7 +217,6 @@ parseImports config o = Imports.step
         , ("right_after", Imports.RightAfter)
         ]
 
-
 --------------------------------------------------------------------------------
 parseLanguagePragmas :: Config -> A.Object -> A.Parser Step
 parseLanguagePragmas config o = LanguagePragmas.step

diff --git a/lib/Language/Haskell/Stylish/Step/Imports.hs b/lib/Language/Haskell/Stylish/Step/Imports.hs
@@ -1,11 +1,13 @@
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE OverloadedStrings #-}
 --------------------------------------------------------------------------------
 module Language.Haskell.Stylish.Step.Imports
     ( Align (..)
     , ImportAlign (..)
     , ListAlign (..)
     , LongListAlign (..)
     , EmptyListAlign (..)
+    , ListPadding (..)
     , step
     ) where
 
@@ -18,6 +20,8 @@ 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
 
 
 --------------------------------------------------------------------------------
@@ -32,11 +36,16 @@ data Align = Align
     , listAlign      :: ListAlign
     , longListAlign  :: LongListAlign
     , emptyListAlign :: EmptyListAlign
-    , listPadding    :: Int
+    , listPadding    :: ListPadding
     , separateLists  :: Bool
     }
     deriving (Eq, Show)
 
+data ListPadding
+    = LPConstant Int
+    | LPModuleName
+    deriving (Eq, Show)
+
 data ImportAlign
     = Global
     | File
@@ -153,6 +162,11 @@ prettyImport columns Align{..} padQualified padName longest imp
         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
@@ -172,13 +186,13 @@ prettyImport columns Align{..} padQualified padName longest imp
         . 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 ("(" ++)
@@ -191,7 +205,7 @@ prettyImport columns Align{..} padQualified padName longest imp
         | 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 (", " ++))
@@ -288,3 +302,17 @@ step' columns align ls (module', _) = applyChanges
     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/tests/Language/Haskell/Stylish/Step/Imports/Tests.hs b/tests/Language/Haskell/Stylish/Step/Imports/Tests.hs
@@ -17,7 +17,7 @@ import           Language.Haskell.Stylish.Tests.Util
 
 --------------------------------------------------------------------------------
 defaultAlign :: Align
-defaultAlign = Align Global AfterAlias Inline Inherit 4 True
+defaultAlign = Align Global AfterAlias Inline Inherit (LPConstant 4) True
 
 
 --------------------------------------------------------------------------------
@@ -46,6 +46,9 @@ tests = testGroup "Language.Haskell.Stylish.Step.Imports.Tests"
     , testCase "case 17" case17
     , testCase "case 18" case18
     , testCase "case 19" case19
+    , testCase "case 19b" case19b
+    , testCase "case 19d" case19c
+    , testCase "case 19d" case19d
     ]
 
 
@@ -185,7 +188,7 @@ case07 = expected @=? testStep (step 80 $ fromImportAlign File) input'
 --------------------------------------------------------------------------------
 case08 :: Assertion
 case08 = expected
-    @=? testStep (step 80 $ Align Global WithAlias Inline Inherit 4 True) input
+    @=? testStep (step 80 $ Align Global WithAlias Inline Inherit (LPConstant 4) True) input
   where
     expected = unlines
         [ "module Herp where"
@@ -208,7 +211,7 @@ case08 = expected
 --------------------------------------------------------------------------------
 case09 :: Assertion
 case09 = expected
-    @=? testStep (step 80 $ Align Global WithAlias Multiline Inherit 4 True) input
+    @=? testStep (step 80 $ Align Global WithAlias Multiline Inherit (LPConstant 4) True) input
   where
     expected = unlines
         [ "module Herp where"
@@ -242,7 +245,7 @@ case09 = expected
 --------------------------------------------------------------------------------
 case10 :: Assertion
 case10 = expected
-    @=? testStep (step 40 $ Align Group WithAlias Multiline Inherit 4 True) input
+    @=? testStep (step 40 $ Align Group WithAlias Multiline Inherit (LPConstant 4) True) input
   where
     expected = unlines
         [ "module Herp where"
@@ -281,7 +284,7 @@ case10 = expected
 --------------------------------------------------------------------------------
 case11 :: Assertion
 case11 = expected
-    @=? testStep (step 80 $ Align Group NewLine Inline Inherit 4 True) input
+    @=? testStep (step 80 $ Align Group NewLine Inline Inherit (LPConstant 4) True) input
   where
     expected = unlines
         [ "module Herp where"
@@ -309,7 +312,7 @@ case11 = expected
 --------------------------------------------------------------------------------
 case12 :: Assertion
 case12 = expected
-    @=? testStep (step 80 $ Align Group NewLine Inline Inherit 2 True) input'
+    @=? testStep (step 80 $ Align Group NewLine Inline Inherit (LPConstant 2) True) input'
   where
     input' = unlines
         [ "import Data.List (map)"
@@ -324,7 +327,7 @@ case12 = expected
 --------------------------------------------------------------------------------
 case13 :: Assertion
 case13 = expected
-    @=? testStep (step 80 $ Align None WithAlias InlineWithBreak Inherit 4 True) input'
+    @=? testStep (step 80 $ Align None WithAlias InlineWithBreak Inherit (LPConstant 4) True) input'
   where
     input' = unlines
         [ "import qualified Data.List as List (concat, foldl, foldr, head, init,"
@@ -342,7 +345,7 @@ case13 = expected
 case14 :: Assertion
 case14 = expected
     @=? testStep
-      (step 80 $ Align None WithAlias InlineWithBreak Inherit 10 True) expected
+      (step 80 $ Align None WithAlias InlineWithBreak Inherit (LPConstant 10) True) expected
   where
     expected = unlines
         [ "import qualified Data.List as List (concat, map, null, reverse, tail, (++))"
@@ -352,7 +355,7 @@ case14 = expected
 --------------------------------------------------------------------------------
 case15 :: Assertion
 case15 = expected
-    @=? testStep (step 80 $ Align None AfterAlias Multiline Inherit 4 True) input'
+    @=? testStep (step 80 $ Align None AfterAlias Multiline Inherit (LPConstant 4) True) input'
   where
     expected = unlines
         [ "import Data.Acid (AcidState)"
@@ -378,7 +381,7 @@ case15 = expected
 --------------------------------------------------------------------------------
 case16 :: Assertion
 case16 = expected
-    @=? testStep (step 80 $ Align None AfterAlias Multiline Inherit 4 False) input'
+    @=? testStep (step 80 $ Align None AfterAlias Multiline Inherit (LPConstant 4) False) input'
   where
     expected = unlines
         [ "import Data.Acid (AcidState)"
@@ -402,7 +405,7 @@ case16 = expected
 --------------------------------------------------------------------------------
 case17 :: Assertion
 case17 = expected
-    @=? testStep (step 80 $ Align None AfterAlias Multiline Inherit 4 True) input'
+    @=? testStep (step 80 $ Align None AfterAlias Multiline Inherit (LPConstant 4) True) input'
   where
     expected = unlines
         [ "import Control.Applicative (Applicative (pure, (<*>)))"
@@ -420,7 +423,7 @@ case17 = expected
 --------------------------------------------------------------------------------
 case18 :: Assertion
 case18 = expected @=? testStep
-    (step 40 $ Align None AfterAlias InlineToMultiline Inherit 4 True) input'
+    (step 40 $ Align None AfterAlias InlineToMultiline Inherit (LPConstant 4) True) input'
   where
     expected = unlines
            ----------------------------------------
@@ -447,7 +450,7 @@ case18 = expected @=? testStep
 --------------------------------------------------------------------------------
 case19 :: Assertion
 case19 = expected @=? testStep
-    (step 40 $ Align Global NewLine InlineWithBreak RightAfter 17 True) input'
+    (step 40 $ Align Global NewLine InlineWithBreak RightAfter (LPConstant 17) True) case19input
   where
     expected = unlines
            ----------------------------------------
@@ -460,7 +463,53 @@ case19 = expected @=? testStep
         , "                 intersperse)"
         ]
 
-    input' = unlines
+case19b :: Assertion
+case19b = expected @=? testStep
+    (step 40 $ Align 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 $ Align 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 $ Align 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 ()"
         , ""