Merge in ghc-lib-parser patches

.github/workflows/ci.yml

@@ -19,7 +19,7 @@ jobs:
 
     - uses: actions/checkout@v2
 
-    - uses: actions/setup-haskell@v1.1
+    - uses: actions/setup-haskell@v1.1.2
       name: Setup Haskell Stack
       with:
         ghc-version: ${{ matrix.ghc }}
@@ -29,7 +29,7 @@ jobs:
       name: Cache ~/.stack
       with:
         path: ~/.stack
-        key: ${{ runner.os }}-${{ matrix.ghc }}-v2
+        key: ${{ runner.os }}-${{ matrix.ghc }}-v3
 
     - name: Add ~/.local/bin to PATH
       run: echo "::add-path::$HOME/.local/bin"

data/stylish-haskell.yaml

@@ -15,6 +15,19 @@ steps:
   #     # true.
   #     add_language_pragma: true
 
+  # Format module header
+  #
+  # Currently, this option is not configurable and will format all exports and
+  # module declarations to minimize diffs
+  #
+  # - module_header:
+  #     # How many spaces use for indentation in the module header.
+  #     indent: 4
+  #
+  #     # Should export lists be sorted?  Sorting is only performed within the
+  #     # export section, as delineated by Haddock comments.
+  #     sort: true
+
   # Format record definitions. This is disabled by default.
   #
   # You can control the layout of record fields. The only rules that can't be configured
@@ -42,6 +55,31 @@ steps:
   #
   #     # How many spaces to insert before "deriving" clause. Deriving clauses are always on separate lines.
   #     deriving: 2
+  #
+  #     # How many spaces to insert before "via" clause counted from indentation of deriving clause
+  #     # Possible values:
+  #     # - "same_line" -- "{" and first field goes on the same line as the data constructor.
+  #     # - "indent N" -- insert a new line and N spaces from the beginning of the data constructor
+  #     via: "indent 2"
+  #
+  #     # Wheter or not to break enums onto several lines
+  #     #
+  #     # Default: false
+  #     break_enums: false
+  #
+  #     # Whether or not to break single constructor data types before `=` sign
+  #     #
+  #     # Default: true
+  #     break_single_constructors: true
+  #
+  #     # Whether or not to curry constraints on function.
+  #     #
+  #     # E.g: @allValues :: Enum a => Bounded a => Proxy a -> [a]@
+  #     #
+  #     # Instead of @allValues :: (Enum a, Bounded a) => Proxy a -> [a]@
+  #     #
+  #     # Default: false
+  #     curried_context: false
 
   # Align the right hand side of some elements.  This is quite conservative
   # and only applies to statements where each element occupies a single
@@ -101,6 +139,11 @@ steps:
       #   > import qualified Data.List      as List
       #   >     (concat, foldl, foldr, head, init, last, length)
       #
+      # - repeat: Repeat the module name to align the import list.
+      #
+      #   > import qualified Data.List      as List (concat, foldl, foldr, head)
+      #   > import qualified Data.List      as List (init, last, length)
+      #
       # Default: after_alias
       list_align: after_alias
 
@@ -203,6 +246,22 @@ steps:
       # Default: false
       space_surround: false
 
+      # Enabling this argument will use the new GHC lib parse to format imports.
+      #
+      # This currently assumes a few things, it will assume that you want post
+      # qualified imports. It is also not as feature complete as the old
+      # imports formatting.
+      #
+      # It does not remove redundant lines or merge lines. As such, the full
+      # feature scope is still pending.
+      #
+      # It _is_ however, a fine alternative if you are using features that are
+      # not parseable by haskell src extensions and you're comfortable with the
+      # presets.
+      #
+      # Default: false
+      ghc_lib_parser: false
+
   # Language pragmas
   - language_pragmas:
       # We can generate different styles of language pragma lists.

lib/Language/Haskell/Stylish.hs

@@ -91,14 +91,19 @@ unicodeSyntax = UnicodeSyntax.step
 
 --------------------------------------------------------------------------------
 runStep :: Extensions -> Maybe FilePath -> Lines -> Step -> Either String Lines
-runStep exts mfp ls step =
-    stepFilter step ls <$> parseModule exts mfp (unlines ls)
-
+runStep exts mfp ls = \case
+  Step _name step ->
+    step ls <$> parseModule exts mfp (unlines ls)
 
 --------------------------------------------------------------------------------
-runSteps :: Extensions -> Maybe FilePath -> [Step] -> Lines
-         -> Either String Lines
-runSteps exts mfp steps ls = foldM (runStep exts mfp) ls steps
+runSteps ::
+     Extensions
+  -> Maybe FilePath
+  -> [Step]
+  -> Lines
+  -> Either String Lines
+runSteps exts mfp steps ls =
+ foldM (runStep exts mfp) ls steps
 
 newtype ConfigPath = ConfigPath { unConfigPath :: FilePath }
 

lib/Language/Haskell/Stylish/Align.hs

@@ -8,7 +8,7 @@ module Language.Haskell.Stylish.Align
 
 --------------------------------------------------------------------------------
 import           Data.List                       (nub)
-import qualified Language.Haskell.Exts           as H
+import qualified SrcLoc                          as S
 
 
 --------------------------------------------------------------------------------
@@ -51,49 +51,48 @@ data Alignable a = Alignable
     , aRightLead :: !Int
     } deriving (Show)
 
-
 --------------------------------------------------------------------------------
 -- | Create changes that perform the alignment.
+
 align
-    :: Maybe Int              -- ^ Max columns
-    -> [Alignable H.SrcSpan]  -- ^ Alignables
-    -> [Change String]        -- ^ Changes performing the alignment.
+  :: Maybe Int                    -- ^ Max columns
+  -> [Alignable S.RealSrcSpan]    -- ^ Alignables
+  -> [Change String]              -- ^ Changes performing the alignment
 align _ [] = []
 align maxColumns alignment
-    -- Do not make any change if we would go past the maximum number of columns.
-    | exceedsColumns (longestLeft + longestRight) = []
-    | not (fixable alignment)                     = []
-    | otherwise                                   = map align' alignment
+  -- Do not make an changes if we would go past the maximum number of columns
+  | exceedsColumns (longestLeft + longestRight)  = []
+  | not (fixable alignment)                      = []
+  | otherwise                                    = map align' alignment
   where
     exceedsColumns i = case maxColumns of
-        Nothing -> False  -- No number exceeds a maximum column count of
-                          -- Nothing, because there is no limit to exceed.
-        Just c -> i > c
+      Nothing -> False
+      Just c  -> i > c
 
-    -- The longest thing in the left column.
-    longestLeft = maximum $ map (H.srcSpanEndColumn . aLeft) alignment
+    -- The longest thing in the left column
+    longestLeft = maximum $ map (S.srcSpanEndCol . aLeft) alignment
 
-    -- The longest thing in the right column.
+    -- The longest thing in the right column
     longestRight = maximum
-        [ H.srcSpanEndColumn (aRight a) - H.srcSpanStartColumn (aRight a)
-            + aRightLead a
-        | a <- alignment
-        ]
-
-    align' a = changeLine (H.srcSpanStartLine $ aContainer a) $ \str ->
-        let column      = H.srcSpanEndColumn $ aLeft a
-            (pre, post) = splitAt column str
-        in [padRight longestLeft (trimRight pre) ++ trimLeft post]
+      [ S.srcSpanEndCol (aRight a) - S.srcSpanStartCol (aRight a)
+          + aRightLead a
+      | a <- alignment
+      ]
 
+    align' a = changeLine (S.srcSpanStartLine $ aContainer a) $ \str ->
+      let column = S.srcSpanEndCol $ aLeft a
+          (pre, post) = splitAt column str
+      in [padRight longestLeft (trimRight pre) ++ trimLeft post] 
 
 --------------------------------------------------------------------------------
 -- | Checks that all the alignables appear on a single line, and that they do
 -- not overlap.
-fixable :: [Alignable H.SrcSpan] -> Bool
+
+fixable :: [Alignable S.RealSrcSpan] -> Bool
 fixable []     = False
 fixable [_]    = False
 fixable fields = all singleLine containers && nonOverlapping containers
   where
     containers        = map aContainer fields
-    singleLine s      = H.srcSpanStartLine s == H.srcSpanEndLine s
-    nonOverlapping ss = length ss == length (nub $ map H.srcSpanStartLine ss)
+    singleLine s      = S.srcSpanStartLine s == S.srcSpanEndLine s
+    nonOverlapping ss = length ss == length (nub $ map S.srcSpanStartLine ss)

lib/Language/Haskell/Stylish/Block.hs

@@ -4,28 +4,26 @@ module Language.Haskell.Stylish.Block
     , LineBlock
     , SpanBlock
     , blockLength
-    , linesFromSrcSpan
-    , spanFromSrcSpan
     , moveBlock
     , adjacent
     , merge
+    , mergeAdjacent
     , overlapping
     , groupAdjacent
     ) where
 
 
 --------------------------------------------------------------------------------
-import           Control.Arrow         (arr, (&&&), (>>>))
-import qualified Data.IntSet           as IS
-import qualified Language.Haskell.Exts as H
+import qualified Data.IntSet as IS
 
 
 --------------------------------------------------------------------------------
 -- | Indicates a line span
 data Block a = Block
     { blockStart :: Int
     , blockEnd   :: Int
-    } deriving (Eq, Ord, Show)
+    }
+    deriving (Eq, Ord, Show)
 
 
 --------------------------------------------------------------------------------
@@ -40,21 +38,6 @@ type SpanBlock = Block Char
 blockLength :: Block a -> Int
 blockLength (Block start end) = end - start + 1
 
-
---------------------------------------------------------------------------------
-linesFromSrcSpan :: H.SrcSpanInfo -> LineBlock
-linesFromSrcSpan = H.srcInfoSpan >>>
-    H.srcSpanStartLine &&& H.srcSpanEndLine >>>
-    arr (uncurry Block)
-
-
---------------------------------------------------------------------------------
-spanFromSrcSpan :: H.SrcSpanInfo -> SpanBlock
-spanFromSrcSpan = H.srcInfoSpan >>>
-    H.srcSpanStartColumn &&& H.srcSpanEndColumn >>>
-    arr (uncurry Block)
-
-
 --------------------------------------------------------------------------------
 moveBlock :: Int -> Block a -> Block a
 moveBlock offset (Block start end) = Block (start + offset) (end + offset)
@@ -94,3 +77,8 @@ groupAdjacent = foldr go []
     go (b1, x) gs = case break (adjacent b1 . fst) gs of
         (_, [])               -> (b1, [x]) : gs
         (ys, ((b2, xs) : zs)) -> (merge b1 b2, x : xs) : (ys ++ zs)
+
+mergeAdjacent :: [Block a] -> [Block a]
+mergeAdjacent (a : b : rest) | a `adjacent` b = merge a b : mergeAdjacent rest
+mergeAdjacent (a : rest)     = a : mergeAdjacent rest
+mergeAdjacent []             = []