Use ghc-lib-parser rather than haskell-src-exts

This patch swaps out the parsing library from `haskell-src-exts` to
`ghc-lib-parser`, which gives us better compatibility with GHC.

Because almost every module heavily used the Haskell AST provided by
`haskell-src-exts`, this was a huge effort and it would not have been possible
without Felix Mulder doing an initial port, GSoC student Beatrice Vergani
porting several other steps, and Łukasz Gołębiewski and Paweł Szulc who helped
me finish up things in the home stretch.

I've generally tried to keep styling 100% compatible with what was there before,
but some issues may have unintentionally slipped in so please report those.

This introduces one new import styling contributed by Felix: when wrapping
import lists over multiple lines, you can repeat the module name, e.g.:

    import Control.Monad.Except as X (ExceptT (..), MonadError (..), liftEither)
    import Control.Monad.Except as X (runExceptT, withExceptT)

This is activated by using `import_align: repeat`.

Secondly, a new Step was added, `module_header`, which formats the export list
of a module, including the trailing `where` clause.  Details for this new step
can be found in the `data/stylish-haskell.yaml`.

Co-Authored-By: Beatrice Vergani <[email protected]>
Co-Authored-By: Paweł Szulc <[email protected]>
Co-Authored-By: Łukasz Gołębiewski <[email protected]>
Co-Authored-By: Felix Mulder <[email protected]>

Author: 5 people

.github/workflows/ci.yml

@@ -19,7 +19,7 @@ jobs:
 
     - uses: actions/checkout@v2
 
-    - uses: actions/[email protected]
+    - uses: actions/[email protected].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 []             = []