stylish-haskell 0.13.0.0 → 0.14.0.0

raw patch · 34 files changed

+2276/−2604 lines, 34 filesdep +ghc-lib-parser-exdep ~Cabaldep ~aesondep ~bytestringPVP ok

version bump matches the API change (PVP)

Dependencies added: ghc-lib-parser-ex

Dependency ranges changed: Cabal, aeson, bytestring, ghc-lib-parser, optparse-applicative

API changes (from Hackage documentation)

Files

• CHANGELOG +5/−0
• data/stylish-haskell.yaml +1/−1
• lib/Language/Haskell/Stylish/Align.hs +11/−11
• lib/Language/Haskell/Stylish/Block.hs +16/−4
• lib/Language/Haskell/Stylish/Comments.hs +145/−0
• lib/Language/Haskell/Stylish/Config.hs +8/−11
• lib/Language/Haskell/Stylish/Config/Cabal.hs +0/−1
• lib/Language/Haskell/Stylish/Editor.hs +3/−1
• lib/Language/Haskell/Stylish/GHC.hs +41/−58
• lib/Language/Haskell/Stylish/Module.hs +63/−197
• lib/Language/Haskell/Stylish/Ordering.hs +32/−21
• lib/Language/Haskell/Stylish/Parse.hs +56/−81
• lib/Language/Haskell/Stylish/Printer.hs +110/−227
• lib/Language/Haskell/Stylish/Step/Data.hs +326/−322
• lib/Language/Haskell/Stylish/Step/Imports.hs +231/−242
• lib/Language/Haskell/Stylish/Step/LanguagePragmas.hs +25/−29
• lib/Language/Haskell/Stylish/Step/ModuleHeader.hs +139/−214
• lib/Language/Haskell/Stylish/Step/SimpleAlign.hs +50/−53
• lib/Language/Haskell/Stylish/Step/Squash.hs +22/−25
• lib/Language/Haskell/Stylish/Step/UnicodeSyntax.hs +75/−53
• lib/Language/Haskell/Stylish/Util.hs +11/−22
• stylish-haskell.cabal +48/−101
• tests/Language/Haskell/Stylish/Config/Tests.hs +1/−1
• tests/Language/Haskell/Stylish/Regressions.hs +5/−6
• tests/Language/Haskell/Stylish/Step/Data/Tests.hs +436/−446
• tests/Language/Haskell/Stylish/Step/Imports/FelixTests.hs +267/−329
• tests/Language/Haskell/Stylish/Step/Imports/Tests.hs +23/−16
• tests/Language/Haskell/Stylish/Step/LanguagePragmas/Tests.hs +16/−20
• tests/Language/Haskell/Stylish/Step/ModuleHeader/Tests.hs +26/−0
• tests/Language/Haskell/Stylish/Step/Tabs/Tests.hs +15/−18
• tests/Language/Haskell/Stylish/Step/TrailingWhitespace/Tests.hs +15/−18
• tests/Language/Haskell/Stylish/Step/UnicodeSyntax/Tests.hs +20/−27
• tests/Language/Haskell/Stylish/Tests.hs +15/−7
• tests/Language/Haskell/Stylish/Tests/Util.hs +19/−42

@@ -1,5 +1,10 @@ # CHANGELOG +- 0.14.0.0 (2022-03-16)+     *  Port to GHC 9.2 AST (by jaspervdj)+     *  Case insensitive import sort (by vlatkoB)+     *  Fix issue with dissappearing GADT kind signatures (by Łukasz Gołębiewski)+ - 0.13.0.0 (2021-09-15)      *  Don't remove ticks on promoted data types (by Jim McStanton)      *  Add break_only_where option (by 1Computer1)

@@ -85,7 +85,7 @@   #     # Sort typeclass names in the "deriving" list alphabetically.   #     sort_deriving: true   #-  #     # Wheter or not to break enums onto several lines+  #     # Whether or not to break enums onto several lines   #     #   #     # Default: false   #     break_enums: false

@@ -8,7 +8,7 @@  -------------------------------------------------------------------------------- import           Data.List                       (nub)-import qualified SrcLoc                          as S+import qualified GHC.Types.SrcLoc                          as GHC   --------------------------------------------------------------------------------@@ -55,9 +55,9 @@ -- | Create changes that perform the alignment.  align-  :: Maybe Int                    -- ^ Max columns-  -> [Alignable S.RealSrcSpan]    -- ^ Alignables-  -> [Change String]              -- ^ Changes performing the alignment+  :: Maybe Int                      -- ^ Max columns+  -> [Alignable GHC.RealSrcSpan]    -- ^ Alignables+  -> [Change String]                -- ^ Changes performing the alignment align _ [] = [] align maxColumns alignment   -- Do not make an changes if we would go past the maximum number of columns@@ -70,17 +70,17 @@       Just c  -> i > c      -- The longest thing in the left column-    longestLeft = maximum $ map (S.srcSpanEndCol . aLeft) alignment+    longestLeft = maximum $ map (GHC.srcSpanEndCol . aLeft) alignment      -- The longest thing in the right column     longestRight = maximum-      [ S.srcSpanEndCol (aRight a) - S.srcSpanStartCol (aRight a)+      [ GHC.srcSpanEndCol (aRight a) - GHC.srcSpanStartCol (aRight a)           + aRightLead a       | a <- alignment       ] -    align' a = changeLine (S.srcSpanStartLine $ aContainer a) $ \str ->-      let column = S.srcSpanEndCol $ aLeft a+    align' a = changeLine (GHC.srcSpanStartLine $ aContainer a) $ \str ->+      let column = GHC.srcSpanEndCol $ aLeft a           (pre, post) = splitAt column str       in [padRight longestLeft (trimRight pre) ++ trimLeft post]  @@ -88,11 +88,11 @@ -- | Checks that all the alignables appear on a single line, and that they do -- not overlap. -fixable :: [Alignable S.RealSrcSpan] -> Bool+fixable :: [Alignable GHC.RealSrcSpan] -> Bool fixable []     = False fixable [_]    = False fixable fields = all singleLine containers && nonOverlapping containers   where     containers        = map aContainer fields-    singleLine s      = S.srcSpanStartLine s == S.srcSpanEndLine s-    nonOverlapping ss = length ss == length (nub $ map S.srcSpanStartLine ss)+    singleLine s      = GHC.srcSpanStartLine s == GHC.srcSpanEndLine s+    nonOverlapping ss = length ss == length (nub $ map GHC.srcSpanStartLine ss)

@@ -2,6 +2,7 @@ module Language.Haskell.Stylish.Block     ( Block (..)     , LineBlock+    , realSrcSpanToLineBlock     , SpanBlock     , blockLength     , moveBlock@@ -14,7 +15,8 @@   ---------------------------------------------------------------------------------import qualified Data.IntSet as IS+import qualified Data.IntSet      as IS+import qualified GHC.Types.SrcLoc as GHC   --------------------------------------------------------------------------------@@ -22,11 +24,15 @@ data Block a = Block     { blockStart :: Int     , blockEnd   :: Int-    }-    deriving (Eq, Ord, Show)+    } deriving (Eq, Ord, Show)   --------------------------------------------------------------------------------+instance Semigroup (Block a) where+    (<>) = merge+++-------------------------------------------------------------------------------- type LineBlock = Block String  @@ -35,9 +41,15 @@   --------------------------------------------------------------------------------+realSrcSpanToLineBlock :: GHC.RealSrcSpan -> Block String+realSrcSpanToLineBlock s = Block (GHC.srcSpanStartLine s) (GHC.srcSpanEndLine s)+++-------------------------------------------------------------------------------- blockLength :: Block a -> Int blockLength (Block start end) = end - start + 1 + -------------------------------------------------------------------------------- moveBlock :: Int -> Block a -> Block a moveBlock offset (Block start end) = Block (start + offset) (end + offset)@@ -47,7 +59,7 @@ adjacent :: Block a -> Block a -> Bool adjacent b1 b2 = follows b1 b2 || follows b2 b1   where-    follows (Block _ e1) (Block s2 _) = e1 + 1 == s2+    follows (Block _ e1) (Block s2 _) = e1 == s2 || e1 + 1 == s2   --------------------------------------------------------------------------------

@@ -0,0 +1,145 @@+--------------------------------------------------------------------------------+-- | Utilities for assocgating comments with things in a list.+{-# LANGUAGE RecordWildCards     #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Language.Haskell.Stylish.Comments+    ( CommentGroup (..)+    , commentGroups+    , commentGroupHasComments+    , commentGroupSort+    ) where+++--------------------------------------------------------------------------------+import           Data.Function                  (on)+import           Data.List                      (sortBy, sortOn)+import           Data.Maybe                     (isNothing, maybeToList)+import qualified GHC.Hs                         as GHC+import qualified GHC.Types.SrcLoc               as GHC+import qualified GHC.Utils.Outputable           as GHC+++--------------------------------------------------------------------------------+import           Language.Haskell.Stylish.Block+import           Language.Haskell.Stylish.GHC+++--------------------------------------------------------------------------------+data CommentGroup a = CommentGroup+    { cgBlock     :: LineBlock+    , cgPrior     :: [GHC.LEpaComment]+    , cgItems     :: [(a, Maybe GHC.LEpaComment)]+    , cgFollowing :: [GHC.LEpaComment]+    }+++--------------------------------------------------------------------------------+instance GHC.Outputable a => Show (CommentGroup a) where+    show CommentGroup {..} = "(CommentGroup (" +++        show cgBlock ++ ") (" +++        showOutputable cgPrior ++ ") (" +++        showOutputable cgItems ++ ") (" +++        showOutputable cgFollowing ++ "))"+++--------------------------------------------------------------------------------+commentGroups+    :: forall a.+       (a -> Maybe GHC.RealSrcSpan)+    -> [a]+    -> [GHC.LEpaComment]+    -> [CommentGroup a]+commentGroups getSpan allItems allComments =+    work Nothing (sortOn fst allItemsWithLines) (sortOn fst commentsWithLines)+  where+    allItemsWithLines :: [(LineBlock, a)]+    allItemsWithLines = do+        item <- allItems+        s <- maybeToList $ getSpan item+        pure (realSrcSpanToLineBlock s, item)++    commentsWithLines :: [(LineBlock, GHC.LEpaComment)]+    commentsWithLines = do+        comment <- allComments+        let s = GHC.anchor $ GHC.getLoc comment+        pure (realSrcSpanToLineBlock s, comment)++    work+        :: Maybe (CommentGroup a)+        -> [(LineBlock, a)]+        -> [(LineBlock, GHC.LEpaComment)]+        -> [CommentGroup a]+    work mbCurrent items comments = case takeNext items comments of+        Nothing -> maybeToList mbCurrent+        Just (b, next, items', comments') ->+            let (flush, current) = case mbCurrent of+                    Just c  | adjacent (cgBlock c) b+                            , nextThingItem next+                            , following@(_ : _) <- cgFollowing c ->+                        ([c {cgFollowing = []}], CommentGroup b following [] [])+                    Just c  | adjacent (cgBlock c) b ->+                        ([], c {cgBlock = cgBlock c <> b})+                    _ -> (maybeToList mbCurrent, CommentGroup b [] [] [])+                current' = case next of+                    NextItem i -> current {cgItems = cgItems current <> [(i, Nothing)]}+                    NextComment c+                        | null (cgItems current) -> current {cgPrior = cgPrior current <> [c]}+                        | otherwise -> current {cgFollowing = cgFollowing current <> [c]}+                    NextItemWithComment i c ->+                        current {cgItems = cgItems current <> [(i, Just c)]} in+            flush ++ work (Just current') items' comments'++++--------------------------------------------------------------------------------+takeNext+    :: [(LineBlock, a)]+    -> [(LineBlock, GHC.LEpaComment)]+    -> Maybe (LineBlock, NextThing a, [(LineBlock, a)], [(LineBlock, GHC.LEpaComment)])+takeNext [] [] = Nothing+takeNext [] ((cb, c) : comments) =+    Just (cb, NextComment c, [], comments)+takeNext ((ib, i) : items) [] =+    Just (ib, NextItem i, items, [])+takeNext ((ib, i) : items) ((cb, c) : comments)+    | blockStart ib == blockStart cb =+        Just (ib <> cb, NextItemWithComment i c, items, comments)+    | blockStart ib < blockStart cb =+        Just (ib, NextItem i, items, (cb, c) : comments)+    | otherwise =+        Just (cb, NextComment c, (ib, i) : items, comments)+++--------------------------------------------------------------------------------+data NextThing a+    = NextComment GHC.LEpaComment+    | NextItem a+    | NextItemWithComment a GHC.LEpaComment+++--------------------------------------------------------------------------------+instance GHC.Outputable a => Show (NextThing a) where+    show (NextComment c) = "NextComment " ++ showOutputable c+    show (NextItem i) = "NextItem " ++ showOutputable i+    show (NextItemWithComment i c) =+        "NextItemWithComment " ++ showOutputable i ++ " " ++ showOutputable c+++--------------------------------------------------------------------------------+nextThingItem :: NextThing a -> Bool+nextThingItem (NextComment _)           = False+nextThingItem (NextItem _)              = True+nextThingItem (NextItemWithComment _ _) = True+++--------------------------------------------------------------------------------+commentGroupHasComments :: CommentGroup a -> Bool+commentGroupHasComments CommentGroup {..} = not $+    null cgPrior && all (isNothing . snd) cgItems && null cgFollowing+++--------------------------------------------------------------------------------+commentGroupSort :: (a -> a -> Ordering) -> CommentGroup a -> CommentGroup a+commentGroupSort cmp cg = cg+    { cgItems = sortBy (cmp `on` fst) (cgItems cg)+    }

@@ -260,17 +260,14 @@       maybe Data.NoMaxColumns Data.MaxColumns (configColumns c)  parseIndent :: A.Value -> A.Parser Data.Indent-parseIndent = A.withText "Indent" $ \t ->-  if t == "same_line"-     then return Data.SameLine-     else-         if "indent " `T.isPrefixOf` t-             then-                 case readMaybe (T.unpack $ T.drop 7 t) of-                     Just n -> return $ Data.Indent n-                     Nothing -> fail $ "Indent: not a number" <> T.unpack (T.drop 7 t)-             else fail $ "can't parse indent setting: " <> T.unpack t-+parseIndent = \case+    A.String "same_line" -> return Data.SameLine+    A.String t | "indent " `T.isPrefixOf` t ->+        case readMaybe (T.unpack $ T.drop 7 t) of+             Just n -> return $ Data.Indent n+             Nothing -> fail $ "Indent: not a number" <> T.unpack (T.drop 7 t)+    A.String t -> fail $ "can't parse indent setting: " <> T.unpack t+    _ -> fail "Expected string for indent value"  -------------------------------------------------------------------------------- parseSquash :: Config -> A.Object -> A.Parser Step

@@ -11,7 +11,6 @@ import qualified Distribution.PackageDescription          as Cabal import qualified Distribution.PackageDescription.Parsec   as Cabal import qualified Distribution.Simple.Utils                as Cabal-import qualified Distribution.Types.CondTree              as Cabal import qualified Distribution.Verbosity                   as Cabal import qualified Language.Haskell.Extension               as Language import           Language.Haskell.Stylish.Verbose

@@ -9,7 +9,9 @@ -- when this is evaluated, we take into account that 4th line will become the -- 3rd line before it needs changing. module Language.Haskell.Stylish.Editor-    ( Change+    ( module Language.Haskell.Stylish.Block++    , Change     , applyChanges      , change

@@ -1,4 +1,5 @@-{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE LambdaCase      #-}+{-# LANGUAGE RecordWildCards #-} {-# OPTIONS_GHC -Wno-missing-fields #-} -- | Utility functions for working with the GHC AST module Language.Haskell.Stylish.GHC@@ -11,35 +12,39 @@   , getStartLineUnsafe     -- * Standard settings   , baseDynFlags-    -- * Positions-  , unLocated     -- * Outputable operators   , showOutputable-  , compareOutputable-  ) where ----------------------------------------------------------------------------------import           Data.Function     (on)+    -- * Deconstruction+  , epAnnComments+  , deepAnnComments+  ) where  ---------------------------------------------------------------------------------import           DynFlags          (Settings (..), defaultDynFlags)-import qualified DynFlags          as GHC-import           FileSettings      (FileSettings (..))-import           GHC.Fingerprint   (fingerprint0)-import           GHC.Platform-import           GHC.Version       (cProjectVersion)-import           GhcNameVersion    (GhcNameVersion (..))-import qualified Outputable        as GHC-import           PlatformConstants (PlatformConstants (..))-import           SrcLoc            (GenLocated (..), Located, RealLocated,-                                    RealSrcSpan, SrcSpan (..), srcSpanEndLine,-                                    srcSpanStartLine)-import           ToolSettings      (ToolSettings (..))+import           Data.Generics                                       (Data,+                                                                      Typeable,+                                                                      everything,+                                                                      mkQ)+import           Data.List                                           (sortOn)+import qualified GHC.Driver.Ppr                                      as GHC (showPpr)+import           GHC.Driver.Session                                  (defaultDynFlags)+import qualified GHC.Driver.Session                                  as GHC+import qualified GHC.Hs                                              as GHC+import           GHC.Types.SrcLoc                                    (GenLocated (..),+                                                                      Located,+                                                                      RealLocated,+                                                                      RealSrcSpan,+                                                                      SrcSpan (..),+                                                                      srcSpanEndLine,+                                                                      srcSpanStartLine)+import qualified GHC.Types.SrcLoc                                    as GHC+import qualified GHC.Utils.Outputable                                as GHC+import qualified Language.Haskell.GhclibParserEx.GHC.Settings.Config as GHCEx  unsafeGetRealSrcSpan :: Located a -> RealSrcSpan unsafeGetRealSrcSpan = \case-  (L (RealSrcSpan s) _) -> s-  _                     -> error "could not get source code location"+  (L (RealSrcSpan s _) _) -> s+  _                       -> error "could not get source code location"  getStartLineUnsafe :: Located a -> Int getStartLineUnsafe = srcSpanStartLine . unsafeGetRealSrcSpan@@ -49,13 +54,13 @@  dropAfterLocated :: Maybe (Located a) -> [RealLocated b] -> [RealLocated b] dropAfterLocated loc xs = case loc of-  Just (L (RealSrcSpan rloc) _) ->+  Just (L (RealSrcSpan rloc _) _) ->     filter (\(L x _) -> srcSpanEndLine rloc >= srcSpanStartLine x) xs   _ -> xs  dropBeforeLocated :: Maybe (Located a) -> [RealLocated b] -> [RealLocated b] dropBeforeLocated loc xs = case loc of-  Just (L (RealSrcSpan rloc) _) ->+  Just (L (RealSrcSpan rloc _) _) ->     filter (\(L x _) -> srcSpanStartLine rloc <= srcSpanEndLine x) xs   _ -> xs @@ -63,41 +68,19 @@ dropBeforeAndAfter loc = dropBeforeLocated (Just loc) . dropAfterLocated (Just loc)  baseDynFlags :: GHC.DynFlags-baseDynFlags = defaultDynFlags fakeSettings llvmConfig-  where-    fakeSettings = GHC.Settings-      { sGhcNameVersion = GhcNameVersion "stylish-haskell" cProjectVersion-      , sFileSettings = FileSettings {}-      , sToolSettings = ToolSettings-        { toolSettings_opt_P_fingerprint = fingerprint0,-          toolSettings_pgm_F = ""-        }-      , sPlatformConstants = PlatformConstants-        { pc_DYNAMIC_BY_DEFAULT = False-        , pc_WORD_SIZE = 8-        }-      , sTargetPlatform = Platform-        { platformMini = PlatformMini-          { platformMini_arch = ArchUnknown-          , platformMini_os = OSUnknown-          }-        , platformWordSize = PW8-        , platformUnregisterised = True-        , platformHasIdentDirective = False-        , platformHasSubsectionsViaSymbols = False-        , platformIsCrossCompiling = False-        }-      , sPlatformMisc = PlatformMisc {}-      , sRawSettings = []-      }--    llvmConfig = GHC.LlvmConfig [] []--unLocated :: Located a -> a-unLocated (L _ a) = a+baseDynFlags = defaultDynFlags GHCEx.fakeSettings GHCEx.fakeLlvmConfig  showOutputable :: GHC.Outputable a => a -> String showOutputable = GHC.showPpr baseDynFlags -compareOutputable :: GHC.Outputable a => a -> a -> Ordering-compareOutputable = compare `on` showOutputable+epAnnComments :: GHC.EpAnn a -> [GHC.LEpaComment]+epAnnComments GHC.EpAnnNotUsed = []+epAnnComments GHC.EpAnn {..}   = priorAndFollowing comments++deepAnnComments :: (Data a, Typeable a) => a -> [GHC.LEpaComment]+deepAnnComments = everything (++) (mkQ [] priorAndFollowing)++priorAndFollowing :: GHC.EpAnnComments -> [GHC.LEpaComment]+priorAndFollowing = sortOn (GHC.anchor . GHC.getLoc) . \case+    GHC.EpaComments         {..} -> priorComments+    GHC.EpaCommentsBalanced {..} -> priorComments ++ followingComments

@@ -1,199 +1,89 @@-{-# LANGUAGE BlockArguments #-}-{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE BlockArguments             #-}+{-# LANGUAGE DerivingStrategies         #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ViewPatterns #-}-{-# LANGUAGE TupleSections #-}-{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE LambdaCase                 #-}+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE RecordWildCards            #-}+{-# LANGUAGE TupleSections              #-} module Language.Haskell.Stylish.Module   ( -- * Data types-    Module (..)-  , ModuleHeader-  , Import-  , Decls-  , Comments+    Module+  , Comments (..)   , Lines-  , makeModule      -- * Getters-  , moduleHeader-  , moduleImports   , moduleImportGroups-  , moduleDecls-  , moduleComments-  , moduleLanguagePragmas   , queryModule   , groupByLine      -- * Imports   , canMergeImport   , mergeModuleImport--    -- * Annotations-  , lookupAnnotation+  , importModuleName -    -- * Internal API getters-  , rawComments-  , rawImport-  , rawModuleAnnotations-  , rawModuleDecls-  , rawModuleExports-  , rawModuleHaddocks-  , rawModuleName+    -- * Pragmas+  , moduleLanguagePragmas   ) where ----------------------------------------------------------------------------------import           Data.Function                   ((&), on)-import           Data.Functor                    ((<&>))-import           Data.Generics                   (Typeable, everything, mkQ)-import           Data.Maybe                      (mapMaybe)-import           Data.Map                        (Map)-import qualified Data.Map                        as Map-import           Data.List                       (nubBy, sort)-import           Data.List.NonEmpty              (NonEmpty (..), nonEmpty)-import           Data.Text                       (Text)-import qualified Data.Text                       as T-import           Data.Data                       (Data)  ---------------------------------------------------------------------------------import qualified ApiAnnotation                   as GHC-import qualified Lexer                           as GHC-import           GHC.Hs                          (ImportDecl(..), ImportDeclQualifiedStyle(..))-import qualified GHC.Hs                          as GHC-import           GHC.Hs.Extension                (GhcPs)-import           GHC.Hs.Decls                    (LHsDecl)-import           Outputable                      (Outputable)-import           SrcLoc                          (GenLocated(..), RealLocated)-import           SrcLoc                          (RealSrcSpan(..), SrcSpan(..))-import           SrcLoc                          (Located)-import qualified SrcLoc                          as GHC-import qualified Module                          as GHC+import           Data.Char                    (toLower)+import           Data.Function                (on)+import           Data.Generics                (Typeable, everything, mkQ)+import qualified Data.List                    as L+import           Data.List.NonEmpty           (NonEmpty (..))+import           Data.Maybe                   (fromMaybe, mapMaybe)+import           GHC.Hs                       (ImportDecl (..),+                                               ImportDeclQualifiedStyle (..))+import qualified GHC.Hs                       as GHC+import           GHC.Hs.Extension             (GhcPs)+import           GHC.Types.SrcLoc             (GenLocated (..),+                                               RealSrcSpan (..), unLoc)+import qualified GHC.Types.SrcLoc             as GHC+import qualified GHC.Unit.Module.Name         as GHC + -------------------------------------------------------------------------------- import           Language.Haskell.Stylish.GHC + -------------------------------------------------------------------------------- type Lines = [String]   -------------------------------------------------------------------------------- -- | Concrete module type-data Module = Module-  { parsedComments :: [GHC.RealLocated GHC.AnnotationComment]-  , parsedAnnotations :: [(GHC.ApiAnnKey, [GHC.SrcSpan])]-  , parsedAnnotSrcs :: Map RealSrcSpan [GHC.AnnKeywordId]-  , parsedModule :: GHC.Located (GHC.HsModule GhcPs)-  } deriving (Data)---- | Declarations in module-newtype Decls = Decls [LHsDecl GhcPs]+type Module = GHC.Located GHC.HsModule --- | Import declaration in module-newtype Import = Import { unImport :: ImportDecl GhcPs }-  deriving newtype (Outputable)+importModuleName :: ImportDecl GhcPs -> String+importModuleName = GHC.moduleNameString . GHC.unLoc . GHC.ideclName  -- | Returns true if the two import declarations can be merged-canMergeImport :: Import -> Import -> Bool-canMergeImport (Import i0) (Import i1) = and $ fmap (\f -> f i0 i1)-  [ (==) `on` unLocated . ideclName+canMergeImport :: ImportDecl GhcPs -> ImportDecl GhcPs -> Bool+canMergeImport i0 i1 = and $ fmap (\f -> f i0 i1)+  [ (==) `on` unLoc . ideclName   , (==) `on` ideclPkgQual   , (==) `on` ideclSource   , hasMergableQualified `on` ideclQualified   , (==) `on` ideclImplicit-  , (==) `on` fmap unLocated . ideclAs+  , (==) `on` fmap unLoc . ideclAs   , (==) `on` fmap fst . ideclHiding -- same 'hiding' flags   ]   where     hasMergableQualified QualifiedPre QualifiedPost = True     hasMergableQualified QualifiedPost QualifiedPre = True-    hasMergableQualified q0 q1 = q0 == q1--instance Eq Import where-  i0 == i1 = canMergeImport i0 i1 && hasSameImports (unImport i0) (unImport i1)-    where-      hasSameImports = (==) `on` fmap snd . ideclHiding--instance Ord Import where-  compare (Import i0) (Import i1) =-    ideclName i0 `compareOutputable` ideclName i1 <>-    fmap showOutputable (ideclPkgQual i0) `compare`-        fmap showOutputable (ideclPkgQual i1) <>-    compareOutputable i0 i1+    hasMergableQualified q0 q1                      = q0 == q1  -- | Comments associated with module-newtype Comments = Comments [GHC.RealLocated GHC.AnnotationComment]---- | A module header is its name, exports and haddock docstring-data ModuleHeader = ModuleHeader-  { name :: Maybe (GHC.Located GHC.ModuleName)-  , exports :: Maybe (GHC.Located [GHC.LIE GhcPs])-  , haddocks :: Maybe GHC.LHsDocString-  }---- | Create a module from GHC internal representations-makeModule :: GHC.PState -> GHC.Located (GHC.HsModule GHC.GhcPs) -> Module-makeModule pstate = Module comments annotations annotationMap-  where-    comments-      = sort-      . filterRealLocated-      $ GHC.comment_q pstate ++ (GHC.annotations_comments pstate >>= snd)--    filterRealLocated = mapMaybe \case-      GHC.L (GHC.RealSrcSpan s) e -> Just (GHC.L s e)-      GHC.L (GHC.UnhelpfulSpan _) _ -> Nothing--    annotations-      = GHC.annotations pstate--    annotationMap-      = GHC.annotations pstate-      & mapMaybe x-      & Map.fromListWith (++)--    x = \case-      ((RealSrcSpan rspan, annot), _) -> Just (rspan, [annot])-      _ -> Nothing---- | Get all declarations in module-moduleDecls :: Module -> Decls-moduleDecls = Decls . GHC.hsmodDecls . unLocated . parsedModule---- | Get comments in module-moduleComments :: Module -> Comments-moduleComments = Comments . parsedComments---- | Get module language pragmas-moduleLanguagePragmas :: Module -> [(RealSrcSpan, NonEmpty Text)]-moduleLanguagePragmas = mapMaybe toLanguagePragma . parsedComments-  where-    toLanguagePragma :: RealLocated GHC.AnnotationComment -> Maybe (RealSrcSpan, NonEmpty Text)-    toLanguagePragma = \case-      L pos (GHC.AnnBlockComment s) ->-        Just (T.pack s)-          >>= T.stripPrefix "{-#"-          >>= T.stripSuffix "#-}"-          <&> T.strip-          <&> T.splitAt 8 -- length "LANGUAGE"-          <&> fmap (T.splitOn ",")-          <&> fmap (fmap T.strip)-          <&> fmap (filter (not . T.null))-          >>= (\(T.toUpper . T.strip -> lang, xs) -> (lang,) <$> nonEmpty xs)-          >>= (\(lang, nel) -> if lang == "LANGUAGE" then Just (pos, nel) else Nothing)-      _ -> Nothing---- | Get module imports-moduleImports :: Module -> [Located Import]-moduleImports m-  = parsedModule m-  & unLocated-  & GHC.hsmodImports-  & fmap \(L pos i) -> L pos (Import i)+newtype Comments = Comments [GHC.RealLocated GHC.EpaComment]  -- | Get groups of imports from module-moduleImportGroups :: Module -> [NonEmpty (Located Import)]-moduleImportGroups = groupByLine unsafeGetRealSrcSpan . moduleImports+moduleImportGroups :: Module -> [NonEmpty (GHC.LImportDecl GHC.GhcPs)]+moduleImportGroups =+    groupByLine (fromMaybe err . GHC.srcSpanToRealSrcSpan . GHC.getLocA) .+    GHC.hsmodImports . GHC.unLoc+  where+    err = error "moduleImportGroups: import without soure span"  -- The same logic as 'Language.Haskell.Stylish.Module.moduleImportGroups'. groupByLine :: (a -> RealSrcSpan) -> [a] -> [NonEmpty a]@@ -223,9 +113,11 @@ --   comment imports themselves. It _is_ however, systemic and it'd be better --   if we processed comments beforehand and attached them to all AST nodes in --   our own representation.-mergeModuleImport :: Located Import -> Located Import -> Located Import-mergeModuleImport (L p0 (Import i0)) (L _p1 (Import i1)) =-  L p0 $ Import i0 { ideclHiding = newImportNames }+mergeModuleImport+    :: GHC.LImportDecl GHC.GhcPs -> GHC.LImportDecl GHC.GhcPs+    -> GHC.LImportDecl GHC.GhcPs+mergeModuleImport (L p0 i0) (L _p1 i1) =+  L p0 $ i0 { ideclHiding = newImportNames }   where     newImportNames =       case (ideclHiding i0, ideclHiding i1) of@@ -234,50 +126,24 @@         (Just x, Nothing) -> Just x         (Nothing, Just x) -> Just x     merge xs ys-      = nubBy ((==) `on` showOutputable) (xs ++ ys)---- | Get module header-moduleHeader :: Module -> ModuleHeader-moduleHeader (Module _ _ _ (GHC.L _ m)) = ModuleHeader-  { name = GHC.hsmodName m-  , exports = GHC.hsmodExports m-  , haddocks = GHC.hsmodHaddockModHeader m-  }---- | Query for annotations associated with a 'SrcSpan'-lookupAnnotation :: SrcSpan -> Module -> [GHC.AnnKeywordId]-lookupAnnotation (RealSrcSpan rspan) m = Map.findWithDefault [] rspan (parsedAnnotSrcs m)-lookupAnnotation (UnhelpfulSpan _) _ = []+      = L.nubBy ((==) `on` showOutputable) (xs ++ ys)  -- | Query the module AST using @f@ queryModule :: Typeable a => (a -> [b]) -> Module -> [b]-queryModule f = everything (++) (mkQ [] f) . parsedModule------------------------------------------------------------------------------------- | Getter for internal components in imports newtype-rawImport :: Import -> ImportDecl GhcPs-rawImport (Import i) = i---- | Getter for internal module name representation-rawModuleName :: ModuleHeader -> Maybe (GHC.Located GHC.ModuleName)-rawModuleName = name---- | Getter for internal module exports representation-rawModuleExports :: ModuleHeader -> Maybe (GHC.Located [GHC.LIE GhcPs])-rawModuleExports = exports---- | Getter for internal module haddocks representation-rawModuleHaddocks :: ModuleHeader -> Maybe GHC.LHsDocString-rawModuleHaddocks = haddocks---- | Getter for internal module decls representation-rawModuleDecls :: Decls -> [LHsDecl GhcPs]-rawModuleDecls (Decls xs) = xs+queryModule f = everything (++) (mkQ [] f) --- | Getter for internal module comments representation-rawComments :: Comments -> [GHC.RealLocated GHC.AnnotationComment]-rawComments (Comments xs) = xs+moduleLanguagePragmas :: Module -> [(RealSrcSpan, NonEmpty String)]+moduleLanguagePragmas =+    mapMaybe prag . epAnnComments . GHC.hsmodAnn . GHC.unLoc+  where+    prag :: GHC.LEpaComment -> Maybe (GHC.RealSrcSpan, NonEmpty String)+    prag comment = case GHC.ac_tok (GHC.unLoc comment) of+        GHC.EpaBlockComment str+            | lang : p1 : ps <- tokenize str, map toLower lang == "language" ->+                pure (GHC.anchor (GHC.getLoc comment), p1 :| ps)+        _ -> Nothing --- | Getter for internal module annotation representation-rawModuleAnnotations :: Module -> [(GHC.ApiAnnKey, [GHC.SrcSpan])]-rawModuleAnnotations = parsedAnnotations+    tokenize = words .+        map (\c -> if c == ',' then ' ' else c) .+        takeWhile (/= '#') .+        drop 1 . dropWhile (/= '#')

@@ -4,23 +4,36 @@ -- utilities. {-# LANGUAGE LambdaCase #-} module Language.Haskell.Stylish.Ordering-    ( compareLIE+    ( compareImports+    , compareLIE     , compareWrappedName-    , unwrapName+    , compareOutputableCI     ) where   ---------------------------------------------------------------------------------import           Data.Char                    (isUpper)-import           Data.Ord                     (comparing)+import           Data.Char                       (isUpper, toLower)+import           Data.Function                   (on)+import           Data.Ord                        (comparing) import           GHC.Hs-import           RdrName                      (RdrName)-import           SrcLoc                       (unLoc)+import qualified GHC.Hs                          as GHC+import           GHC.Types.Name.Reader           (RdrName)+import           GHC.Types.SrcLoc                (unLoc)+import           GHC.Utils.Outputable            (Outputable)+import qualified GHC.Utils.Outputable            as GHC+import           Language.Haskell.Stylish.GHC    (showOutputable)   ---------------------------------------------------------------------------------import           Language.Haskell.Stylish.GHC (showOutputable)-import           Outputable                   (Outputable)+-- | Compare imports for sorting.  Cannot easily be a lawful instance due to+-- case insensitivity.+compareImports+    :: GHC.ImportDecl GHC.GhcPs -> GHC.ImportDecl GHC.GhcPs -> Ordering+compareImports i0 i1 =+    ideclName i0 `compareOutputableCI` ideclName i1 <>+    fmap showOutputable (ideclPkgQual i0) `compare`+        fmap showOutputable (ideclPkgQual i1) <>+    compareOutputableCI i0 i1   --------------------------------------------------------------------------------@@ -33,12 +46,12 @@     -- constructors first, followed by functions, and then operators.     ieKey :: IE GhcPs -> (Int, String)     ieKey = \case-        IEVar _ n             -> nameKey n-        IEThingAbs _ n        -> nameKey n-        IEThingAll _ n        -> nameKey n-        IEThingWith _ n _ _ _ -> nameKey n-        IEModuleContents _ n  -> nameKey n-        _                     -> (2, "")+        IEVar _ n            -> nameKey n+        IEThingAbs _ n       -> nameKey n+        IEThingAll _ n       -> nameKey n+        IEThingWith _ n _ _  -> nameKey n+        IEModuleContents _ n -> nameKey n+        _                    -> (2, "")   --------------------------------------------------------------------------------@@ -47,15 +60,13 @@   ---------------------------------------------------------------------------------unwrapName :: IEWrappedName n -> n-unwrapName (IEName n)    = unLoc n-unwrapName (IEPattern n) = unLoc n-unwrapName (IEType n)    = unLoc n----------------------------------------------------------------------------------- nameKey :: Outputable name => name -> (Int, String) nameKey n = case showOutputable n of     o@('(' : _)             -> (2, o)     o@(o0 : _) | isUpper o0 -> (0, o)     o                       -> (1, o)+++--------------------------------------------------------------------------------+compareOutputableCI :: GHC.Outputable a => a -> a -> Ordering+compareOutputableCI = compare `on` (map toLower . showOutputable)

@@ -1,4 +1,3 @@-{-# LANGUAGE LambdaCase #-} -------------------------------------------------------------------------------- module Language.Haskell.Stylish.Parse   ( parseModule@@ -6,35 +5,36 @@   ---------------------------------------------------------------------------------import           Data.Function                   ((&))-import           Data.Maybe                      (fromMaybe, listToMaybe)-import           System.IO.Unsafe                (unsafePerformIO)+import           Control.Monad                                      ((>=>))+import           Data.List                                          (foldl',+                                                                     stripPrefix)+import           Data.Maybe                                         (fromMaybe,+                                                                     listToMaybe,+                                                                     mapMaybe)+import           Data.Traversable                                   (for)+import qualified GHC.Data.StringBuffer                              as GHC+import           GHC.Driver.Ppr                                     as GHC+import qualified GHC.Driver.Session                                 as GHC+import qualified GHC.LanguageExtensions.Type                        as LangExt+import qualified GHC.Parser.Errors.Ppr                              as GHC+import qualified GHC.Parser.Header                                  as GHC+import qualified GHC.Parser.Lexer                                   as GHC+import qualified GHC.Types.SrcLoc                                   as GHC+import qualified GHC.Utils.Error                                    as GHC+import qualified GHC.Utils.Outputable                               as GHC+import qualified Language.Haskell.GhclibParserEx.GHC.Driver.Session as GHCEx+import qualified Language.Haskell.GhclibParserEx.GHC.Parser         as GHCEx ----------------------------------------------------------------------------------import           Bag                             (bagToList)-import qualified DynFlags                        as GHC-import qualified ErrUtils                        as GHC-import           FastString                      (mkFastString)-import qualified GHC.Hs                          as GHC-import qualified GHC.LanguageExtensions          as GHC-import qualified HeaderInfo                      as GHC-import qualified HscTypes                        as GHC-import           Lexer                           (ParseResult (..))-import           Lexer                           (mkPState, unP)-import qualified Lexer                           as GHC-import qualified Panic                           as GHC-import qualified Parser                          as GHC-import           SrcLoc                          (mkRealSrcLoc)-import qualified SrcLoc                          as GHC-import           StringBuffer                    (stringToStringBuffer)-import qualified StringBuffer                    as GHC  ---------------------------------------------------------------------------------import           Language.Haskell.Stylish.GHC    (baseDynFlags)+import           Language.Haskell.Stylish.GHC import           Language.Haskell.Stylish.Module ++-------------------------------------------------------------------------------- type Extensions = [String] + -------------------------------------------------------------------------------- -- | Filter out lines which use CPP macros unCpp :: String -> String@@ -46,6 +46,7 @@             nextMultiline = isCpp && not (null x) && last x == '\\'         in (if isCpp then "" else x) : go nextMultiline xs + -------------------------------------------------------------------------------- -- | If the given string is prefixed with an UTF-8 Byte Order Mark, drop it -- because haskell-src-exts can't handle it.@@ -57,67 +58,41 @@ -------------------------------------------------------------------------------- -- | Abstraction over GHC lib's parsing parseModule :: Extensions -> Maybe FilePath -> String -> Either String Module-parseModule exts fp string =-  parsePragmasIntoDynFlags baseDynFlags userExtensions filePath string >>= \dynFlags ->-    dropBom string-      & removeCpp dynFlags-      & runParser dynFlags-      & toModule dynFlags-  where-    toModule :: GHC.DynFlags -> GHC.ParseResult (GHC.Located (GHC.HsModule GHC.GhcPs)) -> Either String Module-    toModule dynFlags res = case res of-      POk ps m ->-        Right (makeModule ps m)-      PFailed failureState ->-        let-          withFileName x = maybe "" (<> ": ") fp <> x-        in-        Left . withFileName . unlines . getParserStateErrors dynFlags $ failureState--    removeCpp dynFlags s =-      if GHC.xopt GHC.Cpp dynFlags then unCpp s-      else s--    userExtensions =-      fmap toLocatedExtensionFlag ("Haskell2010" : exts) -- FIXME: do we need `Haskell2010` here?+parseModule externalExts0 fp string = do+    -- Parse extensions.+    externalExts1 <- for externalExts0 $ \s -> case GHCEx.readExtension s of+        Nothing -> Left $ "Unknown extension: " ++ show s+        Just e  -> Right e -    toLocatedExtensionFlag flag-      = "-X" <> flag-      & GHC.L GHC.noSrcSpan+    -- Build first dynflags.+    let dynFlags0 = foldl' turnOn baseDynFlags externalExts1 -    getParserStateErrors dynFlags state-      = GHC.getErrorMessages state dynFlags-      & bagToList-      & fmap (\errMsg -> show (GHC.errMsgSpan errMsg) <> ": " <> show errMsg)+    -- Parse options from file+    let fileOptions = fmap GHC.unLoc $ GHC.getOptions dynFlags0+            (GHC.stringToStringBuffer string)+            (fromMaybe "-" fp)+        fileExtensions = mapMaybe+            (stripPrefix "-X" >=> GHCEx.readExtension)+            fileOptions -    filePath =-      fromMaybe "<interactive>" fp+    -- Set further dynflags.+    let dynFlags1 = foldl' turnOn dynFlags0 fileExtensions+            `GHC.gopt_set` GHC.Opt_KeepRawTokenStream -    runParser :: GHC.DynFlags -> String -> GHC.ParseResult (GHC.Located (GHC.HsModule GHC.GhcPs))-    runParser flags str =-      let-        filename = mkFastString filePath-        parseState = mkPState flags (stringToStringBuffer str) (mkRealSrcLoc filename 1 1)-      in-        unP GHC.parseModule parseState+    -- Possibly strip CPP.+    let removeCpp s = if GHC.xopt LangExt.Cpp dynFlags1 then unCpp s else s+        input = removeCpp $ dropBom string --- | Parse 'DynFlags' from the extra options------   /Note:/ this function would be IO, but we're not using any of the internal---   features that constitute side effectful computation. So I think it's fine---   if we run this to avoid changing the interface too much.-parsePragmasIntoDynFlags ::-     GHC.DynFlags-  -> [GHC.Located String]-  -> FilePath-  -> String-  -> Either String GHC.DynFlags-{-# NOINLINE parsePragmasIntoDynFlags #-}-parsePragmasIntoDynFlags originalFlags extraOpts filepath str = unsafePerformIO $ catchErrors $ do-  let opts = GHC.getOptions originalFlags (GHC.stringToStringBuffer str) filepath-  (parsedFlags, _invalidFlags, _warnings) <- GHC.parseDynamicFilePragma originalFlags (opts <> extraOpts)-  -- FIXME: have a look at 'leftovers' since it should be empty-  return $ Right $ parsedFlags `GHC.gopt_set` GHC.Opt_KeepRawTokenStream+    -- Actual parse.+    case GHCEx.parseModule input dynFlags1 of+        GHC.POk _ m -> Right m+        GHC.PFailed ps -> Left . withFileName . GHC.showSDoc dynFlags1 .+            GHC.vcat . GHC.pprMsgEnvelopeBagWithLoc . fmap GHC.pprError . snd $+            GHC.getMessages ps   where-    catchErrors act = GHC.handleGhcException reportErr (GHC.handleSourceError reportErr act)-    reportErr e = return $ Left (show e)+    withFileName x = maybe "" (<> ": ") fp <> x++    turnOn dynFlags ext = foldl'+        turnOn+        (GHC.xopt_set dynFlags ext)+        [rhs | (lhs, True, rhs) <- GHC.impliedXFlags, lhs == ext]

@@ -1,10 +1,10 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE BlockArguments #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DerivingStrategies #-}-{-# LANGUAGE DoAndIfThenElse #-}+{-# LANGUAGE BlockArguments             #-}+{-# LANGUAGE DeriveGeneric              #-}+{-# LANGUAGE DerivingStrategies         #-}+{-# LANGUAGE DoAndIfThenElse            #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE LambdaCase                 #-}+{-# LANGUAGE RecordWildCards            #-} module Language.Haskell.Stylish.Printer   ( Printer(..)   , PrinterConfig(..)@@ -20,28 +20,19 @@     -- ** Combinators   , comma   , dot-  , getAnnot   , getCurrentLine   , getCurrentLineLength-  , getDocstrPrev   , newline   , parenthesize-  , peekNextCommentPos   , prefix   , putComment-  , putEolComment+  , putMaybeLineComment   , putOutputable-  , putAllSpanComments   , putCond   , putType   , putRdrName   , putText-  , removeCommentTo-  , removeCommentToEnd-  , removeLineComment   , sep-  , groupAttachedComments-  , groupWithoutComments   , space   , spaces   , suffix@@ -57,31 +48,26 @@ import           Prelude                         hiding (lines)  ---------------------------------------------------------------------------------import           ApiAnnotation                   (AnnKeywordId(..), AnnotationComment(..))-import           BasicTypes                      (PromotionFlag(..))-import           GHC.Hs.Extension                (GhcPs, NoExtField(..))-import           GHC.Hs.Types                    (HsType(..))-import           Module                          (ModuleName, moduleNameString)-import           RdrName                         (RdrName(..))-import           SrcLoc                          (GenLocated(..), RealLocated)-import           SrcLoc                          (Located, SrcSpan(..))-import           SrcLoc                          (srcSpanStartLine, srcSpanEndLine)-import           Outputable                      (Outputable)+import qualified GHC.Hs                          as GHC+import           GHC.Hs.Extension                (GhcPs)+import qualified GHC.Types.Basic                 as GHC+import           GHC.Types.Name.Reader           (RdrName (..))+import           GHC.Types.SrcLoc                (GenLocated (..))+import qualified GHC.Types.SrcLoc                as GHC+import qualified GHC.Unit.Module.Name            as GHC+import           GHC.Utils.Outputable            (Outputable)  -------------------------------------------------------------------------------- import           Control.Monad                   (forM_, replicateM_)-import           Control.Monad.Reader            (MonadReader, ReaderT(..), asks, local)-import           Control.Monad.State             (MonadState, State)-import           Control.Monad.State             (runState)-import           Control.Monad.State             (get, gets, modify, put)-import           Data.Foldable                   (find, toList)-import           Data.Functor                    ((<&>))-import           Data.List                       (delete, isPrefixOf)-import           Data.List.NonEmpty              (NonEmpty(..))+import           Control.Monad.Reader            (MonadReader, ReaderT (..),+                                                  asks, local)+import           Control.Monad.State             (MonadState, State, get, gets,+                                                  modify, put, runState)+import           Data.List                       (foldl')  ---------------------------------------------------------------------------------import           Language.Haskell.Stylish.Module (Module, Lines, lookupAnnotation)-import           Language.Haskell.Stylish.GHC    (showOutputable, unLocated)+import           Language.Haskell.Stylish.GHC    (showOutputable)+import           Language.Haskell.Stylish.Module (Lines)  -- | Shorthand for 'Printer' monad type P = Printer@@ -97,24 +83,22 @@  -- | State of printer data PrinterState = PrinterState-  { lines :: !Lines-  , linePos :: !Int+  { lines       :: !Lines+  , linePos     :: !Int   , currentLine :: !String-  , pendingComments :: ![RealLocated AnnotationComment]-  , parsedModule :: !Module   }  -- | Run printer to get printed lines out of module as well as return value of monad-runPrinter :: PrinterConfig -> [RealLocated AnnotationComment] -> Module -> Printer a -> (a, Lines)-runPrinter cfg comments m (Printer printer) =+runPrinter :: PrinterConfig -> Printer a -> (a, Lines)+runPrinter cfg (Printer printer) =   let-    (a, PrinterState parsedLines _ startedLine _ _) = runReaderT printer cfg `runState` PrinterState [] 0 "" comments m+    (a, PrinterState parsedLines _ startedLine) = runReaderT printer cfg `runState` PrinterState [] 0 ""   in     (a, parsedLines <> if startedLine == [] then [] else [startedLine])  -- | Run printer to get printed lines only-runPrinter_ :: PrinterConfig -> [RealLocated AnnotationComment] -> Module -> Printer a -> Lines-runPrinter_ cfg comments m printer = snd (runPrinter cfg comments m printer)+runPrinter_ :: PrinterConfig -> Printer a -> Lines+runPrinter_ cfg printer = snd (runPrinter cfg printer)  -- | Print text putText :: String -> P ()@@ -137,6 +121,7 @@  -- | Put all comments that has positions within 'SrcSpan' and separate by --   passed @P ()@+{- putAllSpanComments :: P () -> SrcSpan -> P () putAllSpanComments suff = \case   UnhelpfulSpan _ -> pure ()@@ -146,150 +131,143 @@       srcSpanEndLine rloc <= srcSpanEndLine rspan      forM_ cmts (\c -> putComment c >> suff)+-}  -- | Print any comment-putComment :: AnnotationComment -> P ()-putComment = \case-  AnnLineComment s -> putText s-  AnnDocCommentNext s -> putText s-  AnnDocCommentPrev s -> putText s-  AnnDocCommentNamed s -> putText s-  AnnDocSection _ s -> putText s-  AnnDocOptions s -> putText s-  AnnBlockComment s -> putText s+putComment :: GHC.EpaComment -> P ()+putComment epaComment = case GHC.ac_tok epaComment of+  GHC.EpaLineComment s     -> putText s+  GHC.EpaDocCommentNext s  -> putText s+  GHC.EpaDocCommentPrev s  -> putText s+  GHC.EpaDocCommentNamed s -> putText s+  GHC.EpaDocSection _ s    -> putText s+  GHC.EpaDocOptions s      -> putText s+  GHC.EpaBlockComment s    -> putText s+  GHC.EpaEofComment        -> pure () --- | Given the current start line of 'SrcSpan', remove and put EOL comment for same line-putEolComment :: SrcSpan -> P ()-putEolComment = \case-  RealSrcSpan rspan -> do-    cmt <- removeComment \case-      L rloc (AnnLineComment s) ->-        and-          [ srcSpanStartLine rspan == srcSpanStartLine rloc-          , not ("-- ^" `isPrefixOf` s)-          , not ("-- |" `isPrefixOf` s)-          ]-      _ -> False-    forM_ cmt (\c -> space >> putComment c)-  UnhelpfulSpan _ -> pure ()+putMaybeLineComment :: Maybe GHC.EpaComment -> P ()+putMaybeLineComment = \case+    Nothing  -> pure ()+    Just cmt -> space >> putComment cmt  -- | Print a 'RdrName'-putRdrName :: Located RdrName -> P ()-putRdrName (L pos n) = case n of-  Unqual name -> do-    annots <- getAnnot pos-    if AnnOpenP `elem` annots then do-      putText "("-      putText (showOutputable name)-      putText ")"-    else if AnnBackquote `elem` annots then do-      putText "`"+putRdrName :: GenLocated GHC.SrcSpanAnnN RdrName -> P ()+putRdrName rdrName = case GHC.unLoc rdrName of+    Unqual name -> do+      let (pre, post) = nameAnnAdornments $+            GHC.epAnnAnnsL $ GHC.ann $ GHC.getLoc rdrName+      putText pre       putText (showOutputable name)-      putText "`"-    else if AnnSimpleQuote `elem` annots then do-      putText "'"+      putText post+    Qual modulePrefix name ->+      putModuleName modulePrefix >> dot >> putText (showOutputable name)+    Orig _ name ->       putText (showOutputable name)-    else+    Exact name ->       putText (showOutputable name)-  Qual modulePrefix name ->-    putModuleName modulePrefix >> dot >> putText (showOutputable name)-  Orig _ name ->-    putText (showOutputable name)-  Exact name ->-    putText (showOutputable name) +nameAnnAdornments :: [GHC.NameAnn] -> (String, String)+nameAnnAdornments = foldl'+    (\(accl, accr) nameAnn ->+        let (l, r) = nameAnnAdornment nameAnn in (accl ++ l, r ++ accr))+    (mempty, mempty)++nameAnnAdornment :: GHC.NameAnn -> (String, String)+nameAnnAdornment = \case+    GHC.NameAnn {..}       -> fromAdornment nann_adornment+    GHC.NameAnnCommas {..} -> fromAdornment nann_adornment+    GHC.NameAnnOnly {..}   -> fromAdornment nann_adornment+    GHC.NameAnnRArrow {}   -> (mempty, mempty)+    GHC.NameAnnQuote {}    -> ("'", mempty)+    GHC.NameAnnTrailing {} -> (mempty, mempty)+  where+    fromAdornment GHC.NameParens     = ("(", ")")+    fromAdornment GHC.NameBackquotes = ("`", "`")+    fromAdornment GHC.NameParensHash = ("#(", "#)")+    fromAdornment GHC.NameSquare     = ("[", "]")+ -- | Print module name-putModuleName :: ModuleName -> P ()-putModuleName = putText . moduleNameString+putModuleName :: GHC.ModuleName -> P ()+putModuleName = putText . GHC.moduleNameString  -- | Print type-putType :: Located (HsType GhcPs) -> P ()-putType ltp = case unLocated ltp of-  HsFunTy NoExtField argTp funTp -> do+putType :: GHC.LHsType GhcPs -> P ()+putType ltp = case GHC.unLoc ltp of+  GHC.HsFunTy _ arrowTp argTp funTp -> do     putOutputable argTp     space-    putText "->"+    case arrowTp of+        GHC.HsUnrestrictedArrow {} -> putText "->"+        GHC.HsLinearArrow {}       -> putText "%1 ->"+        GHC.HsExplicitMult {}      -> putOutputable arrowTp     space     putType funTp-  HsAppTy NoExtField t1 t2 ->+  GHC.HsAppTy _ t1 t2 ->     putType t1 >> space >> putType t2-  HsExplicitListTy NoExtField _ xs -> do+  GHC.HsExplicitListTy _ _ xs -> do     putText "'["     sep       (comma >> space)       (fmap putType xs)     putText "]"-  HsExplicitTupleTy NoExtField xs -> do+  GHC.HsExplicitTupleTy _ xs -> do     putText "'("     sep       (comma >> space)       (fmap putType xs)     putText ")"-  HsOpTy NoExtField lhs op rhs -> do+  GHC.HsOpTy _ lhs op rhs -> do     putType lhs     space     putRdrName op     space     putType rhs-  HsTyVar NoExtField flag rdrName -> do+  GHC.HsTyVar _ flag rdrName -> do     case flag of-      IsPromoted  -> putText "'"-      NotPromoted -> pure ()+      GHC.IsPromoted  -> putText "'"+      GHC.NotPromoted -> pure ()     putRdrName rdrName-  HsTyLit _ tp ->+  GHC.HsTyLit _ tp ->     putOutputable tp-  HsParTy _ tp -> do+  GHC.HsParTy _ tp -> do     putText "("     putType tp     putText ")"-  HsTupleTy NoExtField _ xs -> do+  GHC.HsTupleTy _ _ xs -> do     putText "("     sep       (comma >> space)       (fmap putType xs)     putText ")"-  HsForAllTy NoExtField _ _ _ ->+  GHC.HsForAllTy {} ->     putOutputable ltp-  HsQualTy NoExtField _ _ ->+  GHC.HsQualTy {} ->     putOutputable ltp-  HsAppKindTy _ _ _ ->+  GHC.HsAppKindTy _ _ _ ->     putOutputable ltp-  HsListTy _ _ ->+  GHC.HsListTy _ _ ->     putOutputable ltp-  HsSumTy _ _ ->+  GHC.HsSumTy _ _ ->     putOutputable ltp-  HsIParamTy _ _ _ ->+  GHC.HsIParamTy _ _ _ ->     putOutputable ltp-  HsKindSig _ _ _ ->+  GHC.HsKindSig _ _ _ ->     putOutputable ltp-  HsStarTy _ _ ->+  GHC.HsStarTy _ _ ->     putOutputable ltp-  HsSpliceTy _ _ ->+  GHC.HsSpliceTy _ _ ->     putOutputable ltp-  HsDocTy _ _ _ ->+  GHC.HsDocTy _ _ _ ->     putOutputable ltp-  HsBangTy _ _ _ ->+  GHC.HsBangTy _ _ _ ->     putOutputable ltp-  HsRecTy _ _ ->+  GHC.HsRecTy _ _ ->     putOutputable ltp-  HsWildCardTy _ ->+  GHC.HsWildCardTy _ ->     putOutputable ltp-  XHsType _ ->+  GHC.XHsType _ ->     putOutputable ltp --- | Get a docstring on the start line of 'SrcSpan' that is a @-- ^@ comment-getDocstrPrev :: SrcSpan -> P (Maybe AnnotationComment)-getDocstrPrev = \case-  UnhelpfulSpan _ -> pure Nothing-  RealSrcSpan rspan -> do-    removeComment \case-      L rloc (AnnLineComment s) ->-        and-          [ srcSpanStartLine rspan == srcSpanStartLine rloc-          , "-- ^" `isPrefixOf` s-          ]-      _ -> False- -- | Print a newline newline :: P () newline = do@@ -318,7 +296,7 @@  -- | Add separator between each element of the given printers sep :: P a -> [P a] -> P ()-sep _ [] = pure ()+sep _ []             = pure () sep s (first : rest) = first >> forM_ rest ((>>) s)  -- | Prefix a printer with another one@@ -336,62 +314,6 @@     len <- length <$> getCurrentLine     spaces $ n - len --- | Gets comment on supplied 'line' and removes it from the state-removeLineComment :: Int -> P (Maybe AnnotationComment)-removeLineComment line =-  removeComment (\(L rloc _) -> srcSpanStartLine rloc == line)---- | Removes comments from the state up to start line of 'SrcSpan' and returns---   the ones that were removed-removeCommentTo :: SrcSpan -> P [AnnotationComment]-removeCommentTo = \case-  UnhelpfulSpan _ -> pure []-  RealSrcSpan rspan -> removeCommentTo' (srcSpanStartLine rspan)---- | Removes comments from the state up to end line of 'SrcSpan' and returns---   the ones that were removed-removeCommentToEnd :: SrcSpan -> P [AnnotationComment]-removeCommentToEnd = \case-  UnhelpfulSpan _ -> pure []-  RealSrcSpan rspan -> removeCommentTo' (srcSpanEndLine rspan)---- | Removes comments to the line number given and returns the ones removed-removeCommentTo' :: Int -> P [AnnotationComment]-removeCommentTo' line =-  removeComment (\(L rloc _) -> srcSpanStartLine rloc < line) >>= \case-    Nothing -> pure []-    Just c -> do-      rest <- removeCommentTo' line-      pure (c : rest)---- | Removes comments from the state while given predicate 'p' is true-removeComments :: (RealLocated AnnotationComment -> Bool) -> P [AnnotationComment]-removeComments p =-  removeComment p >>= \case-    Just c -> do-      rest <- removeComments p-      pure (c : rest)-    Nothing -> pure []---- | Remove a comment from the state given predicate 'p'-removeComment :: (RealLocated AnnotationComment -> Bool) -> P (Maybe AnnotationComment)-removeComment p = do-  comments <- gets pendingComments--  let-    foundComment =-      find p comments--    newPendingComments =-      maybe comments (`delete` comments) foundComment--  modify \s -> s { pendingComments = newPendingComments }-  pure $ fmap (\(L _ c) -> c) foundComment---- | Get all annotations for 'SrcSpan'-getAnnot :: SrcSpan -> P [AnnKeywordId]-getAnnot spn = gets (lookupAnnotation spn . parsedModule)- -- | Get current line getCurrentLine :: P String getCurrentLine = gets currentLine@@ -399,45 +321,6 @@ -- | Get current line length getCurrentLineLength :: P Int getCurrentLineLength = fmap length getCurrentLine---- | Peek at the next comment in the state-peekNextCommentPos :: P (Maybe SrcSpan)-peekNextCommentPos = do-  gets pendingComments <&> \case-    (L next _ : _) -> Just (RealSrcSpan next)-    [] -> Nothing---- | Get attached comments belonging to '[Located a]' given-groupAttachedComments :: [Located a] -> P [([AnnotationComment], NonEmpty (Located a))]-groupAttachedComments = go-  where-    go :: [Located a] -> P [([AnnotationComment], NonEmpty (Located a))]-    go (L rspan x : xs) = do-      comments <- removeCommentTo rspan-      nextGroupStartM <- peekNextCommentPos--      let-        sameGroupOf = maybe xs \nextGroupStart ->-          takeWhile (\(L p _)-> p < nextGroupStart) xs--        restOf = maybe [] \nextGroupStart ->-          dropWhile (\(L p _) -> p <= nextGroupStart) xs--      restGroups <- go (restOf nextGroupStartM)-      pure $ (comments, L rspan x :| sameGroupOf nextGroupStartM) : restGroups--    go _ = pure []---- | A view on 'groupAttachedComments': return 'Just' when there is just a---   one big group without any comments.-groupWithoutComments-    :: [([AnnotationComment], NonEmpty (Located a))]-    -> Maybe [Located a]-groupWithoutComments grouped-    | all (null . fst) grouped-    = Just $ concatMap (toList . snd) grouped-    | otherwise-    = Nothing  modifyCurrentLine :: (String -> String) -> P () modifyCurrentLine f = do

@@ -1,8 +1,11 @@-{-# LANGUAGE BlockArguments  #-}-{-# LANGUAGE DoAndIfThenElse #-}-{-# LANGUAGE LambdaCase      #-}-{-# LANGUAGE NamedFieldPuns  #-}-{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE BlockArguments   #-}+{-# LANGUAGE DataKinds        #-}+{-# LANGUAGE DoAndIfThenElse  #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE LambdaCase       #-}+{-# LANGUAGE MultiWayIf       #-}+{-# LANGUAGE NamedFieldPuns   #-}+{-# LANGUAGE RecordWildCards  #-} module Language.Haskell.Stylish.Step.Data   ( Config(..)   , defaultConfig@@ -12,45 +15,30 @@   , step   ) where ----------------------------------------------------------------------------------import           Prelude                          hiding (init)  ---------------------------------------------------------------------------------import           Control.Monad                    (forM_, unless, when)-import           Data.Function                    ((&))-import           Data.Functor                     ((<&>))-import           Data.List                        (sortBy)-import           Data.Maybe                       (listToMaybe)+import           Control.Monad                     (forM_, unless, when)+import           Data.List                         (sortBy)+import           Data.Maybe                        (listToMaybe, maybeToList)+import qualified GHC.Hs                            as GHC+import qualified GHC.Types.Fixity                  as GHC+import qualified GHC.Types.Name.Reader             as GHC+import qualified GHC.Types.SrcLoc                  as GHC+import           Prelude                           hiding (init) ----------------------------------------------------------------------------------import           ApiAnnotation                    (AnnotationComment)-import           BasicTypes                       (LexicalFixity (..))-import           GHC.Hs.Decls                     (ConDecl (..),-                                                   DerivStrategy (..),-                                                   HsDataDefn (..), HsDecl (..),-                                                   HsDerivingClause (..),-                                                   NewOrData (..),-                                                   TyClDecl (..))-import           GHC.Hs.Extension                 (GhcPs, NoExtField (..),-                                                   noExtCon)-import           GHC.Hs.Types                     (ConDeclField (..),-                                                   ForallVisFlag (..),-                                                   HsConDetails (..), HsContext,-                                                   HsImplicitBndrs (..),-                                                   HsTyVarBndr (..),-                                                   HsType (..), LHsQTyVars (..))-import           RdrName                          (RdrName)-import           SrcLoc                           (GenLocated (..), Located,-                                                   RealLocated)  ---------------------------------------------------------------------------------import           Language.Haskell.Stylish.Block import           Language.Haskell.Stylish.Editor+import           Language.Haskell.Stylish.Comments import           Language.Haskell.Stylish.GHC import           Language.Haskell.Stylish.Module+import           Language.Haskell.Stylish.Ordering import           Language.Haskell.Stylish.Printer import           Language.Haskell.Stylish.Step+import           Language.Haskell.Stylish.Util ++-------------------------------------------------------------------------------- data Indent     = SameLine     | Indent !Int@@ -102,208 +90,214 @@ step cfg = makeStep "Data" \ls m -> applyChanges (changes m) ls   where     changes :: Module -> [ChangeLine]-    changes m = fmap (formatDataDecl cfg m) (dataDecls m)+    changes m = formatDataDecl cfg <$> dataDecls m -    dataDecls :: Module -> [Located DataDecl]-    dataDecls = queryModule \case-      L pos (TyClD _ (DataDecl _ name tvars fixity defn)) -> pure . L pos $ MkDataDecl-        { dataDeclName = name-        , dataTypeVars = tvars-        , dataDefn = defn-        , dataFixity = fixity-        }-      _ -> []+    dataDecls :: Module -> [DataDecl]+    dataDecls m = do+        ldecl <- GHC.hsmodDecls $ GHC.unLoc m+        GHC.TyClD _ tycld <- pure $ GHC.unLoc ldecl+        loc <- maybeToList $ GHC.srcSpanToRealSrcSpan $ GHC.getLocA ldecl+        case tycld of+            GHC.DataDecl {..} -> pure $ MkDataDecl+                { dataComments = epAnnComments tcdDExt+                , dataLoc      = loc+                , dataDeclName = tcdLName+                , dataTypeVars = tcdTyVars+                , dataDefn     = tcdDataDefn+                , dataFixity   = tcdFixity+                }+            _ -> []  type ChangeLine = Change String -formatDataDecl :: Config -> Module -> Located DataDecl -> ChangeLine-formatDataDecl cfg@Config{..} m ldecl@(L declPos decl) =-  change originalDeclBlock (const printedDecl)-  where-    relevantComments :: [RealLocated AnnotationComment]-    relevantComments-      = moduleComments m-      & rawComments-      & dropBeforeAndAfter ldecl+data DataDecl = MkDataDecl+    { dataComments :: [GHC.LEpaComment]+    , dataLoc      :: GHC.RealSrcSpan+    , dataDeclName :: GHC.LocatedN GHC.RdrName+    , dataTypeVars :: GHC.LHsQTyVars GHC.GhcPs+    , dataDefn     :: GHC.HsDataDefn GHC.GhcPs+    , dataFixity   :: GHC.LexicalFixity+    } -    defn = dataDefn decl -    originalDeclBlock =-      Block (getStartLineUnsafe ldecl) (getEndLineUnsafe ldecl)+formatDataDecl :: Config -> DataDecl -> ChangeLine+formatDataDecl cfg@Config{..} decl@MkDataDecl {..} =+    change originalDeclBlock (const printedDecl)+  where+    originalDeclBlock = Block+        (GHC.srcSpanStartLine dataLoc)+        (GHC.srcSpanEndLine dataLoc)      printerConfig = PrinterConfig-      { columns = case cMaxColumns of-          NoMaxColumns -> Nothing-          MaxColumns n -> Just n-      }+        { columns = case cMaxColumns of+            NoMaxColumns -> Nothing+            MaxColumns n -> Just n+        } -    printedDecl = runPrinter_ printerConfig relevantComments m do-      putText (newOrData decl)-      space-      putName decl+    printedDecl = runPrinter_ printerConfig $ putDataDecl cfg decl -      when (isGADT decl) (space >> putText "where")+putDataDecl :: Config -> DataDecl -> P ()+putDataDecl cfg@Config {..} decl = do+    let defn = dataDefn decl+        constructorComments = commentGroups+            (GHC.srcSpanToRealSrcSpan . GHC.getLocA)+            (GHC.dd_cons defn)+            (dataComments decl) -      when (hasConstructors decl) do-        breakLineBeforeEq <- case (cEquals, cFirstField) of-          (_, Indent x) | isEnum decl && cBreakEnums -> do-            putEolComment declPos-            newline >> spaces x-            pure True-          (_, _) | not (isNewtype decl) && singleConstructor decl && not cBreakSingleConstructors ->-            False <$ space-          (Indent x, _)-            | isEnum decl && not cBreakEnums -> False <$ space-            | otherwise -> do-              putEolComment declPos-              newline >> spaces x-              pure True-          (SameLine, _) -> False <$ space+        onelineEnum =+            isEnum decl && not cBreakEnums &&+            all (not . commentGroupHasComments) constructorComments +    putText $ newOrData decl+    space+    putName decl++    when (isGADT decl) (space >> putText "where")++    when (hasConstructors decl) do+        case (cEquals, cFirstField) of+            (_, Indent x) | isEnum decl && cBreakEnums -> newline >> spaces x+            (_, _)+                | not (isNewtype decl)+                , singleConstructor decl && not cBreakSingleConstructors ->+                    space+            (Indent x, _)+                | onelineEnum -> space+                | otherwise -> newline >> spaces x+            (SameLine, _) -> space+         lineLengthAfterEq <- fmap (+2) getCurrentLineLength -        if isEnum decl && not cBreakEnums then-          putText "=" >> space >> putUnbrokenEnum cfg decl-        else if isNewtype decl then-          putText "=" >> space >> forM_ (dd_cons defn) (putNewtypeConstructor cfg)-        else-          case dd_cons defn of-            [] -> pure ()-            lcon@(L pos _) : consRest -> do-              when breakLineBeforeEq do-                removeCommentTo pos >>= mapM_ \c -> putComment c >> consIndent lineLengthAfterEq+        if  | onelineEnum ->+                putText "=" >> space >> putUnbrokenEnum cfg decl+            | isNewtype decl -> do+                putText "=" >> space+                forM_ (GHC.dd_cons defn) $ putNewtypeConstructor cfg+            | not . null $ GHC.dd_cons defn -> do+                forM_ (flagEnds constructorComments) $ \(CommentGroup {..}, firstGroup, lastGroup) -> do+                    forM_ cgPrior $ \lc -> do+                        putComment $ GHC.unLoc lc+                        consIndent lineLengthAfterEq -              unless-                (isGADT decl)-                (putText "=" >> space)+                    forM_ (flagEnds cgItems) $ \((lcon, mbInlineComment), firstItem, lastItem) -> do+                        unless (isGADT decl) $ do+                            putText $ if firstGroup && firstItem then "=" else "|"+                            space+                        putConstructor cfg lineLengthAfterEq lcon+                        putMaybeLineComment $ GHC.unLoc <$> mbInlineComment+                        unless (lastGroup && lastItem) $+                            consIndent lineLengthAfterEq -              putConstructor cfg lineLengthAfterEq lcon-              forM_ consRest \con@(L conPos _) -> do-                unless (cFirstField == SameLine) do-                  removeCommentTo conPos >>= mapM_ \c -> consIndent lineLengthAfterEq >> putComment c-                consIndent lineLengthAfterEq+                    forM_ cgFollowing $ \lc -> do+                        consIndent lineLengthAfterEq+                        putComment $ GHC.unLoc lc -                unless-                  (isGADT decl)-                  (putText "|" >> space)+            | otherwise ->+                pure () -                putConstructor cfg lineLengthAfterEq con-                putEolComment conPos+    let derivingComments = deepAnnComments (GHC.dd_derivs defn) -        when (hasDeriving decl) do-          if isEnum decl && not cBreakEnums then+    when (hasDeriving decl) do+        if onelineEnum && null derivingComments then             space-          else do-            removeCommentTo (defn & dd_derivs & \(L pos _) -> pos) >>=-              mapM_ \c -> newline >> spaces cDeriving >> putComment c+        else do+            forM_ derivingComments $ \lc -> do+                newline+                spaces cDeriving+                putComment $ GHC.unLoc lc             newline             spaces cDeriving -        sep (newline >> spaces cDeriving) $ defn & dd_derivs & \(L pos ds) -> ds <&> \d -> do-          putAllSpanComments (newline >> spaces cDeriving) pos-          putDeriving cfg d-+        sep (newline >> spaces cDeriving) $ map+            (putDeriving cfg)+            (GHC.dd_derivs defn)+  where     consIndent eqIndent = newline >> case (cEquals, cFirstField) of-      (SameLine, SameLine) -> spaces (eqIndent - 2)-      (SameLine, Indent y) -> spaces (eqIndent + y - 4)-      (Indent x, Indent _) -> spaces x-      (Indent x, SameLine) -> spaces x+        (SameLine, SameLine) -> spaces (eqIndent - 2)+        (SameLine, Indent y) -> spaces (eqIndent + y - 4)+        (Indent x, Indent _) -> spaces x+        (Indent x, SameLine) -> spaces x -data DataDecl = MkDataDecl-  { dataDeclName :: Located RdrName-  , dataTypeVars :: LHsQTyVars GhcPs-  , dataDefn     :: HsDataDefn GhcPs-  , dataFixity   :: LexicalFixity-  }+derivingClauseTypes+    :: GHC.HsDerivingClause GHC.GhcPs -> [GHC.LHsSigType GHC.GhcPs]+derivingClauseTypes GHC.HsDerivingClause {..} =+    case GHC.unLoc deriv_clause_tys of+        GHC.DctSingle _ t -> [t]+        GHC.DctMulti _ ts -> ts -putDeriving :: Config -> Located (HsDerivingClause GhcPs) -> P ()-putDeriving Config{..} (L pos clause) = do-  putText "deriving"+putDeriving :: Config -> GHC.LHsDerivingClause GHC.GhcPs -> P ()+putDeriving Config{..} lclause = do+    let clause@GHC.HsDerivingClause {..} = GHC.unLoc lclause+        tys = (if cSortDeriving then sortBy compareOutputableCI else id) $+            map (GHC.sig_body . GHC.unLoc) $+            derivingClauseTypes clause+        headTy = listToMaybe tys+        tailTy = drop 1 tys -  forM_ (deriv_clause_strategy clause) \case-    L _ StockStrategy    -> space >> putText "stock"-    L _ AnyclassStrategy -> space >> putText "anyclass"-    L _ NewtypeStrategy  -> space >> putText "newtype"-    L _ (ViaStrategy _)  -> pure ()+    putText "deriving" -  putCond-    withinColumns-    oneLinePrint-    multilinePrint+    forM_ deriv_clause_strategy $ \lstrat -> case GHC.unLoc lstrat of+        GHC.StockStrategy    {} -> space >> putText "stock"+        GHC.AnyclassStrategy {} -> space >> putText "anyclass"+        GHC.NewtypeStrategy  {} -> space >> putText "newtype"+        GHC.ViaStrategy      {} -> pure () -  forM_ (deriv_clause_strategy clause) \case-    L _ (ViaStrategy tp) -> do-      case cVia of-        SameLine -> space-        Indent x -> newline >> spaces (x + cDeriving)+    putCond+        withinColumns+        do+            space+            putText "("+            sep+                (comma >> space)+                (fmap putOutputable tys)+            putText ")"+        do+            newline+            spaces indentation+            putText "(" -      putText "via"-      space-      putType (getType tp)-    _ -> pure ()+            forM_ headTy \t ->+                space >> putOutputable t -  putEolComment pos+            forM_ tailTy \t -> do+                newline+                spaces indentation+                comma+                space+                putOutputable t -  where-    getType = \case-      HsIB _ tp          -> tp-      XHsImplicitBndrs x -> noExtCon x+            newline+            spaces indentation+            putText ")" +    forM_ deriv_clause_strategy $ \lstrat -> case GHC.unLoc lstrat of+        GHC.ViaStrategy tp -> do+            case cVia of+                SameLine -> space+                Indent x -> newline >> spaces (x + cDeriving)++            putText "via"+            space+            putType $ case tp of+                GHC.XViaStrategyPs _ ty -> GHC.sig_body $ GHC.unLoc ty+        _ -> pure ()++    -- putEolComment pos+  where     withinColumns PrinterState{currentLine} =       case cMaxColumns of         MaxColumns maxCols -> length currentLine <= maxCols         NoMaxColumns       -> True -    oneLinePrint = do-      space-      putText "("-      sep-        (comma >> space)-        (fmap putOutputable tys)-      putText ")"--    multilinePrint = do-      newline-      spaces indentation-      putText "("--      forM_ headTy \t ->-        space >> putOutputable t--      forM_ tailTy \t -> do-        newline-        spaces indentation-        comma-        space-        putOutputable t--      newline-      spaces indentation-      putText ")"-     indentation =       cDeriving + case cFirstField of         Indent x -> x         SameLine -> 0 -    tys-      = clause-      & deriv_clause_tys-      & unLocated-      & (if cSortDeriving then sortBy compareOutputable else id)-      & fmap hsib_body--    headTy =-      listToMaybe tys--    tailTy =-      drop 1 tys- putUnbrokenEnum :: Config -> DataDecl -> P ()-putUnbrokenEnum cfg decl =-  sep+putUnbrokenEnum cfg decl = sep     (space >> putText "|" >> space)-    (fmap (putConstructor cfg 0) . dd_cons . dataDefn $ decl)+    (fmap (putConstructor cfg 0) . GHC.dd_cons . dataDefn $ decl)  putName :: DataDecl -> P () putName decl@MkDataDecl{..} =@@ -312,42 +306,32 @@     putRdrName dataDeclName     space     forM_ secondTvar putOutputable+    maybePutKindSig   else do     putRdrName dataDeclName-    forM_ (hsq_explicit dataTypeVars) (\t -> space >> putOutputable t)+    forM_ (GHC.hsq_explicit dataTypeVars) (\t -> space >> putOutputable t)+    maybePutKindSig    where-    firstTvar :: Maybe (Located (HsTyVarBndr GhcPs))-    firstTvar-      = dataTypeVars-      & hsq_explicit-      & listToMaybe+    firstTvar :: Maybe (GHC.LHsTyVarBndr () GHC.GhcPs)+    firstTvar = listToMaybe $ GHC.hsq_explicit dataTypeVars -    secondTvar :: Maybe (Located (HsTyVarBndr GhcPs))-    secondTvar-      = dataTypeVars-      & hsq_explicit-      & drop 1-      & listToMaybe+    secondTvar :: Maybe (GHC.LHsTyVarBndr () GHC.GhcPs)+    secondTvar = listToMaybe . drop 1 $ GHC.hsq_explicit dataTypeVars -putConstructor :: Config -> Int -> Located (ConDecl GhcPs) -> P ()-putConstructor cfg consIndent (L _ cons) = case cons of-  ConDeclGADT{..} -> do-    -- Put argument to constructor first:-    case con_args of-      PrefixCon _ -> do-        sep-          (comma >> space)-          (fmap putRdrName con_names)+    maybePutKindSig :: Printer ()+    maybePutKindSig = forM_ maybeKindSig (\k -> space >> putText "::" >> space >> putOutputable k) -      InfixCon arg1 arg2 -> do-        putType arg1-        space-        forM_ con_names putRdrName-        space-        putType arg2-      RecCon _ ->-        error . mconcat $+    maybeKindSig :: Maybe (GHC.LHsKind GHC.GhcPs)+    maybeKindSig = GHC.dd_kindSig dataDefn++putConstructor :: Config -> Int -> GHC.LConDecl GHC.GhcPs -> P ()+putConstructor cfg consIndent lcons = case GHC.unLoc lcons of+  GHC.ConDeclGADT {..} -> do+    -- Put argument to constructor first:+    case con_g_args of+      GHC.PrefixConGADT _ -> sep (comma >> space) $ fmap putRdrName con_names+      GHC.RecConGADT _ -> error . mconcat $           [ "Language.Haskell.Stylish.Step.Data.putConstructor: "           , "encountered a GADT with record constructors, not supported yet"           ]@@ -357,27 +341,39 @@     putText "::"     space -    putForAll con_forall $ hsq_explicit con_qvars-    forM_ con_mb_cxt (putContext cfg . unLocated)+    putForAll+        (case GHC.unLoc con_bndrs of+            GHC.HsOuterImplicit {} -> False+            GHC.HsOuterExplicit {} -> True)+        (case GHC.unLoc con_bndrs of+            GHC.HsOuterImplicit {}   -> []+            GHC.HsOuterExplicit {..} -> hso_bndrs)+    forM_ con_mb_cxt $ putContext cfg+    case con_g_args of+        GHC.PrefixConGADT scaledTys -> forM_ scaledTys $ \scaledTy -> do+            putType $ GHC.hsScaledThing scaledTy+            space >> putText "->" >> space+        GHC.RecConGADT _ -> error . mconcat $+            [ "Language.Haskell.Stylish.Step.Data.putConstructor: "+            , "encountered a GADT with record constructors, not supported yet"+            ]     putType con_res_ty -  XConDecl x ->-    noExtCon x-  ConDeclH98{..} -> do+  GHC.ConDeclH98 {..} -> do     putForAll con_forall con_ex_tvs-    forM_ con_mb_cxt (putContext cfg . unLocated)+    forM_ con_mb_cxt $ putContext cfg     case con_args of-      InfixCon arg1 arg2 -> do-        putType arg1+      GHC.InfixCon arg1 arg2 -> do+        putType $ GHC.hsScaledThing arg1         space         putRdrName con_name         space-        putType arg2-      PrefixCon xs -> do+        putType $ GHC.hsScaledThing arg2+      GHC.PrefixCon _tyargs args -> do         putRdrName con_name-        unless (null xs) space-        sep space (fmap putOutputable xs)-      RecCon (L recPos (L posFirst firstArg : args)) -> do+        unless (null args) space+        sep space (fmap putOutputable args)+      GHC.RecCon largs | _ : _ <- GHC.unLoc largs -> do         putRdrName con_name         skipToBrace         bracePos <- getCurrentLineLength@@ -385,32 +381,42 @@         let fieldPos = bracePos + 2         space +        let commented = commentGroups+                (GHC.srcSpanToRealSrcSpan . GHC.getLocA)+                (GHC.unLoc largs)+                (epAnnComments . GHC.ann $ GHC.getLoc largs)++        forM_ (flagEnds commented) $ \(CommentGroup {..}, firstCommentGroup, _) -> do+         -- Unless everything's configured to be on the same line, put pending         -- comments-        unless (cFirstField cfg == SameLine) do-          removeCommentTo posFirst >>= mapM_ \c -> putComment c >> sepDecl bracePos--        -- Put first decl field-        pad fieldPos >> putConDeclField cfg firstArg-        unless (cFirstField cfg == SameLine) (putEolComment posFirst)+          forM_ cgPrior $ \lc -> do+            pad fieldPos+            putComment $ GHC.unLoc lc+            sepDecl bracePos -        -- Put tail decl fields-        forM_ args \(L pos arg) -> do-          sepDecl bracePos-          removeCommentTo pos >>= mapM_ \c ->-            spaces (cFieldComment cfg) >> putComment c >> sepDecl bracePos-          comma-          space-          putConDeclField cfg arg-          putEolComment pos+          forM_ (flagEnds cgItems) $ \((item, mbInlineComment), firstItem, _) -> do+            if firstCommentGroup && firstItem+                then pad fieldPos+                else do+                    comma+                    space+            putConDeclField cfg $ GHC.unLoc item+            case mbInlineComment of+                Just c -> do+                    sepDecl bracePos >> spaces (cFieldComment cfg)+                    putComment $ GHC.unLoc c+                _ -> pure ()+            sepDecl bracePos -        -- Print docstr after final field-        removeCommentToEnd recPos >>= mapM_ \c ->-          sepDecl bracePos >> spaces (cFieldComment cfg) >> putComment c+          forM_ cgFollowing $ \lc -> do+            spaces $ cFieldComment cfg+            putComment $ GHC.unLoc lc+            sepDecl bracePos          -- Print whitespace to closing brace-        sepDecl bracePos >> putText "}"-      RecCon (L _ []) -> do+        putText "}"+      GHC.RecCon _ -> do         skipToBrace >> putText "{"         skipToBrace >> putText "}" @@ -426,126 +432,124 @@       -- Jump to the next declaration.       sepDecl bracePos = newline >> spaces case (cEquals cfg, cFirstField cfg) of         (_, Indent y) | not (cBreakSingleConstructors cfg) -> y-        (SameLine, SameLine) -> bracePos-        (Indent x, Indent y) -> x + y + 2-        (SameLine, Indent y) -> bracePos + y - 2-        (Indent x, SameLine) -> bracePos + x - 2+        (SameLine, SameLine)                               -> bracePos+        (Indent x, Indent y)                               -> x + y + 2+        (SameLine, Indent y)                               -> bracePos + y - 2+        (Indent x, SameLine)                               -> bracePos + x - 2 -putNewtypeConstructor :: Config -> Located (ConDecl GhcPs) -> P ()-putNewtypeConstructor cfg (L _ cons) = case cons of-  ConDeclH98{..} ->+putNewtypeConstructor :: Config -> GHC.LConDecl GHC.GhcPs -> P ()+putNewtypeConstructor cfg lcons = case GHC.unLoc lcons of+  GHC.ConDeclH98{..} ->     putRdrName con_name >> case con_args of-      PrefixCon xs -> do-        unless (null xs) space-        sep space (fmap putOutputable xs)-      RecCon (L _ [L _posFirst firstArg]) -> do+      GHC.PrefixCon _ args -> do+        unless (null args) space+        sep space (fmap putOutputable args)+      GHC.RecCon largs | [firstArg] <- GHC.unLoc largs -> do         space         putText "{"         space-        putConDeclField cfg firstArg+        putConDeclField cfg $ GHC.unLoc firstArg         space         putText "}"-      RecCon (L _ _args) ->+      GHC.RecCon {} ->         error . mconcat $           [ "Language.Haskell.Stylish.Step.Data.putNewtypeConstructor: "           , "encountered newtype with several arguments"           ]-      InfixCon {} ->+      GHC.InfixCon {} ->         error . mconcat $           [ "Language.Haskell.Stylish.Step.Data.putNewtypeConstructor: "           , "infix newtype constructor"           ]-  XConDecl x ->-    noExtCon x-  ConDeclGADT{} ->+  GHC.ConDeclGADT{} ->     error . mconcat $       [ "Language.Haskell.Stylish.Step.Data.putNewtypeConstructor: "       , "GADT encountered in newtype"       ] -putForAll :: Located Bool -> [Located (HsTyVarBndr GhcPs)] -> P ()-putForAll forall ex_tvs =-  when (unLocated forall) do+putForAll+    :: GHC.OutputableBndrFlag s 'GHC.Parsed+    => Bool -> [GHC.LHsTyVarBndr s GHC.GhcPs] -> P ()+putForAll forall ex_tvs = when forall do     putText "forall"     space-    sep space (fmap putOutputable ex_tvs)+    sep space $ putOutputable . GHC.unLoc <$> ex_tvs     dot     space -putContext :: Config -> HsContext GhcPs -> P ()-putContext Config{..} = suffix (space >> putText "=>" >> space) . \case-  [L _ (HsParTy _ tp)] | cCurriedContext ->-    putType tp-  [ctx] ->-    putType ctx-  ctxs | cCurriedContext ->-    sep (space >> putText "=>" >> space) (fmap putType ctxs)-  ctxs ->-    parenthesize $ sep (comma >> space) (fmap putType ctxs)+putContext :: Config -> GHC.LHsContext GHC.GhcPs -> P ()+putContext Config{..} lctx = suffix (space >> putText "=>" >> space) $+    case ltys of+        [lty] | GHC.HsParTy _ tp <- GHC.unLoc lty, cCurriedContext ->+          putType tp+        [ctx] ->+          putType ctx+        ctxs | cCurriedContext ->+          sep (space >> putText "=>" >> space) (fmap putType ctxs)+        ctxs ->+          parenthesize $ sep (comma >> space) (fmap putType ctxs)+  where+    ltys = GHC.unLoc lctx :: [GHC.LHsType GHC.GhcPs] -putConDeclField :: Config -> ConDeclField GhcPs -> P ()-putConDeclField cfg = \case-  ConDeclField{..} -> do+putConDeclField :: Config -> GHC.ConDeclField GHC.GhcPs -> P ()+putConDeclField cfg GHC.ConDeclField {..} = do     sep-      (comma >> space)-      (fmap putOutputable cd_fld_names)+        (comma >> space)+        (fmap putOutputable cd_fld_names)     space     putText "::"     space     putType' cfg cd_fld_type-  XConDeclField{} ->-    error . mconcat $-      [ "Language.Haskell.Stylish.Step.Data.putConDeclField: "-      , "XConDeclField encountered"-      ]  -- | A variant of 'putType' that takes 'cCurriedContext' into account-putType' :: Config -> Located (HsType GhcPs) -> P ()-putType' cfg = \case-  L _ (HsForAllTy NoExtField vis bndrs tp) -> do-    putText "forall"-    space-    sep space (fmap putOutputable bndrs)-    putText-      if vis == ForallVis then "->"-      else "."-    space-    putType' cfg tp-  L _ (HsQualTy NoExtField ctx tp) -> do-    putContext cfg (unLocated ctx)-    putType' cfg tp-  other -> putType other+putType' :: Config -> GHC.LHsType GHC.GhcPs -> P ()+putType' cfg lty = case GHC.unLoc lty of+    GHC.HsForAllTy GHC.NoExtField tele tp -> do+        putText "forall"+        space+        sep space $ case tele of+            GHC.HsForAllVis   {..} -> putOutputable . GHC.unLoc <$> hsf_vis_bndrs+            GHC.HsForAllInvis {..} -> putOutputable . GHC.unLoc <$> hsf_invis_bndrs+        case tele of+            GHC.HsForAllVis   {} -> space >> putText "->"+            GHC.HsForAllInvis {} -> putText "."+        space+        putType' cfg tp+    GHC.HsQualTy GHC.NoExtField ctx tp -> do+        forM_ ctx $ putContext cfg+        putType' cfg tp+    _ -> putType lty  newOrData :: DataDecl -> String newOrData decl = if isNewtype decl then "newtype" else "data"  isGADT :: DataDecl -> Bool-isGADT = any isGADTCons . dd_cons . dataDefn+isGADT = any isGADTCons . GHC.dd_cons . dataDefn   where-    isGADTCons = \case-      L _ (ConDeclGADT {}) -> True-      _                    -> False+    isGADTCons c = case GHC.unLoc c of+      GHC.ConDeclGADT {} -> True+      _                  -> False  isNewtype :: DataDecl -> Bool-isNewtype = (== NewType) . dd_ND . dataDefn+isNewtype = (== GHC.NewType) . GHC.dd_ND . dataDefn  isInfix :: DataDecl -> Bool-isInfix = (== Infix) . dataFixity+isInfix = (== GHC.Infix) . dataFixity  isEnum :: DataDecl -> Bool-isEnum = all isUnary . dd_cons . dataDefn+isEnum = all isUnary . GHC.dd_cons . dataDefn   where-    isUnary = \case-      L _ (ConDeclH98 {..}) -> case con_args of-        PrefixCon [] -> True-        _            -> False+    isUnary c = case GHC.unLoc c of+      GHC.ConDeclH98 {..} -> case con_args of+        GHC.PrefixCon tyargs args -> null tyargs && null args+        _                         -> False       _ -> False  hasConstructors :: DataDecl -> Bool-hasConstructors = not . null . dd_cons . dataDefn+hasConstructors = not . null . GHC.dd_cons . dataDefn  singleConstructor :: DataDecl -> Bool-singleConstructor = (== 1) . length . dd_cons . dataDefn+singleConstructor = (== 1) . length . GHC.dd_cons . dataDefn  hasDeriving :: DataDecl -> Bool-hasDeriving = not . null . unLocated . dd_derivs . dataDefn+hasDeriving = not . null . GHC.dd_derivs . dataDefn

@@ -17,51 +17,45 @@  -------------------------------------------------------------------------------- import           Control.Monad                   (forM_, when, void)+import           Data.Foldable                   (toList) import           Data.Function                   ((&), on) import           Data.Functor                    (($>))-import           Data.Foldable                   (toList)-import           Data.Maybe                      (isJust)-import           Data.List                       (sortBy) import           Data.List.NonEmpty              (NonEmpty(..))+import           Data.List                       (sortBy)+import           Data.Maybe                      (fromMaybe, isJust) import qualified Data.List.NonEmpty              as NonEmpty import qualified Data.Map                        as Map import qualified Data.Set                        as Set------------------------------------------------------------------------------------import           BasicTypes                      (StringLiteral (..),-                                                  SourceText (..))-import qualified FastString                      as FS-import           GHC.Hs.Extension                (GhcPs)-import qualified GHC.Hs.Extension                as GHC-import           GHC.Hs.ImpExp-import           Module                          (moduleNameString)-import           RdrName                         (RdrName)-import           SrcLoc                          (Located, GenLocated(..), unLoc)+import qualified GHC.Data.FastString             as GHC+import qualified GHC.Hs                          as GHC+import qualified GHC.Types.Name.Reader           as GHC+import qualified GHC.Types.SourceText            as GHC+import qualified GHC.Types.SrcLoc                as GHC+import qualified GHC.Unit.Module.Name            as GHC+import qualified GHC.Unit.Types                  as GHC   -------------------------------------------------------------------------------- import           Language.Haskell.Stylish.Block+import           Language.Haskell.Stylish.Editor import           Language.Haskell.Stylish.Module import           Language.Haskell.Stylish.Ordering import           Language.Haskell.Stylish.Printer import           Language.Haskell.Stylish.Step-import           Language.Haskell.Stylish.Editor-import           Language.Haskell.Stylish.GHC import           Language.Haskell.Stylish.Util   -------------------------------------------------------------------------------- data Options = Options-    { importAlign     :: ImportAlign-    , listAlign       :: ListAlign-    , padModuleNames  :: Bool-    , longListAlign   :: LongListAlign-    , emptyListAlign  :: EmptyListAlign-    , listPadding     :: ListPadding-    , separateLists   :: Bool-    , spaceSurround   :: Bool-    , postQualified   :: Bool+    { importAlign    :: ImportAlign+    , listAlign      :: ListAlign+    , padModuleNames :: Bool+    , longListAlign  :: LongListAlign+    , emptyListAlign :: EmptyListAlign+    , listPadding    :: ListPadding+    , separateLists  :: Bool+    , spaceSurround  :: Bool+    , postQualified  :: Bool     } deriving (Eq, Show)  defaultOptions :: Options@@ -120,38 +114,40 @@ printImports maxCols align ls m = applyChanges changes ls   where     groups = moduleImportGroups m-    moduleStats = foldMap importStats . fmap unLoc $ concatMap toList groups+    moduleStats = foldMap importStats . fmap GHC.unLoc $ concatMap toList groups     changes = do         group <- groups-        pure $ formatGroup maxCols align m moduleStats group+        pure $ formatGroup maxCols align moduleStats group  formatGroup-    :: Maybe Int -> Options -> Module -> ImportStats-    -> NonEmpty (Located Import) -> Change String-formatGroup maxCols options m moduleStats imports =-    let newLines = formatImports maxCols options m moduleStats imports in+    :: Maybe Int -> Options -> ImportStats+    -> NonEmpty (GHC.LImportDecl GHC.GhcPs) -> Change String+formatGroup maxCols options moduleStats imports =+    let newLines = formatImports maxCols options moduleStats imports in     change (importBlock imports) (const newLines) -importBlock :: NonEmpty (Located a) -> Block String+importBlock :: NonEmpty (GHC.LImportDecl GHC.GhcPs)  -> Block String importBlock group = Block-    (getStartLineUnsafe $ NonEmpty.head group)-    (getEndLineUnsafe   $ NonEmpty.last group)+    (GHC.srcSpanStartLine . src $ NonEmpty.head group)+    (GHC.srcSpanEndLine   . src $ NonEmpty.last group)+  where+    src = fromMaybe (error "importBlock: missing location") .+        GHC.srcSpanToRealSrcSpan . GHC.getLocA  formatImports     :: Maybe Int    -- ^ Max columns.     -> Options      -- ^ Options.-    -> Module       -- ^ Module.     -> ImportStats  -- ^ Module stats.-    -> NonEmpty (Located Import) -> Lines-formatImports maxCols options m moduleStats rawGroup =-  runPrinter_ (PrinterConfig maxCols) [] m do+    -> NonEmpty (GHC.LImportDecl GHC.GhcPs) -> Lines+formatImports maxCols options moduleStats rawGroup =+  runPrinter_ (PrinterConfig maxCols) do   let-+    group :: NonEmpty (GHC.LImportDecl GHC.GhcPs)     group-      = NonEmpty.sortWith unLocated rawGroup+      = NonEmpty.sortBy (compareImports `on` GHC.unLoc) rawGroup       & mergeImports -    unLocatedGroup = fmap unLocated $ toList group+    unLocatedGroup = fmap GHC.unLoc $ toList group      align' = importAlign options     padModuleNames' = padModuleNames options@@ -165,151 +161,160 @@    forM_ group \imp -> printQualified options padNames stats imp >> newline + ---------------------------------------------------------------------------------printQualified :: Options -> Bool -> ImportStats -> Located Import -> P ()-printQualified Options{..} padNames stats (L _ decl) = do-  let decl' = rawImport decl+printQualified+    :: Options -> Bool -> ImportStats -> GHC.LImportDecl GHC.GhcPs -> P ()+printQualified Options{..} padNames stats ldecl = do+    putText "import" >> space -  putText "import" >> space+    case (isSource decl, isAnySource stats) of+      (True, _) -> putText "{-# SOURCE #-}" >> space+      (_, True) -> putText "              " >> space+      _         -> pure () -  case (isSource decl, isAnySource stats) of-    (True, _) -> putText "{-# SOURCE #-}" >> space-    (_, True) -> putText "              " >> space-    _         -> pure ()+    when (GHC.ideclSafe decl) (putText "safe" >> space) -  when (isSafe decl) (putText "safe" >> space)+    let module_ = do+            moduleNamePosition <- length <$> getCurrentLine+            forM_ (GHC.ideclPkgQual decl) $ \pkg ->+                putText (stringLiteral pkg) >> space+            putText (importModuleName decl) -  let-    module_ = do-      moduleNamePosition <- length <$> getCurrentLine-      forM_ (ideclPkgQual decl') $ \pkg -> putText (stringLiteral pkg) >> space-      putText (moduleName decl)-      -- Only print spaces if something follows.-      when padNames $-        when (isJust (ideclAs decl') || isHiding decl ||-                not (null $ ideclHiding decl')) $-          putText $-            replicate (isLongestImport stats - importModuleNameLength decl) ' '-      pure moduleNamePosition+            -- Only print spaces if something follows.+            let somethingFollows =+                    isJust (GHC.ideclAs decl) || isHiding decl ||+                    not (null $ GHC.ideclHiding decl)+            when (padNames && somethingFollows) $ putText $ replicate+                (isLongestImport stats - importModuleNameLength decl)+                ' '+            pure moduleNamePosition -  moduleNamePosition <--    case (postQualified, isQualified decl, isAnyQualified stats) of-      (False, True , _   ) -> putText "qualified" *> space *> module_-      (False, _    , True) -> putText "         " *> space *> module_-      (True , True , _   ) -> module_ <* space <* putText "qualified"-      _                    -> module_+    moduleNamePosition <-+        case (postQualified, isQualified decl, isAnyQualified stats) of+            (False, True , _   ) -> putText "qualified" *> space *> module_+            (False, _    , True) -> putText "         " *> space *> module_+            (True , True , _   ) -> module_ <* space <* putText "qualified"+            _                    -> module_ -  beforeAliasPosition <- length <$> getCurrentLine+    beforeAliasPosition <- length <$> getCurrentLine+    forM_ (GHC.ideclAs decl) $ \lname -> do+        space >> putText "as" >> space+        putText . GHC.moduleNameString $ GHC.unLoc lname -  forM_ (ideclAs decl') \(L _ name) -> do-    space >> putText "as" >> space >> putText (moduleNameString name)+    afterAliasPosition <- length <$> getCurrentLine -  afterAliasPosition <- length <$> getCurrentLine+    when (isHiding decl) (space >> putText "hiding") -  when (isHiding decl) (space >> putText "hiding")+    let putOffset = putText $ replicate offset ' '+        offset = case listPadding of+            LPConstant n -> n+            LPModuleName -> moduleNamePosition -  let putOffset = putText $ replicate offset ' '-      offset = case listPadding of-        LPConstant n -> n-        LPModuleName -> moduleNamePosition+    pure () -  case snd <$> ideclHiding decl' of-    Nothing            -> pure ()-    Just (L _ [])      -> case emptyListAlign of-      RightAfter -> modifyCurrentLine trimRight >> space >> putText "()"-      Inherit -> case listAlign of-        NewLine ->-          modifyCurrentLine trimRight >> newline >> putOffset >> putText "()"-        _ -> space >> putText "()"-    Just (L _ imports) -> do-      let printedImports = flagEnds $ -- [P ()]-            fmap ((printImport separateLists) . unLocated)-            (prepareImportList imports)+    case snd <$> GHC.ideclHiding decl of+        Nothing -> pure ()+        Just limports | null (GHC.unLoc limports) -> case emptyListAlign of+            RightAfter -> modifyCurrentLine trimRight >> space >> putText "()"+            Inherit -> case listAlign of+                NewLine -> do+                    modifyCurrentLine trimRight+                    newline >> putOffset >> putText "()"+                _ -> space >> putText "()" -      -- Since we might need to output the import module name several times, we-      -- need to save it to a variable:-      wrapPrefix <- case listAlign of-        AfterAlias -> pure $ replicate (afterAliasPosition + 1) ' '-        WithAlias -> pure $ replicate (beforeAliasPosition + 1) ' '-        Repeat -> fmap (++ " (") getCurrentLine-        WithModuleName -> pure $ replicate (moduleNamePosition + offset) ' '-        NewLine -> pure $ replicate offset ' '+        Just limports -> do+            let imports = GHC.unLoc limports+                printedImports = flagEnds $ -- [P ()]+                    (printImport separateLists) . GHC.unLoc <$>+                    prepareImportList imports -      let -- Helper-          doSpaceSurround = when spaceSurround space+            -- Since we might need to output the import module name several times, we+            -- need to save it to a variable:+            wrapPrefix <- case listAlign of+                AfterAlias -> pure $ replicate (afterAliasPosition + 1) ' '+                WithAlias -> pure $ replicate (beforeAliasPosition + 1) ' '+                Repeat -> fmap (++ " (") getCurrentLine+                WithModuleName -> pure $ replicate (moduleNamePosition + offset) ' '+                NewLine -> pure $ replicate offset ' ' -          -- Try to put everything on one line.-          printAsSingleLine = forM_ printedImports $ \(imp, start, end) -> do-            when start $ putText "(" >> doSpaceSurround-            imp-            if end then doSpaceSurround >> putText ")" else comma >> space+            -- Helper+            let doSpaceSurround = when spaceSurround space -          -- Try to put everything one by one, wrapping if that fails.-          printAsInlineWrapping wprefix = forM_ printedImports $-            \(imp, start, end) ->-            patchForRepeatHiding $ wrapping-              (do-                if start then putText "(" >> doSpaceSurround else space-                imp-                if end then doSpaceSurround >> putText ")" else comma)-              (do-                case listAlign of-                    -- In 'Repeat' mode, end lines with ')' rather than ','.-                    Repeat | not start -> modifyCurrentLine . withLast $-                        \c -> if c == ',' then ')' else c-                    _ | start && spaceSurround ->-                        -- Only necessary if spaceSurround is enabled.-                        modifyCurrentLine trimRight-                    _ -> pure ()-                newline-                void wprefix-                case listAlign of-                  -- '(' already included in repeat-                  Repeat         -> pure ()-                  -- Print the much needed '('-                  _ | start      -> putText "(" >> doSpaceSurround-                  -- Don't bother aligning if we're not in inline mode.-                  _ | longListAlign /= Inline -> pure ()-                  -- 'Inline + AfterAlias' is really where we want to be careful-                  -- with spacing.-                  AfterAlias -> space >> doSpaceSurround-                  WithModuleName -> pure ()-                  WithAlias -> pure ()-                  NewLine -> pure ()-                imp-                if end then doSpaceSurround >> putText ")" else comma)+            -- Try to put everything on one line.+            let printAsSingleLine = forM_ printedImports $ \(imp, start, end) -> do+                    when start $ putText "(" >> doSpaceSurround+                    imp+                    if end then doSpaceSurround >> putText ")" else comma >> space -          -- Put everything on a separate line.  'spaceSurround' can be-          -- ignored.-          printAsMultiLine = forM_ printedImports $ \(imp, start, end) -> do-            when start $ modifyCurrentLine trimRight  -- We added some spaces.-            newline-            putOffset-            if start then putText "( " else putText ", "-            imp-            when end $ newline >> putOffset >> putText ")"+            -- Try to put everything one by one, wrapping if that fails.+            let printAsInlineWrapping wprefix = forM_ printedImports $+                    \(imp, start, end) ->+                    patchForRepeatHiding $ wrapping+                       (do+                         if start then putText "(" >> doSpaceSurround else space+                         imp+                         if end then doSpaceSurround >> putText ")" else comma)+                      (do+                        case listAlign of+                            -- In 'Repeat' mode, end lines with ')' rather than ','.+                            Repeat | not start -> modifyCurrentLine . withLast $+                                \c -> if c == ',' then ')' else c+                            _ | start && spaceSurround ->+                                -- Only necessary if spaceSurround is enabled.+                                modifyCurrentLine trimRight+                            _ -> pure ()+                        newline+                        void wprefix+                        case listAlign of+                          -- '(' already included in repeat+                          Repeat         -> pure ()+                          -- Print the much needed '('+                          _ | start      -> putText "(" >> doSpaceSurround+                          -- Don't bother aligning if we're not in inline mode.+                          _ | longListAlign /= Inline -> pure ()+                          -- 'Inline + AfterAlias' is really where we want to be careful+                          -- with spacing.+                          AfterAlias -> space >> doSpaceSurround+                          WithModuleName -> pure ()+                          WithAlias -> pure ()+                          NewLine -> pure ()+                        imp+                        if end then doSpaceSurround >> putText ")" else comma) -      case longListAlign of-        Multiline -> wrapping-          (space >> printAsSingleLine)-          printAsMultiLine-        Inline | NewLine <- listAlign -> do-          modifyCurrentLine trimRight-          newline >> putOffset >> printAsInlineWrapping (putText wrapPrefix)-        Inline -> space >> printAsInlineWrapping (putText wrapPrefix)-        InlineWithBreak -> wrapping-          (space >> printAsSingleLine)-          (do-            modifyCurrentLine trimRight-            newline >> putOffset >> printAsInlineWrapping putOffset)-        InlineToMultiline -> wrapping-          (space >> printAsSingleLine)-          (wrapping-            (do-              modifyCurrentLine trimRight-              newline >> putOffset >> printAsSingleLine)-            printAsMultiLine)+            -- Put everything on a separate line.  'spaceSurround' can be+            -- ignored.+            let printAsMultiLine = forM_ printedImports $ \(imp, start, end) -> do+                    when start $ modifyCurrentLine trimRight  -- We added some spaces.+                    newline+                    putOffset+                    if start then putText "( " else putText ", "+                    imp+                    when end $ newline >> putOffset >> putText ")"++            case longListAlign of+              Multiline -> wrapping+                (space >> printAsSingleLine)+                printAsMultiLine+              Inline | NewLine <- listAlign -> do+                modifyCurrentLine trimRight+                newline >> putOffset >> printAsInlineWrapping (putText wrapPrefix)+              Inline -> space >> printAsInlineWrapping (putText wrapPrefix)+              InlineWithBreak -> wrapping+                (space >> printAsSingleLine)+                (do+                  modifyCurrentLine trimRight+                  newline >> putOffset >> printAsInlineWrapping putOffset)+              InlineToMultiline -> wrapping+                (space >> printAsSingleLine)+                (wrapping+                  (do+                    modifyCurrentLine trimRight+                    newline >> putOffset >> printAsSingleLine)+                  printAsMultiLine)   where+    decl = GHC.unLoc ldecl+     -- We cannot wrap/repeat 'hiding' imports since then we would get multiple     -- imports hiding different things.     patchForRepeatHiding = case listAlign of@@ -318,63 +323,57 @@   ---------------------------------------------------------------------------------printImport :: Bool -> IE GhcPs -> P ()-printImport _ (IEVar _ name) = do+printImport :: Bool -> GHC.IE GHC.GhcPs -> P ()+printImport _ (GHC.IEVar _ name) = do     printIeWrappedName name-printImport _ (IEThingAbs _ name) = do+printImport _ (GHC.IEThingAbs _ name) = do     printIeWrappedName name-printImport separateLists (IEThingAll _ name) = do+printImport separateLists (GHC.IEThingAll _ name) = do     printIeWrappedName name     when separateLists space     putText "(..)"-printImport _ (IEModuleContents _ (L _ m)) = do+printImport _ (GHC.IEModuleContents _ modu) = do     putText "module"     space-    putText (moduleNameString m)-printImport separateLists (IEThingWith _ name wildcard imps _) = do+    putText . GHC.moduleNameString $ GHC.unLoc modu+printImport separateLists (GHC.IEThingWith _ name wildcard imps) = do     printIeWrappedName name     when separateLists space     let ellipsis = case wildcard of-          IEWildcard _position -> [putText ".."]-          NoIEWildcard         -> []+          GHC.IEWildcard _position -> [putText ".."]+          GHC.NoIEWildcard         -> []     parenthesize $       sep (comma >> space) (ellipsis <> fmap printIeWrappedName imps)-printImport _ (IEGroup _ _ _ ) =+printImport _ (GHC.IEGroup _ _ _ ) =     error "Language.Haskell.Stylish.Printer.Imports.printImportExport: unhandled case 'IEGroup'"-printImport _ (IEDoc _ _) =+printImport _ (GHC.IEDoc _ _) =     error "Language.Haskell.Stylish.Printer.Imports.printImportExport: unhandled case 'IEDoc'"-printImport _ (IEDocNamed _ _) =+printImport _ (GHC.IEDocNamed _ _) =     error "Language.Haskell.Stylish.Printer.Imports.printImportExport: unhandled case 'IEDocNamed'"-printImport _ (XIE ext) =-    GHC.noExtCon ext   ---------------------------------------------------------------------------------printIeWrappedName :: LIEWrappedName RdrName -> P ()-printIeWrappedName lie = unLocated lie & \case-  IEName n -> putRdrName n-  IEPattern n -> putText "pattern" >> space >> putRdrName n-  IEType n -> putText "type" >> space >> putRdrName n+printIeWrappedName :: GHC.LIEWrappedName GHC.RdrName -> P ()+printIeWrappedName lie = case GHC.unLoc lie of+    GHC.IEName      n -> putRdrName n+    GHC.IEPattern _ n -> putText "pattern" >> space >> putRdrName n+    GHC.IEType    _ n -> putText "type" >> space >> putRdrName n -mergeImports :: NonEmpty (Located Import) -> NonEmpty (Located Import)++mergeImports+    :: NonEmpty (GHC.LImportDecl GHC.GhcPs)+    -> NonEmpty (GHC.LImportDecl GHC.GhcPs) mergeImports (x :| []) = x :| [] mergeImports (h :| (t : ts))-  | canMergeImport (unLocated h) (unLocated t) = mergeImports (mergeModuleImport h t :| ts)+  | canMergeImport (GHC.unLoc h) (GHC.unLoc t) = mergeImports (mergeModuleImport h t :| ts)   | otherwise = h :| mergeImportsTail (t : ts)   where     mergeImportsTail (x : y : ys)-      | canMergeImport (unLocated x) (unLocated y) = mergeImportsTail ((mergeModuleImport x y) : ys)+      | canMergeImport (GHC.unLoc x) (GHC.unLoc y) = mergeImportsTail ((mergeModuleImport x y) : ys)       | otherwise = x : mergeImportsTail (y : ys)     mergeImportsTail xs = xs -moduleName :: Import -> String-moduleName-  = moduleNameString-  . unLocated-  . ideclName-  . rawImport - -------------------------------------------------------------------------------- data ImportStats = ImportStats     { isLongestImport :: !Int@@ -395,49 +394,37 @@     mappend = (<>)     mempty  = ImportStats 0 False False False -importStats :: Import -> ImportStats+importStats :: GHC.ImportDecl GHC.GhcPs -> ImportStats importStats i =-    ImportStats (importModuleNameLength i) (isSource i) (isQualified i) (isSafe i)+    ImportStats (importModuleNameLength i) (isSource i) (isQualified i) (GHC.ideclSafe  i)  -- Computes length till module name, includes package name. -- TODO: this should reuse code with the printer-importModuleNameLength :: Import -> Int+importModuleNameLength :: GHC.ImportDecl GHC.GhcPs -> Int importModuleNameLength imp =-    (case ideclPkgQual (rawImport imp) of+    (case GHC.ideclPkgQual imp of         Nothing -> 0         Just sl -> 1 + length (stringLiteral sl)) +-    (length $ moduleName imp)+    (length $ importModuleName imp)   ---------------------------------------------------------------------------------stringLiteral :: StringLiteral -> String-stringLiteral sl = case sl_st sl of-    NoSourceText -> FS.unpackFS $ sl_fs sl-    SourceText s -> s+stringLiteral :: GHC.StringLiteral -> String+stringLiteral sl = case GHC.sl_st sl of+    GHC.NoSourceText -> show . GHC.unpackFS $ GHC.sl_fs sl+    GHC.SourceText s -> s   ---------------------------------------------------------------------------------isQualified :: Import -> Bool-isQualified-  = (/=) NotQualified-  . ideclQualified-  . rawImport+isQualified :: GHC.ImportDecl GHC.GhcPs -> Bool+isQualified = (/=) GHC.NotQualified . GHC.ideclQualified -isHiding :: Import -> Bool-isHiding-  = maybe False fst-  . ideclHiding-  . rawImport+isHiding :: GHC.ImportDecl GHC.GhcPs -> Bool+isHiding = maybe False fst . GHC.ideclHiding -isSource :: Import -> Bool-isSource-  = ideclSource-  . rawImport+isSource :: GHC.ImportDecl GHC.GhcPs -> Bool+isSource = (==) GHC.IsBoot . GHC.ideclSource -isSafe :: Import -> Bool-isSafe-  = ideclSafe-  . rawImport  -------------------------------------------------------------------------------- -- | Cleans up an import item list.@@ -445,42 +432,44 @@ -- * Sorts import items. -- * Sort inner import lists, e.g. `import Control.Monad (Monad (return, join))` -- * Removes duplicates from import lists.-prepareImportList :: [LIE GhcPs] -> [LIE GhcPs]+prepareImportList :: [GHC.LIE GHC.GhcPs] -> [GHC.LIE GHC.GhcPs] prepareImportList =   sortBy compareLIE . map (fmap prepareInner) .   concatMap (toList . snd) . Map.toAscList . mergeByName  where-  mergeByName :: [LIE GhcPs] -> Map.Map RdrName (NonEmpty (LIE GhcPs))+  mergeByName+      :: [GHC.LIE GHC.GhcPs]+      -> Map.Map GHC.RdrName (NonEmpty (GHC.LIE GHC.GhcPs))   mergeByName imports0 = Map.fromListWith     -- Note that ideally every NonEmpty will just have a single entry and we     -- will be able to merge everything into that entry.  Exotic imports can     -- mess this up, though.  So they end up in the tail of the list.-    (\(x :| xs) (y :| ys) -> case ieMerge (unLocated x) (unLocated y) of-      Just z -> (x $> z) :| (xs ++ ys)  -- Keep source from `x`+    (\(x :| xs) (y :| ys) -> case ieMerge (GHC.unLoc x) (GHC.unLoc y) of+      Just z  -> (x $> z) :| (xs ++ ys)  -- Keep source from `x`       Nothing -> x :| (xs ++ y : ys))-    [(ieName $ unLocated imp, imp :| []) | imp <- imports0]+    [(GHC.ieName $ GHC.unLoc imp, imp :| []) | imp <- imports0] -  prepareInner :: IE GhcPs -> IE GhcPs+  prepareInner :: GHC.IE GHC.GhcPs -> GHC.IE GHC.GhcPs   prepareInner = \case     -- Simplify `A ()` to `A`.-    IEThingWith x n NoIEWildcard [] [] -> IEThingAbs x n-    IEThingWith x n w ns fs ->-      IEThingWith x n w (sortBy (compareWrappedName `on` unLoc) ns) fs+    GHC.IEThingWith x n GHC.NoIEWildcard [] -> GHC.IEThingAbs x n+    GHC.IEThingWith x n w ns ->+      GHC.IEThingWith x n w (sortBy (compareWrappedName `on` GHC.unLoc) ns)     ie -> ie    -- Merge two import items, assuming they have the same name.-  ieMerge :: IE GhcPs -> IE GhcPs -> Maybe (IE GhcPs)-  ieMerge l@(IEVar _ _)      _                  = Just l-  ieMerge _                  r@(IEVar _ _)      = Just r-  ieMerge (IEThingAbs _ _)   r                  = Just r-  ieMerge l                  (IEThingAbs _ _)   = Just l-  ieMerge l@(IEThingAll _ _) _                  = Just l-  ieMerge _                  r@(IEThingAll _ _) = Just r-  ieMerge (IEThingWith x0 n0 w0 ns0 []) (IEThingWith _ _ w1 ns1 [])+  ieMerge :: GHC.IE GHC.GhcPs -> GHC.IE GHC.GhcPs -> Maybe (GHC.IE GHC.GhcPs)+  ieMerge l@(GHC.IEVar _ _)      _                  = Just l+  ieMerge _                  r@(GHC.IEVar _ _)      = Just r+  ieMerge (GHC.IEThingAbs _ _)   r                  = Just r+  ieMerge l                  (GHC.IEThingAbs _ _)   = Just l+  ieMerge l@(GHC.IEThingAll _ _) _                  = Just l+  ieMerge _                  r@(GHC.IEThingAll _ _) = Just r+  ieMerge (GHC.IEThingWith x0 n0 w0 ns0) (GHC.IEThingWith _ _ w1 ns1)     | w0 /= w1  = Nothing     | otherwise = Just $         -- TODO: sort the `ns0 ++ ns1`?-        IEThingWith x0 n0 w0 (nubOn (unwrapName . unLoc) $ ns0 ++ ns1) []+        GHC.IEThingWith x0 n0 w0 (nubOn GHC.lieWrappedName $ ns0 ++ ns1)   ieMerge _ _ = Nothing  

@@ -13,15 +13,11 @@ -------------------------------------------------------------------------------- import           Data.List.NonEmpty              (NonEmpty, fromList, toList) import qualified Data.Set                        as S-import           Data.Text                       (Text)-import qualified Data.Text                       as T   ---------------------------------------------------------------------------------import qualified GHC.Hs                          as Hs-import           SrcLoc                          (RealSrcSpan, realSrcSpanStart,-                                                  srcLocLine, srcSpanEndLine,-                                                  srcSpanStartLine)+import qualified GHC.Hs                          as GHC+import         qualified  GHC.Types.SrcLoc as GHC   --------------------------------------------------------------------------------@@ -103,9 +99,9 @@ -------------------------------------------------------------------------------- -- | Filter redundant (and duplicate) pragmas out of the groups. As a side -- effect, we also sort the pragmas in their group...-filterRedundant :: (Text -> Bool)-                -> [(l, NonEmpty Text)]-                -> [(l, [Text])]+filterRedundant :: (String -> Bool)+                -> [(l, NonEmpty String)]+                -> [(l, [String])] filterRedundant isRedundant' = snd . foldr filterRedundant' (S.empty, []) . fmap (fmap toList)   where     filterRedundant' (l, xs) (known, zs)@@ -133,9 +129,9 @@      languagePragmas = moduleLanguagePragmas m -    convertFstToBlock :: [(RealSrcSpan, a)] -> [(Block String, a)]+    convertFstToBlock :: [(GHC.RealSrcSpan, a)] -> [(Block String, a)]     convertFstToBlock = fmap \(rspan, a) ->-      (Block (srcSpanStartLine rspan) (srcSpanEndLine rspan), a)+      (Block (GHC.srcSpanStartLine rspan) (GHC.srcSpanEndLine rspan), a)      groupAdjacent' =       fmap turnSndBackToNel . groupAdjacent . fmap (fmap toList)@@ -143,16 +139,17 @@         turnSndBackToNel (a, bss) = (a, fromList . concat $ bss)      longest :: Int-    longest  = maximum $ map T.length $ toList . snd =<< languagePragmas+    longest  = maximum $ map length $ toList . snd =<< languagePragmas -    groups :: [(Block String, NonEmpty Text)]+    groups :: [(Block String, NonEmpty String)]     groups = [(b, pgs) | (b, pgs) <- groupAdjacent' (convertFstToBlock languagePragmas)]      changes =-      [ change b (const $ prettyPragmas lngPrefix columns longest align style (fmap T.unpack pg))+      [ change b (const $ prettyPragmas lngPrefix columns longest align style pg)       | (b, pg) <- filterRedundant isRedundant' groups       ] + -------------------------------------------------------------------------------- -- | Add a LANGUAGE pragma to a module if it is not present already. addLanguagePragma :: String -> String -> Module -> [Change String]@@ -161,16 +158,16 @@     | otherwise           = [insert line ["{-# " ++ lg ++ " " ++ prag ++ " #-}"]]   where     pragmas'      = moduleLanguagePragmas modu-    present       = concatMap ((fmap T.unpack) . toList . snd) pragmas'+    present       = concatMap (toList . snd) pragmas'     line          = if null pragmas' then 1 else firstLocation pragmas'-    firstLocation :: [(RealSrcSpan, NonEmpty Text)] -> Int-    firstLocation = minimum . fmap (srcLocLine . realSrcSpanStart . fst)+    firstLocation :: [(GHC.RealSrcSpan, NonEmpty String)] -> Int+    firstLocation = minimum . fmap (GHC.srcLocLine . GHC.realSrcSpanStart . fst)   -------------------------------------------------------------------------------- -- | Check if a language pragma is redundant. We can't do this for all pragmas, -- but we do a best effort.-isRedundant :: Module -> Text -> Bool+isRedundant :: Module -> String -> Bool isRedundant m "ViewPatterns" = isRedundantViewPatterns m isRedundant m "BangPatterns" = isRedundantBangPatterns m isRedundant _ _              = False@@ -181,10 +178,10 @@ isRedundantViewPatterns :: Module -> Bool isRedundantViewPatterns = null . queryModule getViewPat   where-    getViewPat :: Hs.Pat Hs.GhcPs -> [()]+    getViewPat :: GHC.Pat GHC.GhcPs -> [()]     getViewPat = \case-      Hs.ViewPat{} -> [()]-      _            -> []+      GHC.ViewPat{} -> [()]+      _             -> []   --------------------------------------------------------------------------------@@ -194,13 +191,12 @@     (null $ queryModule getBangPat modul) &&     (null $ queryModule getMatchStrict modul)   where-    getBangPat :: Hs.Pat Hs.GhcPs -> [()]+    getBangPat :: GHC.Pat GHC.GhcPs -> [()]     getBangPat = \case-      Hs.BangPat{} -> [()]-      _            -> []+      GHC.BangPat{} -> [()]+      _             -> [] -    getMatchStrict :: Hs.Match Hs.GhcPs (Hs.LHsExpr Hs.GhcPs) -> [()]-    getMatchStrict (Hs.XMatch m) = Hs.noExtCon m-    getMatchStrict (Hs.Match _ ctx _ _) = case ctx of-      Hs.FunRhs _ _ Hs.SrcStrict -> [()]-      _                          -> []+    getMatchStrict :: GHC.Match GHC.GhcPs (GHC.LHsExpr GHC.GhcPs) -> [()]+    getMatchStrict (GHC.Match _ ctx _ _) = case ctx of+      GHC.FunRhs _ _ GHC.SrcStrict -> [()]+      _                            -> []

@@ -1,5 +1,6 @@-{-# LANGUAGE BlockArguments #-}-{-# LANGUAGE LambdaCase     #-}+{-# LANGUAGE BlockArguments  #-}+{-# LANGUAGE LambdaCase      #-}+{-# LANGUAGE RecordWildCards #-} module Language.Haskell.Stylish.Step.ModuleHeader   ( Config (..)   , BreakWhere (..)@@ -8,30 +9,20 @@   , step   ) where + ---------------------------------------------------------------------------------import           ApiAnnotation                         (AnnKeywordId (..),-                                                        AnnotationComment (..))-import           Control.Monad                         (forM_, join, when)-import           Data.Bifunctor                        (second)-import           Data.Foldable                         (find, toList)-import           Data.Function                         ((&))-import qualified Data.List                             as L-import           Data.List.NonEmpty                    (NonEmpty (..))-import qualified Data.List.NonEmpty                    as NonEmpty-import           Data.Maybe                            (isJust, listToMaybe)-import qualified GHC.Hs.Doc                            as GHC-import           GHC.Hs.Extension                      (GhcPs)-import qualified GHC.Hs.ImpExp                         as GHC-import qualified Module                                as GHC-import           SrcLoc                                (GenLocated (..),-                                                        Located, RealLocated,-                                                        SrcSpan (..),-                                                        srcSpanEndLine,-                                                        srcSpanStartLine, unLoc)-import           Util                                  (notNull)+import           Control.Applicative                   ((<|>))+import           Control.Monad                         (guard, unless, when)+import           Data.Foldable                         (forM_)+import           Data.Maybe                            (fromMaybe, isJust,+                                                        listToMaybe)+import qualified GHC.Hs                                as GHC+import qualified GHC.Types.SrcLoc                      as GHC+import qualified GHC.Unit.Module.Name                  as GHC + ---------------------------------------------------------------------------------import           Language.Haskell.Stylish.Block+import           Language.Haskell.Stylish.Comments import           Language.Haskell.Stylish.Editor import           Language.Haskell.Stylish.GHC import           Language.Haskell.Stylish.Module@@ -39,6 +30,7 @@ import           Language.Haskell.Stylish.Printer import           Language.Haskell.Stylish.Step import qualified Language.Haskell.Stylish.Step.Imports as Imports+import           Language.Haskell.Stylish.Util         (flagEnds)   data Config = Config@@ -74,229 +66,162 @@ step maxCols = makeStep "Module header" . printModuleHeader maxCols  printModuleHeader :: Maybe Int -> Config -> Lines -> Module -> Lines-printModuleHeader maxCols conf ls m =-  let-    header = moduleHeader m-    name = rawModuleName header-    haddocks = rawModuleHaddocks header-    exports = rawModuleExports header-    annotations = rawModuleAnnotations m--    relevantComments :: [RealLocated AnnotationComment]-    relevantComments-      = moduleComments m-      & rawComments-      & dropAfterLocated exports-      & dropBeforeLocated name--    printedModuleHeader = runPrinter_ (PrinterConfig maxCols) relevantComments-        m (printHeader conf name exports haddocks)+printModuleHeader maxCols conf ls lmodul =+    let modul = GHC.unLoc lmodul+        name = GHC.unLoc <$> GHC.hsmodName modul+        haddocks = GHC.hsmodHaddockModHeader modul -    getBlock loc =-      Block <$> fmap getStartLineUnsafe loc <*> fmap getEndLineUnsafe loc+        startLine = fromMaybe 1 $ moduleLine <|>+            (fmap GHC.srcSpanStartLine . GHC.srcSpanToRealSrcSpan $+                GHC.getLoc lmodul) -    adjustOffsetFrom :: Block a -> Block a -> Maybe (Block a)-    adjustOffsetFrom (Block s0 _) b2@(Block s1 e1)-      | s0 >= s1 && s0 >= e1 = Nothing-      | s0 >= s1 = Just (Block (s0 + 1) e1)-      | otherwise = Just b2+        endLine = fromMaybe 1 $ whereLine <|>+            (do+                loc <- GHC.getLocA <$> GHC.hsmodExports modul+                GHC.srcSpanEndLine <$> GHC.srcSpanToRealSrcSpan loc) -    nameBlock =-      getBlock name+        keywordLine kw = listToMaybe $ do+            GHC.EpAnn {..} <- pure $ GHC.hsmodAnn modul+            GHC.AddEpAnn kw' (GHC.EpaSpan s) <- GHC.am_main anns+            guard $ kw == kw'+            pure $ GHC.srcSpanEndLine s -    exportsBlock =-      join $ adjustOffsetFrom <$> nameBlock <*> getBlock exports+        moduleLine = keywordLine GHC.AnnModule+        whereLine = keywordLine GHC.AnnWhere -    whereM :: Maybe SrcSpan-    whereM-      = annotations-      & filter (\(((_, w), _)) -> w == AnnWhere)-      & fmap (head . snd) -- get position of annot-      & L.sort-      & listToMaybe+        commentOnLine l = listToMaybe $ do+            comment <- epAnnComments $ GHC.hsmodAnn modul+            guard $ GHC.srcSpanStartLine (GHC.anchor $ GHC.getLoc comment) == l+            pure comment -    isModuleHeaderWhere :: Block a -> Bool-    isModuleHeaderWhere w-      = not-      . overlapping-      $ [w] <> toList nameBlock <> toList exportsBlock+        moduleComment = moduleLine >>= commentOnLine+        whereComment =+            guard (whereLine /= moduleLine) >> whereLine >>= commentOnLine -    toLineBlock :: SrcSpan -> Block a-    toLineBlock (RealSrcSpan s) = Block (srcSpanStartLine s) (srcSpanEndLine s)-    toLineBlock s-      = error-      $ "'where' block was not a RealSrcSpan" <> show s+        exportGroups = case GHC.hsmodExports modul of+            Nothing -> Nothing+            Just lexports -> Just $ doSort $ commentGroups+                (GHC.srcSpanToRealSrcSpan . GHC.getLocA)+                (GHC.unLoc lexports)+                (epAnnComments . GHC.ann $ GHC.getLoc lexports) -    whereBlock-      = whereM-      & fmap toLineBlock-      & find isModuleHeaderWhere+        printedModuleHeader = runPrinter_+            (PrinterConfig maxCols)+            (printHeader+                conf name exportGroups haddocks moduleComment whereComment) -    deletes =-      fmap delete $ mergeAdjacent $ toList nameBlock <> toList exportsBlock <> toList whereBlock+        deletes = delete (Block startLine endLine) -    startLine =-      maybe 1 blockStart nameBlock+        additions = [insert startLine printedModuleHeader] -    additions = [insert startLine printedModuleHeader]+        changes = deletes : additions in -    changes = deletes <> additions-  in     applyChanges changes ls -printHeader-  :: Config-  -> Maybe (Located GHC.ModuleName)-  -> Maybe (Located [GHC.LIE GhcPs])-  -> Maybe GHC.LHsDocString-  -> P ()-printHeader conf mname mexps _ = do-  forM_ mname \(L _ name) -> do-    putText "module"-    space-    putText (showOutputable name)--  case mexps of-    Nothing -> when (isJust mname) do-      forM_ mname \(L nloc _) -> attachEolComment nloc-      case breakWhere conf of-        Always -> do-          newline-          spaces (indent conf)-        _      -> space-      putText "where"-    Just (L loc exps) -> do-      moduleComment <- getModuleComment-      exportsWithComments <- fmap (second doSort) <$> groupAttachedComments exps-      case breakWhere conf of-        Single-          | Just exportsWithoutComments <- groupWithoutComments exportsWithComments-          , length exportsWithoutComments <= 1-          -> do-              attachModuleComment moduleComment-              printSingleLineExportList conf (L loc exportsWithoutComments)-        Inline-          | Just exportsWithoutComments <- groupWithoutComments exportsWithComments-          -> do-              wrapping-               (   attachModuleComment moduleComment-                >> printSingleLineExportList conf (L loc exportsWithoutComments))-               (   attachOpenBracket-                >> attachModuleComment moduleComment-                >> printMultiLineExportList conf (L loc exportsWithComments))-        _ -> do-          attachOpenBracket-          attachModuleComment moduleComment-          printMultiLineExportList conf (L loc exportsWithComments)   where+    doSort = if sort conf then fmap (commentGroupSort compareLIE) else id -    getModuleComment = do-       maybemaybeComment <- traverse (\(L nloc _) -> removeModuleComment nloc) mname-       pure $ join maybemaybeComment+printHeader+    :: Config+    -> Maybe GHC.ModuleName+    -> Maybe [CommentGroup (GHC.LIE GHC.GhcPs)]+    -> Maybe GHC.LHsDocString+    -> Maybe GHC.LEpaComment  -- Comment attached to 'module'+    -> Maybe GHC.LEpaComment  -- Comment attached to 'where'+    -> P ()+printHeader conf mbName mbExps _ mbModuleComment mbWhereComment = do+    forM_ mbName $ \name -> do+        putText "module"+        space+        putText (showOutputable name) -    attachModuleComment moduleComment =-      mapM_ (\c -> space >> putComment c) moduleComment+    case mbExps of+        Nothing -> do+            when (isJust mbName) $ case breakWhere conf of+                Always -> do+                    attachModuleComment+                    newline+                    spaces (indent conf)+                _      -> space+            putText "where"+        Just exports -> case breakWhere conf of+            Single  | [] <- exports -> do+                printSingleLineExportList conf []+                attachModuleComment+            Single  | [egroup] <- exports+                    , not (commentGroupHasComments egroup)+                    , [(export, _)] <- (cgItems egroup) -> do+                printSingleLineExportList conf [export]+                attachModuleComment+            Inline  | [] <- exports -> do+                printSingleLineExportList conf []+                attachModuleComment+            Inline  | [egroup] <- exports, not (commentGroupHasComments egroup) -> do+                wrapping+                    (printSingleLineExportList conf $ map fst $ cgItems egroup)+                    (do+                        attachOpenBracket+                        attachModuleComment+                        printMultiLineExportList conf exports)+            _ -> do+                attachOpenBracket+                attachModuleComment+                printMultiLineExportList conf exports -    doSort = if sort conf then NonEmpty.sortBy compareLIE else id+    putMaybeLineComment $ GHC.unLoc <$> mbWhereComment+  where+    attachModuleComment = putMaybeLineComment $ GHC.unLoc <$> mbModuleComment      attachOpenBracket-      | openBracket conf == SameLine = putText " ("-      | otherwise                    = pure ()--removeModuleComment :: SrcSpan -> P (Maybe AnnotationComment)-removeModuleComment = \case-  UnhelpfulSpan _ -> pure Nothing-  RealSrcSpan rspan ->-    removeLineComment (srcSpanStartLine rspan)--attachEolComment :: SrcSpan -> P ()-attachEolComment = \case-  UnhelpfulSpan _ -> pure ()-  RealSrcSpan rspan ->-    removeLineComment (srcSpanStartLine rspan) >>= mapM_ \c -> space >> putComment c--attachEolCommentEnd :: SrcSpan -> P ()-attachEolCommentEnd = \case-  UnhelpfulSpan _ -> pure ()-  RealSrcSpan rspan ->-    removeLineComment (srcSpanEndLine rspan) >>= mapM_ \c -> space >> putComment c+        | openBracket conf == SameLine = putText " ("+        | otherwise                    = pure () -printSingleLineExportList :: Config -> Located [GHC.LIE GhcPs] -> P ()-printSingleLineExportList conf (L srcLoc exports) = do-  space >> putText "("-  printInlineExports exports-  putText ")" >> space >> putText "where" >> attachEolCommentEnd srcLoc+printSingleLineExportList+    :: Config -> [GHC.LIE GHC.GhcPs] -> P ()+printSingleLineExportList conf exports = do+    space >> putText "("+    printExports exports+    putText ")" >> space >> putText "where"   where-    printInlineExports :: [GHC.LIE GhcPs] -> P ()-    printInlineExports = \case-      []     -> pure ()-      [e]    -> printExport conf e-      (e:es) -> printExport conf e >> comma >> space >> printInlineExports es+    printExports :: [GHC.LIE GHC.GhcPs] -> P ()+    printExports = \case+        []     -> pure ()+        [e]    -> putExport conf e+        (e:es) -> putExport conf e >> comma >> space >> printExports es  printMultiLineExportList      :: Config-     -> Located [([AnnotationComment], NonEmpty (GHC.LIE GhcPs))]+     -> [CommentGroup (GHC.LIE GHC.GhcPs)]      -> P ()-printMultiLineExportList conf (L srcLoc exportsWithComments) = do-  newline-  doIndent >> putText firstChar >> when (notNull exportsWithComments) space-  printExports exportsWithComments--  putText ")" >> space >> putText "where" >> attachEolCommentEnd srcLoc+printMultiLineExportList conf exports = do+    newline+    doIndent >> putText firstChar >> unless (null exports) space+    mapM_ printExport $ flagEnds exports+    when (null exports) $ newline >> doIndent+    putText ")" >> space >> putText "where"   where-    -- 'doIndent' is @x@:-    ---    -- > module Foo-    -- > xxxx( foo-    -- > xxxx, bar-    -- > xxxx) where-    ---    -- 'doHang' is @y@:-    ---    -- > module Foo-    -- > xxxx( -- Some comment-    -- > xxxxyyfoo-    -- > xxxx) where+    printExport (CommentGroup {..}, firstGroup, _lastGroup) = do+        forM_ (flagEnds cgPrior) $ \(cmt, start, _end) -> do+            unless (firstGroup && start) $ space >> space+            putComment $ GHC.unLoc cmt+            newline >> doIndent -    firstChar =-      case openBracket conf of+        forM_ (flagEnds cgItems) $ \((export, mbComment), start, _end) -> do+            if firstGroup && start then+                unless (null cgPrior) $ space >> space+            else+                comma >> space+            putExport conf export+            putMaybeLineComment $ GHC.unLoc <$> mbComment+            newline >> doIndent++    firstChar = case openBracket conf of         SameLine -> " "         NextLine -> "("      doIndent = spaces (indent conf)-    doHang = pad (indent conf + 2) -    printExports :: [([AnnotationComment], NonEmpty (GHC.LIE GhcPs))] -> P ()-    printExports (([], firstInGroup :| groupRest) : rest) = do-      printExport conf firstInGroup-      newline-      doIndent-      printExportsGroupTail groupRest-      printExportsTail rest-    printExports ((firstComment : comments, firstExport :| groupRest) : rest) = do-      putComment firstComment >> newline >> doIndent-      forM_ comments \c -> doHang >> putComment c >> newline >> doIndent-      doHang-      printExport conf firstExport-      newline-      doIndent-      printExportsGroupTail groupRest-      printExportsTail rest-    printExports [] =-      newline >> doIndent--    printExportsTail :: [([AnnotationComment], NonEmpty (GHC.LIE GhcPs))] -> P ()-    printExportsTail = mapM_ \(comments, exported) -> do-      forM_ comments \c -> doHang >> putComment c >> newline >> doIndent-      forM_ exported \export -> do-        comma >> space >> printExport conf export-        newline >> doIndent--    printExportsGroupTail :: [GHC.LIE GhcPs] -> P ()-    printExportsGroupTail (x : xs) = printExportsTail [([], x :| xs)]-    printExportsGroupTail []       = pure ()- -- NOTE(jaspervdj): This code is almost the same as the import printing in -- 'Imports' and should be merged.-printExport :: Config -> GHC.LIE GhcPs -> P ()-printExport conf = Imports.printImport (separateLists conf) . unLoc+putExport :: Config -> GHC.LIE GHC.GhcPs -> P ()+putExport conf = Imports.printImport (separateLists conf) . GHC.unLoc

@@ -15,7 +15,8 @@ import           Data.List                       (foldl', foldl1', sortOn) import           Data.Maybe                      (fromMaybe) import qualified GHC.Hs                          as Hs-import qualified SrcLoc                          as S+import qualified GHC.Parser.Annotation as GHC+import qualified GHC.Types.SrcLoc as GHC   --------------------------------------------------------------------------------@@ -48,49 +49,47 @@     , cMultiWayIf       = Always     } -groupAlign :: Align -> [Alignable S.RealSrcSpan] -> [[Alignable S.RealSrcSpan]]+groupAlign :: Align -> [Alignable GHC.RealSrcSpan] -> [[Alignable GHC.RealSrcSpan]] groupAlign a xs = case a of     Never    -> []-    Adjacent -> byLine . sortOn (S.srcSpanStartLine . aLeft) $ xs+    Adjacent -> byLine . sortOn (GHC.srcSpanStartLine . aLeft) $ xs     Always   -> [xs]   where     byLine = map toList . groupByLine aLeft   ---------------------------------------------------------------------------------type Record = [S.Located (Hs.ConDeclField Hs.GhcPs)]+type Record = [GHC.LocatedA (Hs.ConDeclField Hs.GhcPs)]   ---------------------------------------------------------------------------------records :: S.Located (Hs.HsModule Hs.GhcPs) -> [Record]+records :: GHC.Located Hs.HsModule -> [Record] records modu = do-  let decls           = map S.unLoc (Hs.hsmodDecls (S.unLoc modu))+  let decls           = map GHC.unLoc (Hs.hsmodDecls (GHC.unLoc modu))       tyClDecls       = [ tyClDecl | Hs.TyClD _ tyClDecl <- decls ]       dataDecls       = [ d | d@(Hs.DataDecl _ _ _ _ _)  <- tyClDecls ]       dataDefns       = map Hs.tcdDataDefn dataDecls   d@Hs.ConDeclH98 {} <- concatMap getConDecls dataDefns   case Hs.con_args d of-      Hs.RecCon rec -> [S.unLoc rec]+      Hs.RecCon rec -> [GHC.unLoc rec]       _             -> []  where   getConDecls :: Hs.HsDataDefn Hs.GhcPs -> [Hs.ConDecl Hs.GhcPs]-  getConDecls d@Hs.HsDataDefn {} = map S.unLoc $ Hs.dd_cons d-  getConDecls (Hs.XHsDataDefn x) = Hs.noExtCon x+  getConDecls d@Hs.HsDataDefn {} = map GHC.unLoc $ Hs.dd_cons d   ---------------------------------------------------------------------------------recordToAlignable :: Config -> Record -> [[Alignable S.RealSrcSpan]]+recordToAlignable :: Config -> Record -> [[Alignable GHC.RealSrcSpan]] recordToAlignable conf = groupAlign (cRecords conf) . fromMaybe [] . traverse fieldDeclToAlignable   -------------------------------------------------------------------------------- fieldDeclToAlignable-    :: S.Located (Hs.ConDeclField Hs.GhcPs) -> Maybe (Alignable S.RealSrcSpan)-fieldDeclToAlignable (S.L _ (Hs.XConDeclField x)) = Hs.noExtCon x-fieldDeclToAlignable (S.L matchLoc (Hs.ConDeclField _ names ty _)) = do-  matchPos <- toRealSrcSpan matchLoc-  leftPos  <- toRealSrcSpan $ S.getLoc $ last names-  tyPos    <- toRealSrcSpan $ S.getLoc ty+    :: GHC.LocatedA (Hs.ConDeclField Hs.GhcPs) -> Maybe (Alignable GHC.RealSrcSpan)+fieldDeclToAlignable (GHC.L matchLoc (Hs.ConDeclField _ names ty _)) = do+  matchPos <- GHC.srcSpanToRealSrcSpan $ GHC.locA matchLoc+  leftPos  <- GHC.srcSpanToRealSrcSpan $ GHC.getLoc $ last names+  tyPos    <- GHC.srcSpanToRealSrcSpan $ GHC.getLocA ty   Just $ Alignable     { aContainer = matchPos     , aLeft      = leftPos@@ -103,60 +102,58 @@ matchGroupToAlignable     :: Config     -> Hs.MatchGroup Hs.GhcPs (Hs.LHsExpr Hs.GhcPs)-    -> [[Alignable S.RealSrcSpan]]-matchGroupToAlignable _conf (Hs.XMatchGroup x) = Hs.noExtCon x+    -> [[Alignable GHC.RealSrcSpan]] matchGroupToAlignable conf (Hs.MG _ alts _) = cases' ++ patterns'   where-    (cases, patterns) = partitionEithers . fromMaybe [] $ traverse matchToAlignable (S.unLoc alts)+    (cases, patterns) = partitionEithers . fromMaybe [] $ traverse matchToAlignable (GHC.unLoc alts)     cases' = groupAlign (cCases conf) cases     patterns' = groupAlign (cTopLevelPatterns conf) patterns   -------------------------------------------------------------------------------- matchToAlignable-    :: S.Located (Hs.Match Hs.GhcPs (Hs.LHsExpr Hs.GhcPs))-    -> Maybe (Either (Alignable S.RealSrcSpan) (Alignable S.RealSrcSpan))-matchToAlignable (S.L matchLoc m@(Hs.Match _ Hs.CaseAlt pats@(_ : _) grhss)) = do-  let patsLocs   = map S.getLoc pats+    :: GHC.LocatedA (Hs.Match Hs.GhcPs (Hs.LHsExpr Hs.GhcPs))+    -> Maybe (Either (Alignable GHC.RealSrcSpan) (Alignable GHC.RealSrcSpan))+matchToAlignable (GHC.L matchLoc m@(Hs.Match _ Hs.CaseAlt pats@(_ : _) grhss)) = do+  let patsLocs   = map GHC.getLocA pats       pat        = last patsLocs       guards     = getGuards m-      guardsLocs = map S.getLoc guards-      left       = foldl' S.combineSrcSpans pat guardsLocs+      guardsLocs = map GHC.getLocA guards+      left       = foldl' GHC.combineSrcSpans pat guardsLocs   body     <- rhsBody grhss-  matchPos <- toRealSrcSpan matchLoc-  leftPos  <- toRealSrcSpan left-  rightPos <- toRealSrcSpan $ S.getLoc body+  matchPos <- GHC.srcSpanToRealSrcSpan $ GHC.locA matchLoc+  leftPos  <- GHC.srcSpanToRealSrcSpan left+  rightPos <- GHC.srcSpanToRealSrcSpan $ GHC.getLocA body   Just . Left $ Alignable     { aContainer = matchPos     , aLeft      = leftPos     , aRight     = rightPos     , aRightLead = length "-> "     }-matchToAlignable (S.L matchLoc (Hs.Match _ (Hs.FunRhs name _ _) pats@(_ : _) grhss)) = do+matchToAlignable (GHC.L matchLoc (Hs.Match _ (Hs.FunRhs name _ _) pats@(_ : _) grhss)) = do   body <- unguardedRhsBody grhss-  let patsLocs = map S.getLoc pats-      nameLoc  = S.getLoc name+  let patsLocs = map GHC.getLocA pats+      nameLoc  = GHC.getLocA name       left     = last (nameLoc : patsLocs)-      bodyLoc  = S.getLoc body-  matchPos <- toRealSrcSpan matchLoc-  leftPos  <- toRealSrcSpan left-  bodyPos  <- toRealSrcSpan bodyLoc+      bodyLoc  = GHC.getLocA body+  matchPos <- GHC.srcSpanToRealSrcSpan $ GHC.locA matchLoc+  leftPos  <- GHC.srcSpanToRealSrcSpan left+  bodyPos  <- GHC.srcSpanToRealSrcSpan bodyLoc   Just . Right $ Alignable     { aContainer = matchPos     , aLeft      = leftPos     , aRight     = bodyPos     , aRightLead = length "= "     }-matchToAlignable (S.L _ (Hs.XMatch x))      = Hs.noExtCon x-matchToAlignable (S.L _ (Hs.Match _ _ _ _)) = Nothing+matchToAlignable (GHC.L _ (Hs.Match _ _ _ _)) = Nothing   -------------------------------------------------------------------------------- multiWayIfToAlignable     :: Config     -> Hs.LHsExpr Hs.GhcPs-    -> [[Alignable S.RealSrcSpan]]-multiWayIfToAlignable conf (S.L _ (Hs.HsMultiIf _ grhss)) =+    -> [[Alignable GHC.RealSrcSpan]]+multiWayIfToAlignable conf (GHC.L _ (Hs.HsMultiIf _ grhss)) =     groupAlign (cMultiWayIf conf) as   where     as = fromMaybe [] $ traverse grhsToAlignable grhss@@ -165,34 +162,34 @@  -------------------------------------------------------------------------------- grhsToAlignable-    :: S.Located (Hs.GRHS Hs.GhcPs (Hs.LHsExpr Hs.GhcPs))-    -> Maybe (Alignable S.RealSrcSpan)-grhsToAlignable (S.L grhsloc (Hs.GRHS _ guards@(_ : _) body)) = do-    let guardsLocs = map S.getLoc guards-        bodyLoc    = S.getLoc body-        left       = foldl1' S.combineSrcSpans guardsLocs-    matchPos <- toRealSrcSpan grhsloc-    leftPos  <- toRealSrcSpan left-    bodyPos  <- toRealSrcSpan bodyLoc+    :: GHC.Located (Hs.GRHS Hs.GhcPs (Hs.LHsExpr Hs.GhcPs))+    -> Maybe (Alignable GHC.RealSrcSpan)+grhsToAlignable (GHC.L grhsloc (Hs.GRHS _ guards@(_ : _) body)) = do+    let guardsLocs = map GHC.getLocA guards+        bodyLoc    = GHC.getLocA $ body+        left       = foldl1' GHC.combineSrcSpans guardsLocs+    matchPos <- GHC.srcSpanToRealSrcSpan grhsloc+    leftPos  <- GHC.srcSpanToRealSrcSpan left+    bodyPos  <- GHC.srcSpanToRealSrcSpan bodyLoc     Just $ Alignable         { aContainer = matchPos         , aLeft      = leftPos         , aRight     = bodyPos         , aRightLead = length "-> "         }-grhsToAlignable (S.L _ (Hs.XGRHS x)) = Hs.noExtCon x-grhsToAlignable (S.L _ _)            = Nothing+grhsToAlignable (GHC.L _ _)            = Nothing   -------------------------------------------------------------------------------- step :: Maybe Int -> Config -> Step step maxColumns config = makeStep "Cases" $ \ls module' ->     let changes-            :: (S.Located (Hs.HsModule Hs.GhcPs) -> [a])-            -> (a -> [[Alignable S.RealSrcSpan]])+            :: (GHC.Located Hs.HsModule -> [a])+            -> (a -> [[Alignable GHC.RealSrcSpan]])             -> [Change String]         changes search toAlign =-            (concatMap . concatMap) (align maxColumns) . map toAlign $ search (parsedModule module')+            (concatMap . concatMap) (align maxColumns) . map toAlign $+            search module'          configured :: [Change String]         configured = concat $

@@ -8,9 +8,10 @@   ---------------------------------------------------------------------------------import           Data.Maybe                      (mapMaybe)-import qualified GHC.Hs                          as Hs-import qualified SrcLoc                          as S+import           Control.Monad    (guard)+import           Data.Maybe       (mapMaybe)+import qualified GHC.Types.SrcLoc as GHC+import qualified GHC.Hs           as GHC   --------------------------------------------------------------------------------@@ -20,38 +21,34 @@   ---------------------------------------------------------------------------------squash-    :: (S.HasSrcSpan l, S.HasSrcSpan r)-    => l -> r -> Maybe (Change String)+squash :: GHC.SrcSpan -> GHC.SrcSpan -> Maybe (Change String) squash left right = do-  lAnn <- toRealSrcSpan $ S.getLoc left-  rAnn <- toRealSrcSpan $ S.getLoc right-  if S.srcSpanEndLine lAnn == S.srcSpanStartLine rAnn ||-      S.srcSpanEndLine lAnn + 1 == S.srcSpanStartLine rAnn-    then Just $-          changeLine (S.srcSpanEndLine lAnn) $ \str ->-          let (pre, post) = splitAt (S.srcSpanEndCol lAnn) str-          in [trimRight pre ++ " " ++ trimLeft post]-    else Nothing+  l <- GHC.srcSpanToRealSrcSpan left+  r <- GHC.srcSpanToRealSrcSpan right+  guard $+      GHC.srcSpanEndLine l == GHC.srcSpanStartLine r ||+      GHC.srcSpanEndLine l + 1 == GHC.srcSpanStartLine r+  pure $ changeLine (GHC.srcSpanEndLine l) $ \str ->+      let (pre, post) = splitAt (GHC.srcSpanEndCol l) str+      in [trimRight pre ++ " " ++ trimLeft post]   ---------------------------------------------------------------------------------squashFieldDecl :: Hs.ConDeclField Hs.GhcPs -> Maybe (Change String)-squashFieldDecl (Hs.ConDeclField _ names type' _)+squashFieldDecl :: GHC.ConDeclField GHC.GhcPs -> Maybe (Change String)+squashFieldDecl (GHC.ConDeclField _ names type' _)   | null names = Nothing-  | otherwise  = squash (last names) type'-squashFieldDecl (Hs.XConDeclField x) = Hs.noExtCon x+  | otherwise  = squash (GHC.getLoc $ last names) (GHC.getLocA type')   ---------------------------------------------------------------------------------squashMatch :: Hs.Match Hs.GhcPs (Hs.LHsExpr Hs.GhcPs) -> Maybe (Change String)-squashMatch (Hs.Match _ (Hs.FunRhs name _ _) [] grhss) = do+squashMatch+    :: GHC.Match GHC.GhcPs (GHC.LHsExpr GHC.GhcPs) -> Maybe (Change String)+squashMatch (GHC.Match _ (GHC.FunRhs name _ _) [] grhss) = do     body <- unguardedRhsBody grhss-    squash name body-squashMatch (Hs.Match _ _ pats grhss) = do+    squash (GHC.getLocA name) (GHC.getLocA body)+squashMatch (GHC.Match _ _ pats grhss) = do     body <- unguardedRhsBody grhss-    squash (last pats) body-squashMatch (Hs.XMatch x) = Hs.noExtCon x+    squash (GHC.getLocA $ last pats) (GHC.getLocA body)   --------------------------------------------------------------------------------

@@ -5,22 +5,20 @@   ---------------------------------------------------------------------------------import           Data.List                                     (isPrefixOf,-                                                                sort)-import           Data.Map                                      (Map)-import qualified Data.Map                                      as M-import           Data.Maybe                                    (maybeToList)-import           GHC.Hs.Binds-import           GHC.Hs.Extension                              (GhcPs)-import           GHC.Hs.Types+import qualified Data.Map              as M+import qualified GHC.Hs                as GHC+import qualified GHC.Types.SrcLoc      as GHC++ ---------------------------------------------------------------------------------import           Language.Haskell.Stylish.Block import           Language.Haskell.Stylish.Editor import           Language.Haskell.Stylish.Module import           Language.Haskell.Stylish.Step import           Language.Haskell.Stylish.Step.LanguagePragmas (addLanguagePragma)-import           Language.Haskell.Stylish.Util+import           Language.Haskell.Stylish.Util                 (everything) ++{- -------------------------------------------------------------------------------- unicodeReplacements :: Map String String unicodeReplacements = M.fromList@@ -32,66 +30,90 @@     , ("-<", "↢")     , (">-", "↣")     ]+-} +--------------------------------------------------------------------------------+-- Simple type that can do replacments on single lines (not spanning, removing+-- or adding lines).+newtype Replacement = Replacement+    { unReplacement :: M.Map Int [(Int, Int, String)]+    } deriving (Show) + ---------------------------------------------------------------------------------replaceAll :: [(Int, [(Int, String)])] -> [Change String]-replaceAll = map changeLine'-  where-    changeLine' (r, ns) = changeLine r $ \str -> return $-        applyChanges-            [ change (Block c ec) (const repl)-            | (c, needle) <- sort ns-            , let ec = c + length needle - 1-            , repl <- maybeToList $ M.lookup needle unicodeReplacements-            ] str+instance Semigroup Replacement where+    Replacement l <> Replacement r = Replacement $ M.unionWith (++) l r   ---------------------------------------------------------------------------------groupPerLine :: [((Int, Int), a)] -> [(Int, [(Int, a)])]-groupPerLine = M.toList . M.fromListWith (++) .-    map (\((r, c), x) -> (r, [(c, x)]))+instance Monoid Replacement where+    mempty = Replacement mempty --- | Find symbol positions in the module.  Currently only searches in type--- signatures.-findSymbol :: Module -> Lines -> String -> [((Int, Int), String)]-findSymbol module' ls sym =-    [ (pos, sym)-    | TypeSig _ funLoc typeLoc <- everything (rawModuleDecls $ moduleDecls module') :: [Sig GhcPs]-    , (funStart, _)            <- infoPoints funLoc-    , (_, typeEnd)             <- infoPoints [hsSigWcType typeLoc]-    , pos                      <- maybeToList $ between funStart typeEnd sym ls-    ]  ----------------------------------------------------------------------------------- | Search for a needle in a haystack of lines. Only part the inside (startRow,--- startCol), (endRow, endCol) is searched. The return value is the position of--- the needle.-between :: (Int, Int) -> (Int, Int) -> String -> Lines -> Maybe (Int, Int)-between (startRow, startCol) (endRow, endCol) needle =-    search (startRow, startCol) .-    withLast (take endCol) .-    withHead (drop $ startCol - 1) .-    take (endRow - startRow + 1) .-    drop (startRow - 1)+mkReplacement :: GHC.RealSrcSpan -> String -> Replacement+mkReplacement rss repl+    | GHC.srcSpanStartLine rss /= GHC.srcSpanEndLine rss = Replacement mempty+    | otherwise                                          = Replacement $+        M.singleton+            (GHC.srcSpanStartLine rss)+            [(GHC.srcSpanStartCol rss, GHC.srcSpanEndCol rss, repl)]+++--------------------------------------------------------------------------------+applyReplacement :: Replacement -> [String] -> [String]+applyReplacement (Replacement repl) ls = do+    (i, l) <- zip [1 ..] ls+    case M.lookup i repl of+        Nothing    -> pure l+        Just repls -> pure $ go repls l   where-    search _      []            = Nothing-    search (r, _) ([] : xs)     = search (r + 1, 1) xs-    search (r, c) (x : xs)-        | needle `isPrefixOf` x = Just (r, c)-        | otherwise             = search (r, c + 1) (tail x : xs)+    go [] l = l+    go ((xstart, xend, x) : repls) l =+        let l' = take (xstart - 1) l ++ x ++ drop (xend - 1) l in+        go (adjust (xstart, xend, x) <$> repls) l' +    adjust (xstart, xend, x) (ystart, yend, y)+        | ystart > xend =+            let offset = length x - (xend - xstart) in+            (ystart + offset, yend + offset, y)+        | otherwise     = (ystart, yend, y) + --------------------------------------------------------------------------------+hsTyReplacements :: GHC.HsType GHC.GhcPs -> Replacement+hsTyReplacements (GHC.HsFunTy xann arr _ _)+    | GHC.HsUnrestrictedArrow GHC.NormalSyntax <- arr+    , GHC.AddRarrowAnn (GHC.EpaSpan loc) <- GHC.anns xann =+        mkReplacement loc "→"+hsTyReplacements (GHC.HsQualTy _ (Just ctx) _)+    | Just arrow <- GHC.ac_darrow . GHC.anns . GHC.ann $ GHC.getLoc ctx+    , (GHC.NormalSyntax, GHC.EpaSpan loc) <- arrow =+        mkReplacement loc "⇒"+hsTyReplacements _ = mempty+++--------------------------------------------------------------------------------+hsSigReplacements :: GHC.Sig GHC.GhcPs -> Replacement+hsSigReplacements (GHC.TypeSig ann _ _)+    | GHC.AddEpAnn GHC.AnnDcolon epaLoc <- GHC.asDcolon $ GHC.anns ann+    , GHC.EpaSpan loc <- epaLoc =+        mkReplacement loc "∷"+hsSigReplacements _ = mempty+++-------------------------------------------------------------------------------- step :: Bool -> String -> Step step = (makeStep "UnicodeSyntax" .) . step'   -------------------------------------------------------------------------------- step' :: Bool -> String -> Lines -> Module -> Lines-step' alp lg ls module' = applyChanges changes ls+step' alp lg ls modu =+    applyChanges+        (if alp then addLanguagePragma lg "UnicodeSyntax" modu else []) $+    applyReplacement replacement ls   where-    changes = (if alp then addLanguagePragma lg "UnicodeSyntax" module' else []) ++-        replaceAll perLine-    toReplace = [ "::", "=>", "->" ]-    perLine = sort $ groupPerLine $ concatMap (findSymbol module' ls) toReplace+    replacement =+        foldMap hsTyReplacements (everything modu) <>+        foldMap hsSigReplacements (everything modu)

@@ -5,7 +5,6 @@     ( indent     , padRight     , everything-    , infoPoints     , trimLeft     , trimRight     , wrap@@ -20,8 +19,6 @@     , withLast     , flagEnds -    , toRealSrcSpan-     , traceOutputable     , traceOutputableM @@ -40,12 +37,13 @@ import           Data.Typeable                 (cast) import           Debug.Trace                   (trace) import qualified GHC.Hs                        as Hs-import qualified Outputable-import qualified SrcLoc                        as S+import qualified GHC.Types.SrcLoc as GHC+import qualified GHC.Utils.Outputable                                as GHC   -------------------------------------------------------------------------------- import           Language.Haskell.Stylish.Step+import           Language.Haskell.Stylish.GHC (showOutputable)   --------------------------------------------------------------------------------@@ -69,6 +67,7 @@   --------------------------------------------------------------------------------+{- infoPoints :: [S.Located pass] -> [((Int, Int), (Int, Int))] infoPoints = fmap (helper . S.getLoc)   where@@ -79,7 +78,7 @@                 end = S.realSrcSpanEnd s                ((S.srcLocLine start, S.srcLocCol start), (S.srcLocLine end, S.srcLocCol end))     helper _                   = ((-1,-1), (-1,-1))-+-}  -------------------------------------------------------------------------------- trimLeft :: String -> String@@ -213,35 +212,28 @@   ---------------------------------------------------------------------------------traceOutputable :: Outputable.Outputable a => String -> a -> b -> b+traceOutputable :: GHC.Outputable a => String -> a -> b -> b traceOutputable title x =-    trace (title ++ ": " ++ (Outputable.showSDocUnsafe $ Outputable.ppr x))+    trace (title ++ ": " ++ (showOutputable x))   ---------------------------------------------------------------------------------traceOutputableM :: (Outputable.Outputable a, Monad m) => String -> a -> m ()+traceOutputableM :: (GHC.Outputable a, Monad m) => String -> a -> m () traceOutputableM title x = traceOutputable title x $ pure ()   ----------------------------------------------------------------------------------- take the (Maybe) RealSrcSpan out of the SrcSpan-toRealSrcSpan :: S.SrcSpan -> Maybe S.RealSrcSpan-toRealSrcSpan (S.RealSrcSpan s) = Just s-toRealSrcSpan _                 = Nothing----------------------------------------------------------------------------------- -- Utility: grab the body out of guarded RHSs if it's a single unguarded one. unguardedRhsBody :: Hs.GRHSs Hs.GhcPs a -> Maybe a unguardedRhsBody (Hs.GRHSs _ [grhs] _)-    | Hs.GRHS _ [] body <- S.unLoc grhs = Just body+    | Hs.GRHS _ [] body <- GHC.unLoc grhs = Just body unguardedRhsBody _ = Nothing   -- Utility: grab the body out of guarded RHSs rhsBody :: Hs.GRHSs Hs.GhcPs a -> Maybe a rhsBody (Hs.GRHSs _ [grhs] _)-    | Hs.GRHS _ _ body <- S.unLoc grhs = Just body+    | Hs.GRHS _ _ body <- GHC.unLoc grhs = Just body rhsBody _ = Nothing  @@ -251,17 +243,14 @@ getGuards (Hs.Match _ _ _ grhss) =   let     lgrhs = getLocGRHS grhss -- []-    grhs  = map S.unLoc lgrhs+    grhs  = map GHC.unLoc lgrhs   in     concatMap getGuardLStmts grhs-getGuards (Hs.XMatch x) = Hs.noExtCon x   getLocGRHS :: Hs.GRHSs Hs.GhcPs (Hs.LHsExpr Hs.GhcPs) -> [Hs.LGRHS Hs.GhcPs (Hs.LHsExpr Hs.GhcPs)] getLocGRHS (Hs.GRHSs _ guardeds _) = guardeds-getLocGRHS (Hs.XGRHSs x)           = Hs.noExtCon x   getGuardLStmts :: Hs.GRHS Hs.GhcPs (Hs.LHsExpr Hs.GhcPs) -> [Hs.GuardLStmt Hs.GhcPs] getGuardLStmts (Hs.GRHS _ guards _) = guards-getGuardLStmts (Hs.XGRHS x)         = Hs.noExtCon x

@@ -1,6 +1,6 @@ Cabal-version: 2.4 Name:          stylish-haskell-Version:       0.13.0.0+Version:       0.14.0.0 Synopsis:      Haskell code prettifier Homepage:      https://github.com/haskell/stylish-haskell License:       BSD-3-Clause@@ -23,20 +23,47 @@   README.markdown,   data/stylish-haskell.yaml -Library-  Hs-source-dirs:   lib+Common depends   Ghc-options:      -Wall   Default-language: Haskell2010 +  Build-depends:+    aeson             >= 0.6    && < 2.1,+    base              >= 4.8    && < 5,+    bytestring        >= 0.9    && < 0.11,+    Cabal             >= 3.4    && < 3.7,+    containers        >= 0.3    && < 0.7,+    directory         >= 1.2.3  && < 1.4,+    filepath          >= 1.1    && < 1.5,+    file-embed        >= 0.0.10 && < 0.1,+    ghc-lib-parser    >= 9.2    && < 9.3,+    ghc-lib-parser-ex >= 9.2    && < 9.3,+    mtl               >= 2.0    && < 2.3,+    syb               >= 0.3    && < 0.8,+    text              >= 1.2    && < 1.3,+    HsYAML-aeson      >=0.2.0   && < 0.3,+    HsYAML            >=0.2.0   && < 0.3++  if impl(ghc < 8.0)+    Build-depends:+      semigroups     >= 0.18   && < 0.20++Library+  Import:         depends+  Hs-source-dirs: lib+   Exposed-modules:     Language.Haskell.Stylish+    Language.Haskell.Stylish.Config     Language.Haskell.Stylish.GHC     Language.Haskell.Stylish.Module+    Language.Haskell.Stylish.Parse     Language.Haskell.Stylish.Printer+    Language.Haskell.Stylish.Step     Language.Haskell.Stylish.Step.Data     Language.Haskell.Stylish.Step.Imports-    Language.Haskell.Stylish.Step.ModuleHeader     Language.Haskell.Stylish.Step.LanguagePragmas+    Language.Haskell.Stylish.Step.ModuleHeader     Language.Haskell.Stylish.Step.SimpleAlign     Language.Haskell.Stylish.Step.Squash     Language.Haskell.Stylish.Step.Tabs@@ -46,13 +73,11 @@   Other-modules:     Language.Haskell.Stylish.Align     Language.Haskell.Stylish.Block-    Language.Haskell.Stylish.Config+    Language.Haskell.Stylish.Comments     Language.Haskell.Stylish.Config.Cabal     Language.Haskell.Stylish.Config.Internal     Language.Haskell.Stylish.Editor     Language.Haskell.Stylish.Ordering-    Language.Haskell.Stylish.Parse-    Language.Haskell.Stylish.Step     Language.Haskell.Stylish.Util     Language.Haskell.Stylish.Verbose     Paths_stylish_haskell@@ -60,123 +85,45 @@   Autogen-modules:     Paths_stylish_haskell -  Build-depends:-    aeson            >= 0.6    && < 1.6,-    base             >= 4.8    && < 5,-    bytestring       >= 0.9    && < 0.11,-    Cabal            >= 2.4    && < 3.3,-    containers       >= 0.3    && < 0.7,-    directory        >= 1.2.3  && < 1.4,-    filepath         >= 1.1    && < 1.5,-    file-embed       >= 0.0.10 && < 0.1,-    ghc-lib-parser   >= 8.10   && < 8.12,-    mtl              >= 2.0    && < 2.3,-    syb              >= 0.3    && < 0.8,-    text             >= 1.2    && < 1.3,-    HsYAML-aeson     >=0.2.0   && < 0.3,-    HsYAML           >=0.2.0   && < 0.3--  if impl(ghc < 8.0)-    Build-depends:-      semigroups     >= 0.18   && < 0.20- Executable stylish-haskell-  Ghc-options:      -Wall-  Hs-source-dirs:   src-  Main-is:          Main.hs-  Default-language: Haskell2010+  Import:         depends+  Hs-source-dirs: src+  Main-is:        Main.hs    Build-depends:     stylish-haskell,     strict               >= 0.3  && < 0.5,-    optparse-applicative >= 0.12 && < 0.17,-    -- Copied from regular dependencies...-    aeson            >= 0.6    && < 1.6,-    base             >= 4.8    && < 5,-    bytestring       >= 0.9    && < 0.11,-    Cabal            >= 2.4    && < 3.3,-    containers       >= 0.3    && < 0.7,-    directory        >= 1.2.3  && < 1.4,-    filepath         >= 1.1    && < 1.5,-    file-embed       >= 0.0.10 && < 0.1,-    ghc-lib-parser   >= 8.10   && < 8.12,-    mtl              >= 2.0    && < 2.3,-    syb              >= 0.3    && < 0.8,-    HsYAML-aeson     >=0.2.0   && < 0.3,-    HsYAML           >=0.2.0   && < 0.3+    optparse-applicative >= 0.12 && < 0.18  Test-suite stylish-haskell-tests-  Ghc-options:      -Wall-  Hs-source-dirs:   tests lib-  Main-is:          TestSuite.hs-  Type:             exitcode-stdio-1.0-  Default-language: Haskell2010+  Import:         depends+  Hs-source-dirs: tests+  Main-is:        TestSuite.hs+  Type:           exitcode-stdio-1.0    Other-modules:-    Language.Haskell.Stylish-    Language.Haskell.Stylish.Align-    Language.Haskell.Stylish.Block-    Language.Haskell.Stylish.Config-    Language.Haskell.Stylish.Config.Cabal-    Language.Haskell.Stylish.Config.Internal     Language.Haskell.Stylish.Config.Tests-    Language.Haskell.Stylish.Editor-    Language.Haskell.Stylish.GHC-    Language.Haskell.Stylish.Ordering-    Language.Haskell.Stylish.Module-    Language.Haskell.Stylish.Parse     Language.Haskell.Stylish.Parse.Tests-    Language.Haskell.Stylish.Printer-    Language.Haskell.Stylish.Step-    Language.Haskell.Stylish.Step.Imports-    Language.Haskell.Stylish.Step.Imports.Tests-    Language.Haskell.Stylish.Step.Imports.FelixTests-    Language.Haskell.Stylish.Step.Data+    Language.Haskell.Stylish.Regressions     Language.Haskell.Stylish.Step.Data.Tests-    Language.Haskell.Stylish.Step.ModuleHeader-    Language.Haskell.Stylish.Step.ModuleHeader.Tests-    Language.Haskell.Stylish.Step.LanguagePragmas+    Language.Haskell.Stylish.Step.Imports.FelixTests+    Language.Haskell.Stylish.Step.Imports.Tests     Language.Haskell.Stylish.Step.LanguagePragmas.Tests-    Language.Haskell.Stylish.Step.SimpleAlign+    Language.Haskell.Stylish.Step.ModuleHeader.Tests     Language.Haskell.Stylish.Step.SimpleAlign.Tests-    Language.Haskell.Stylish.Step.Squash     Language.Haskell.Stylish.Step.Squash.Tests-    Language.Haskell.Stylish.Step.Tabs     Language.Haskell.Stylish.Step.Tabs.Tests-    Language.Haskell.Stylish.Step.TrailingWhitespace     Language.Haskell.Stylish.Step.TrailingWhitespace.Tests-    Language.Haskell.Stylish.Step.UnicodeSyntax     Language.Haskell.Stylish.Step.UnicodeSyntax.Tests-    Language.Haskell.Stylish.Regressions     Language.Haskell.Stylish.Tests     Language.Haskell.Stylish.Tests.Util-    Language.Haskell.Stylish.Util-    Language.Haskell.Stylish.Verbose-    Paths_stylish_haskell -  Autogen-modules:-    Paths_stylish_haskell-   Build-depends:-    HUnit                >= 1.2 && < 1.7,-    test-framework       >= 0.4 && < 0.9,-    test-framework-hunit >= 0.2 && < 0.4,+    stylish-haskell,+    HUnit                >= 1.2   && < 1.7,     random               >= 1.1,-    -- Copied from regular dependencies...-    aeson            >= 0.6    && < 1.6,-    base             >= 4.8    && < 5,-    bytestring       >= 0.9    && < 0.11,-    Cabal            >= 2.4    && < 3.3,-    containers       >= 0.3    && < 0.7,-    directory        >= 1.2.3  && < 1.4,-    filepath         >= 1.1    && < 1.5,-    file-embed       >= 0.0.10 && < 0.1,-    ghc-lib-parser   >= 8.10   && < 8.12,-    mtl              >= 2.0    && < 2.3,-    syb              >= 0.3    && < 0.8,-    text             >= 1.2    && < 1.3,-    HsYAML-aeson     >=0.2.0   && < 0.3,-    HsYAML           >=0.2.0   && < 0.3+    test-framework       >= 0.4   && < 0.9,+    test-framework-hunit >= 0.2   && < 0.4,  Source-repository head   Type:     git

@@ -137,7 +137,7 @@   , "license:         BSD3"   , "author:          Angela Author"   , "build-type:      Simple"-  , "cabal-version:   >= 1.2"+  , "cabal-version:   >= 1.10"   , ""   , "library"   , "   build-depends:   HUnit"

@@ -5,31 +5,30 @@   ) where  import           Language.Haskell.Stylish.Step.Imports-import           Language.Haskell.Stylish.Tests.Util (testStep)+import           Language.Haskell.Stylish.Tests.Util (assertSnippet) import           Test.Framework                      (Test, testGroup) import           Test.Framework.Providers.HUnit      (testCase)-import           Test.HUnit                          (Assertion, (@=?))+import           Test.HUnit                          (Assertion)   tests :: Test tests = testGroup "Language.Haskell.Stylish.Regressions"     [ testCase "case 00 (#198)" case00     ]+ -- | Error parsing '(,) #198 -- -- See https://github.com/haskell/stylish-haskell/issues/198 case00 :: Assertion-case00 = expected @=? testStep (step (Just 80) $ importStepConfig Global) input+case00 = assertSnippet (step (Just 80) $ importStepConfig Global) input input   where-    input = unlines+    input =       [ "{-# LANGUAGE TemplateHaskell #-}"       , ""       , "import           Language.Haskell.TH.Syntax"       , ""       , "main = print $ showName '(,)"       ]--    expected = input  importStepConfig :: ImportAlign -> Options importStepConfig align = defaultOptions { importAlign = align }

@@ -5,10 +5,10 @@     ) where  import           Language.Haskell.Stylish.Step.Data-import           Language.Haskell.Stylish.Tests.Util (assertSnippet, testStep)+import           Language.Haskell.Stylish.Tests.Util (assertSnippet) import           Test.Framework                      (Test, testGroup) import           Test.Framework.Providers.HUnit      (testCase)-import           Test.HUnit                          (Assertion, (@=?))+import           Test.HUnit                          (Assertion)  tests :: Test tests = testGroup "Language.Haskell.Stylish.Step.Data.Tests"@@ -75,182 +75,159 @@     , testCase "case 60" case60     , testCase "case 61 (issue 282)" case61     , testCase "case 62 (issue 273)" case62+    , testCase "case 63 (issue 338)" case63+    , testCase "case 64" case64+    , testCase "case 65" case65     ]  case00 :: Assertion-case00 = expected @=? testStep (step sameSameStyle) input+case00 = assertSnippet (step sameSameStyle) input input   where-    input = unlines-      [ "module Herp where"-      , ""-      , "data Foo"-      ]--    expected = input+    input =+        [ "module Herp where"+        , ""+        , "data Foo"+        ]  case01 :: Assertion-case01 = expected @=? testStep (step indentIndentStyle) input-  where-    input = unlines-      [ "module Herp where"-      , ""-      , "data Foo = Foo { a :: Int }"-      ]--    expected = unlines-       [ "module Herp where"-       , ""-       , "data Foo"-       , "  = Foo"-       , "      { a :: Int"-       , "      }"-       ]+case01 = assertSnippet (step indentIndentStyle)+    [ "module Herp where"+    , ""+    , "data Foo = Foo { a :: Int }"+    ]+    [ "module Herp where"+    , ""+    , "data Foo"+    , "  = Foo"+    , "      { a :: Int"+    , "      }"+    ]  case02 :: Assertion-case02 = expected @=? testStep (step indentIndentStyle) input-  where-    input = unlines-      [ "module Herp where"-      , ""-      , "data Foo = Foo { a :: Int, a2 :: String }"-      ]-    expected = unlines-       [ "module Herp where"-       , ""-       , "data Foo"-       , "  = Foo"-       , "      { a :: Int"-       , "      , a2 :: String"-       , "      }"-       ]+case02 = assertSnippet (step indentIndentStyle)+    [ "module Herp where"+    , ""+    , "data Foo = Foo { a :: Int, a2 :: String }"+    ]+    [ "module Herp where"+    , ""+    , "data Foo"+    , "  = Foo"+    , "      { a :: Int"+    , "      , a2 :: String"+    , "      }"+    ]  case03 :: Assertion-case03 = expected @=? testStep (step indentIndentStyle) input-  where-    input = unlines-      [ "module Herp where"-      , ""-      , "data Foo a = Foo { a :: a, a2 :: String }"-      ]-    expected = unlines-       [ "module Herp where"-       , ""-       , "data Foo a"-       , "  = Foo"-       , "      { a :: a"-       , "      , a2 :: String"-       , "      }"-       ]+case03 = assertSnippet (step indentIndentStyle)+    [ "module Herp where"+    , ""+    , "data Foo a = Foo { a :: a, a2 :: String }"+    ]+    [ "module Herp where"+    , ""+    , "data Foo a"+    , "  = Foo"+    , "      { a :: a"+    , "      , a2 :: String"+    , "      }"+    ]  case04 :: Assertion-case04 = expected @=? testStep (step indentIndentStyle) input-  where-    input = unlines-      [ "module Herp where"-      , ""-      , "data Foo a = Foo { a :: a, a2 :: String } | Bar { b :: a }"-      ]-    expected = unlines-       [ "module Herp where"-       , ""-       , "data Foo a"-       , "  = Foo"-       , "      { a :: a"-       , "      , a2 :: String"-       , "      }"-       , "  | Bar"-       , "      { b :: a"-       , "      }"-       ]+case04 = assertSnippet (step indentIndentStyle)+    [ "module Herp where"+    , ""+    , "data Foo a = Foo { a :: a, a2 :: String } | Bar { b :: a }"+    ]+    [ "module Herp where"+    , ""+    , "data Foo a"+    , "  = Foo"+    , "      { a :: a"+    , "      , a2 :: String"+    , "      }"+    , "  | Bar"+    , "      { b :: a"+    , "      }"+    ]  case05 :: Assertion-case05 = expected @=? testStep (step indentIndentStyle) input-  where-    input = unlines-       [ "module Herp where"-       , ""-       , "data Foo = Foo {"-       , "  a :: Int"-       , "  , a2 :: String"-       , "  }"-       ]-    expected = unlines-       [ "module Herp where"-       , ""-       , "data Foo"-       , "  = Foo"-       , "      { a :: Int"-       , "      , a2 :: String"-       , "      }"-       ]+case05 = assertSnippet (step indentIndentStyle)+    [ "module Herp where"+    , ""+    , "data Foo = Foo {"+    , "  a :: Int"+    , "  , a2 :: String"+    , "  }"+    ]+    [ "module Herp where"+    , ""+    , "data Foo"+    , "  = Foo"+    , "      { a :: Int"+    , "      , a2 :: String"+    , "      }"+    ]  case06 :: Assertion-case06 = expected @=? testStep (step sameSameStyle) input+case06 = assertSnippet (step sameSameStyle) input input   where-    input = unlines-      [ "module Herp where"-      , ""-      , "data Foo = Foo Int String"-      ]-    expected = input+    input =+        [ "module Herp where"+        , ""+        , "data Foo = Foo Int String"+        ]  case07 :: Assertion-case07 = expected @=? testStep (step sameSameStyle) input+case07 = assertSnippet (step sameSameStyle) input input   where-    input = unlines-      [ "module Herp where"-      , ""-      , "data Phantom a = Phantom"-      ]-    expected = input+    input =+        [ "module Herp where"+        , ""+        , "data Phantom a = Phantom"+        ]  case08 :: Assertion-case08 = expected @=? testStep (step sameSameStyle) input-  where-    input = unlines-      [ "module Herp where"-      , ""-      , "data Phantom a ="-      , "  Phantom"-      ]-    expected = unlines-      [ "module Herp where"-      , ""-      , "data Phantom a = Phantom"-      ]+case08 = assertSnippet (step sameSameStyle)+    [ "module Herp where"+    , ""+    , "data Phantom a ="+    , "  Phantom"+    ]+    [ "module Herp where"+    , ""+    , "data Phantom a = Phantom"+    ]  case09 :: Assertion-case09 = expected @=? testStep (step indentIndentStyle4) input-  where-    input = unlines-      [ "module Herp where"-      , ""-      , "data Foo a b = Foo { a :: a, a2 :: String } | Bar { b :: a, c:: b }"-      ]-    expected = unlines-       [ "module Herp where"-       , ""-       , "data Foo a b"-       , "    = Foo"-       , "          { a :: a"-       , "          , a2 :: String"-       , "          }"-       , "    | Bar"-       , "          { b :: a"-       , "          , c :: b"-       , "          }"-       ]+case09 = assertSnippet (step indentIndentStyle4)+    [ "module Herp where"+    , ""+    , "data Foo a b = Foo { a :: a, a2 :: String } | Bar { b :: a, c:: b }"+    ]+    [ "module Herp where"+    , ""+    , "data Foo a b"+    , "    = Foo"+    , "          { a :: a"+    , "          , a2 :: String"+    , "          }"+    , "    | Bar"+    , "          { b :: a"+    , "          , c :: b"+    , "          }"+    ]  case10 :: Assertion-case10 = expected @=? testStep (step indentIndentStyle) input+case10 = assertSnippet (step indentIndentStyle) input expected   where-    input = unlines+    input =       [ "module Herp where"       , ""       , "data Foo = Foo { a :: Int } deriving (Eq, Generic) deriving (Show)"       ] -    expected = unlines+    expected =        [ "module Herp where"        , ""        , "data Foo"@@ -262,16 +239,16 @@        ]  case11 :: Assertion-case11 = expected @=? testStep (step indentIndentStyle) input+case11 = assertSnippet (step indentIndentStyle) input expected   where-    input = unlines+    input =       [ "{-# LANGUAGE DerivingStrategies #-}"       , "module Herp where"       , ""       , "data Foo = Foo { a :: Int } deriving stock (Show)"       ] -    expected = unlines+    expected =        [ "{-# LANGUAGE DerivingStrategies #-}"        , "module Herp where"        , ""@@ -283,15 +260,15 @@        ]  case12 :: Assertion-case12 = expected @=? testStep (step indentIndentStyle4) input+case12 = assertSnippet (step indentIndentStyle4) input expected   where-    input = unlines+    input =       [ "module Herp where"       , ""       , "data Point = Point { pointX, pointY :: Double , pointName :: String} deriving (Show)"       ] -    expected = unlines+    expected =        [ "module Herp where"        , ""        , "data Point"@@ -303,15 +280,15 @@        ]  case13 :: Assertion-case13 = expected @=? testStep (step indentIndentStyle) input+case13 = assertSnippet (step indentIndentStyle) input expected   where-    input = unlines+    input =       [ "module Herp where"       , ""       , "-- this is a comment"       , "data Foo = Foo { a :: Int }"       ]-    expected = unlines+    expected =       [ "module Herp where"       , ""       , "-- this is a comment"@@ -322,16 +299,16 @@       ]  case14 :: Assertion-case14 = expected @=? testStep (step indentIndentStyle) input+case14 = assertSnippet (step indentIndentStyle) input expected   where-    input = unlines+    input =       [ "module Herp where"       , ""       , "{- this is"       , "   a comment -}"       , "data Foo = Foo { a :: Int }"       ]-    expected = unlines+    expected =       [ "module Herp where"       , ""       , "{- this is"@@ -343,122 +320,108 @@       ]  case15 :: Assertion-case15 = expected @=? testStep (step indentIndentStyle) input-  where-    input = unlines-       [ "module Herp where"-       , ""-       , "data Foo a = Foo"-       , "  { a :: a, -- comment"-       , "   a2 :: String"-       , "  }"-       ]-    expected = unlines-       [ "module Herp where"-       , ""-       , "data Foo a"-       , "  = Foo"-       , "      { a :: a -- comment"-       , "      , a2 :: String"-       , "      }"-       ]+case15 = assertSnippet (step indentIndentStyle)+    [ "module Herp where"+    , ""+    , "data Foo a = Foo"+    , "  { a :: a, -- comment"+    , "   a2 :: String"+    , "  }"+    ]+    [ "module Herp where"+    , ""+    , "data Foo a"+    , "  = Foo"+    , "      { a :: a"+    , "        -- comment"+    , "      , a2 :: String"+    , "      }"+    ]  case16 :: Assertion-case16 = expected @=? testStep (step indentIndentStyle) input-  where-    input = unlines-      [ "module Herp where"-      , ""-      , "data Foo = Foo {"-      , "   a :: Int -- ^ comment"-      , "  }"-      ]-    expected = unlines-      [ "module Herp where"-      , ""-      , "data Foo"-      , "  = Foo"-      , "      { a :: Int"-      , "        -- ^ comment"-      , "      }"-      ]+case16 = assertSnippet (step indentIndentStyle)+    [ "module Herp where"+    , ""+    , "data Foo = Foo {"+    , "   a :: Int -- ^ comment"+    , "  }"+    ]+    [ "module Herp where"+    , ""+    , "data Foo"+    , "  = Foo"+    , "      { a :: Int"+    , "        -- ^ comment"+    , "      }"+    ]  case17 :: Assertion-case17 = expected @=? testStep (step indentIndentStyle) input-  where-    input = unlines-       [ "module Herp where"-       , ""-       , "data Foo a = Foo"-       , "  { a :: a,"-       , "-- comment"-       , "   a2 :: String"-       , "  }"-       ]-    expected = unlines-       [ "module Herp where"-       , ""-       , "data Foo a"-       , "  = Foo"-       , "      { a :: a"-       , "        -- comment"-       , "      , a2 :: String"-       , "      }"-       ]+case17 = assertSnippet (step indentIndentStyle)+    [ "module Herp where"+    , ""+    , "data Foo a = Foo"+    , "  { a :: a,"+    , "-- comment"+    , "   a2 :: String"+    , "  }"+    ]+    [ "module Herp where"+    , ""+    , "data Foo a"+    , "  = Foo"+    , "      { a :: a"+    , "        -- comment"+    , "      , a2 :: String"+    , "      }"+    ]  case18 :: Assertion-case18 = expected @=? testStep (step indentIndentStyle) input-  where-    input = unlines-       [ "module Herp where"-       , ""-       , "data Foo a = Foo"-       , "  { a :: a,"-       , "-- ^ comment"-       , "   a2 :: String"-       , "  }"-       ]-    expected = unlines-       [ "module Herp where"-       , ""-       , "data Foo a"-       , "  = Foo"-       , "      { a :: a"-       , "        -- ^ comment"-       , "      , a2 :: String"-       , "      }"-       ]+case18 = assertSnippet (step indentIndentStyle)+    [ "module Herp where"+    , ""+    , "data Foo a = Foo"+    , "  { a :: a,"+    , "-- ^ comment"+    , "   a2 :: String"+    , "  }"+    ]+    [ "module Herp where"+    , ""+    , "data Foo a"+    , "  = Foo"+    , "      { a :: a"+    , "        -- ^ comment"+    , "      , a2 :: String"+    , "      }"+    ]  case19 :: Assertion-case19 = expected @=? testStep (step indentIndentStyle) input-  where-    input = unlines-       [ "module Herp where"-       , ""-       , "data Foo a = Foo"-       , "  { firstName, lastName :: String,"-       , "-- ^ names"-       , "   age :: Int"-       , "  }"-       ]-    expected = unlines-       [ "module Herp where"-       , ""-       , "data Foo a"-       , "  = Foo"-       , "      { firstName, lastName :: String"-       , "        -- ^ names"-       , "      , age :: Int"-       , "      }"-       ]+case19 = assertSnippet (step indentIndentStyle)+    [ "module Herp where"+    , ""+    , "data Foo a = Foo"+    , "  { firstName, lastName :: String,"+    , "-- ^ names"+    , "   age :: Int"+    , "  }"+    ]+    [ "module Herp where"+    , ""+    , "data Foo a"+    , "  = Foo"+    , "      { firstName, lastName :: String"+    , "        -- ^ names"+    , "      , age :: Int"+    , "      }"+    ]  -- | Should not break Enums (data without records) formatting -- -- See https://github.com/haskell/stylish-haskell/issues/262 case20 :: Assertion-case20 = input @=? testStep (step indentIndentStyle) input+case20 = assertSnippet (step indentIndentStyle) input input   where-    input = unlines+    input =        [ "module Herp where"        , ""        , "data Tag = Title | Text deriving (Eq, Show)"@@ -466,98 +429,94 @@  case21 :: Assertion case21 = assertSnippet (step sameSameStyle)-   [ "data Foo a"-   , "  = Foo { a :: Int,"-   , "          a2 :: String"-   , "          -- ^ some haddock"-   , "        }"-   , "  | Bar { b :: a }  deriving (Eq, Show)"-   , "  deriving (ToJSON)"-   ]-   [ "data Foo a = Foo { a :: Int"-   , "                 , a2 :: String"-   , "                   -- ^ some haddock"-   , "                 }"-   , "           | Bar { b :: a"-   , "                 }"-   , "  deriving (Eq, Show)"-   , "  deriving (ToJSON)"-   ]+    [ "data Foo a"+    , "  = Foo { a :: Int,"+    , "          a2 :: String"+    , "          -- ^ some haddock"+    , "        }"+    , "  | Bar { b :: a }  deriving (Eq, Show)"+    , "  deriving (ToJSON)"+    ]+    [ "data Foo a = Foo { a :: Int"+    , "                 , a2 :: String"+    , "                   -- ^ some haddock"+    , "                 }"+    , "           | Bar { b :: a"+    , "                 }"+    , "  deriving (Eq, Show)"+    , "  deriving (ToJSON)"+    ]  case22 :: Assertion case22 = assertSnippet (step sameIndentStyle)-   [ "data Foo a"-   , "  = Foo { a :: Int,"-   , "          a2 :: String"-   , "          -- ^ some haddock"-   , "        }"-   , "  | Bar { b :: a }  deriving (Eq, Show)"-   , "  deriving (ToJSON)"-   ]-   [ "data Foo a = Foo"-   , "               { a :: Int"-   , "               , a2 :: String"-   , "                 -- ^ some haddock"-   , "               }"-   , "           | Bar"-   , "               { b :: a"-   , "               }"-   , "  deriving (Eq, Show)"-   , "  deriving (ToJSON)"-   ]+    [ "data Foo a"+    , "  = Foo { a :: Int,"+    , "          a2 :: String"+    , "          -- ^ some haddock"+    , "        }"+    , "  | Bar { b :: a }  deriving (Eq, Show)"+    , "  deriving (ToJSON)"+    ]+    [ "data Foo a = Foo"+    , "               { a :: Int"+    , "               , a2 :: String"+    , "                 -- ^ some haddock"+    , "               }"+    , "           | Bar"+    , "               { b :: a"+    , "               }"+    , "  deriving (Eq, Show)"+    , "  deriving (ToJSON)"+    ]  case23 :: Assertion case23 = assertSnippet (step indentSameStyle)-   [ "data Foo a"-   , "  = Foo { a :: Int,"-   , "          a2 :: String"-   , "          -- ^ some haddock"-   , "        }"-   , "  | Bar { b :: a }  deriving (Eq, Show)"-   , "  deriving (ToJSON)"-   ]-   [ "data Foo a"-   , "  = Foo { a :: Int"-   , "        , a2 :: String"-   , "          -- ^ some haddock"-   , "        }"-   , "  | Bar { b :: a"-   , "        }"-   , "  deriving (Eq, Show)"-   , "  deriving (ToJSON)"-   ]+    [ "data Foo a"+    , "  = Foo { a :: Int,"+    , "          a2 :: String"+    , "          -- ^ some haddock"+    , "        }"+    , "  | Bar { b :: a }  deriving (Eq, Show)"+    , "  deriving (ToJSON)"+    ]+    [ "data Foo a"+    , "  = Foo { a :: Int"+    , "        , a2 :: String"+    , "          -- ^ some haddock"+    , "        }"+    , "  | Bar { b :: a"+    , "        }"+    , "  deriving (Eq, Show)"+    , "  deriving (ToJSON)"+    ]  case24 :: Assertion-case24 = expected @=? testStep (step indentIndentStyle) input-  where-    input = unlines-       [ "data Foo a"-       , "  = Foo { a :: Int,"-       , "          a2 :: String"-       , "          -- ^ some haddock"-       , "        }"-       , "  | Bar { b :: a }  deriving (Eq, Show)"-       , "  deriving (ToJSON)"-       ]--    expected = unlines-       [ "data Foo a"-       , "  = Foo"-       , "      { a :: Int"-       , "      , a2 :: String"-       , "        -- ^ some haddock"-       , "      }"-       , "  | Bar"-       , "      { b :: a"-       , "      }"-       , "  deriving (Eq, Show)"-       , "  deriving (ToJSON)"-       ]+case24 = assertSnippet (step indentIndentStyle)+    [ "data Foo a"+    , "  = Foo { a :: Int,"+    , "          a2 :: String"+    , "          -- ^ some haddock"+    , "        }"+    , "  | Bar { b :: a }  deriving (Eq, Show)"+    , "  deriving (ToJSON)"+    ]+    [ "data Foo a"+    , "  = Foo"+    , "      { a :: Int"+    , "      , a2 :: String"+    , "        -- ^ some haddock"+    , "      }"+    , "  | Bar"+    , "      { b :: a"+    , "      }"+    , "  deriving (Eq, Show)"+    , "  deriving (ToJSON)"+    ]  case25 :: Assertion-case25 = expected @=? testStep (step indentIndentStyle { cBreakSingleConstructors = False }) input+case25 = assertSnippet (step indentIndentStyle { cBreakSingleConstructors = False }) input expected   where-    input = unlines+    input =        [ "data Foo a"        , "  = Foo { a :: Int,"        , "          a2 :: String"@@ -567,7 +526,7 @@        , "  deriving (ToJSON)"        ] -    expected = unlines+    expected =        [ "data Foo a = Foo"        , "  { a :: Int"        , "  , a2 :: String"@@ -578,15 +537,15 @@        ]  case26 :: Assertion-case26 = expected @=? testStep (step indentIndentStyle) input+case26 = assertSnippet (step indentIndentStyle) input expected   where-    input = unlines+    input =       [ "module Herp where"       , ""       , "data Foo = Foo { a :: Int } deriving (FromJSON) via Bla Foo"       ] -    expected = unlines+    expected =        [ "module Herp where"        , ""        , "data Foo"@@ -597,15 +556,15 @@        ]  case27 :: Assertion-case27 = expected @=? testStep (step sameIndentStyle { cBreakEnums = True }) input+case27 = assertSnippet (step sameIndentStyle { cBreakEnums = True }) input expected   where-    input = unlines+    input =       [ "module Herp where"       , ""       , "data Foo = Foo | Bar | Baz deriving (Eq, Show)"       ] -    expected = unlines+    expected =       [ "module Herp where"       , ""       , "data Foo"@@ -616,9 +575,9 @@       ]  case28 :: Assertion-case28 = expected @=? testStep (step sameIndentStyle { cBreakEnums = True }) input+case28 = assertSnippet (step sameIndentStyle { cBreakEnums = True }) input expected   where-    input = unlines+    input =       [ "module Some.Types where"       , ""       , "newtype BankCode = BankCode {"@@ -644,7 +603,7 @@       , "  deriving (ToJSON, FromJSON) via SnakeCaseCapsEnumEncoding MandateStatus"       ] -    expected = unlines+    expected =       [ "module Some.Types where"       , ""       , "newtype BankCode = BankCode { unBankCode :: Text }"@@ -669,26 +628,26 @@       ]  case29 :: Assertion-case29 = expected @=? testStep (step sameIndentStyle) input+case29 = assertSnippet (step sameIndentStyle) input expected   where-    input = unlines+    input =       [ "module Some.Types where"       , ""       , "data NonEmpty a"       , "  = a :| [a]"       ] -    expected = unlines+    expected =       [ "module Some.Types where"       , ""       , "data NonEmpty a = a :| [a]"       ]  case30 :: Assertion-case30 = expected @=? testStep (step sameIndentStyle { cBreakEnums = True }) input+case30 = assertSnippet (step sameIndentStyle { cBreakEnums = True }) input expected   where     expected = input-    input = unlines+    input =       [ "data ReasonCode"       , "  = MissingTenantId"       , "  -- Transaction errors:"@@ -709,10 +668,10 @@   case31 :: Assertion-case31 = expected @=? testStep (step indentIndentStyle { cBreakEnums = True }) input+case31 = assertSnippet (step indentIndentStyle { cBreakEnums = True }) input expected   where     expected = input-    input = unlines+    input =       [ "data ConfiguredLogger"       , "  -- | Logs to file"       , "  = LogTo FilePath"@@ -724,10 +683,10 @@       ]  case32 :: Assertion-case32 = expected @=? testStep (step indentIndentStyle { cBreakEnums = True }) input+case32 = assertSnippet (step indentIndentStyle { cBreakEnums = True }) input expected   where     expected = input-    input = unlines+    input =       [ "data RejectionReason"       , "  -- InvalidState"       , "  = CancellationFailed"@@ -742,15 +701,15 @@       ]  case33 :: Assertion-case33 = expected @=? testStep (step indentIndentStyle { cBreakEnums = True, cBreakSingleConstructors = False }) input+case33 = assertSnippet (step indentIndentStyle { cBreakEnums = True, cBreakSingleConstructors = False }) input expected   where-    input = unlines+    input =       [ "module Some.Types where"       , ""       , "newtype NonEmpty a = NonEmpty { unNonEmpty :: a }"       ] -    expected = unlines+    expected =       [ "module Some.Types where"       , ""       , "newtype NonEmpty a"@@ -758,16 +717,16 @@       ]  case34 :: Assertion-case34 = expected @=? testStep (step indentIndentStyle { cVia = Indent 2 }) input+case34 = assertSnippet (step indentIndentStyle { cVia = Indent 2 }) input expected   where-    input = unlines+    input =       [ "module Some.Types where"       , ""       , "newtype NonEmpty a = NonEmpty { unNonEmpty :: a }"       , "     deriving (ToJSON, FromJSON) via Something Magic (NonEmpty a)"       ] -    expected = unlines+    expected =       [ "module Some.Types where"       , ""       , "newtype NonEmpty a"@@ -777,9 +736,9 @@       ]  case35 :: Assertion-case35 = expected @=? testStep (step indentIndentStyle { cBreakEnums = True, cBreakSingleConstructors = False }) input+case35 = assertSnippet (step indentIndentStyle { cBreakEnums = True, cBreakSingleConstructors = False }) input expected   where-    input = unlines+    input =       [ "module Some.Types where"       , ""       , "data Foo = Foo"@@ -789,7 +748,7 @@       , "  }"       ] -    expected = unlines+    expected =       [ "module Some.Types where"       , ""       , "data Foo = Foo"@@ -798,9 +757,9 @@       ]  case36 :: Assertion-case36 = expected @=? testStep (step indentIndentStyle { cBreakEnums = True, cBreakSingleConstructors = False }) input+case36 = assertSnippet (step indentIndentStyle { cBreakEnums = True, cBreakSingleConstructors = False }) input expected   where-    input = unlines+    input =       [ "module Some.Types where"       , ""       , "data Foo = Foo"@@ -810,7 +769,7 @@       , "  }"       ] -    expected = unlines+    expected =       [ "module Some.Types where"       , ""       , "data Foo = Foo"@@ -819,9 +778,9 @@       ]  case37 :: Assertion-case37 = expected @=? testStep (step indentIndentStyle { cVia = Indent 2 }) input+case37 = assertSnippet (step indentIndentStyle { cVia = Indent 2 }) input expected   where-    input = unlines+    input =       [ "module Some.Types where"       , ""       , "newtype UndoFlowData"@@ -833,7 +792,7 @@       , "                     \"reversal_indicator\" := \"Undo\"] FlowDataDetails"       ] -    expected = unlines+    expected =       [ "module Some.Types where"       , ""       , "newtype UndoFlowData"@@ -844,9 +803,9 @@       ]  case38 :: Assertion-case38 = expected @=? testStep (step indentIndentStyle { cVia = Indent 2 }) input+case38 = assertSnippet (step indentIndentStyle { cVia = Indent 2 }) input expected   where-    input = unlines+    input =       [ "data Flat = Flat"       , "  { foo :: Int"       , "  , bar :: Text"@@ -865,7 +824,7 @@       , "      Flat"       ] -    expected = unlines+    expected =       [ "data Flat"       , "  = Flat"       , "      { foo :: Int"@@ -879,9 +838,9 @@       ]  case39 :: Assertion-case39 = expected @=? testStep (step indentIndentStyle { cVia = Indent 2 }) input+case39 = assertSnippet (step indentIndentStyle { cVia = Indent 2 }) input expected   where-    input = unlines+    input =       [ "data CreditTransfer = CreditTransfer"       , "  { nestedCreditorInfo :: CreditorInfo"       , "  }"@@ -902,7 +861,7 @@       , "    )"       ] -    expected = unlines+    expected =       [ "data CreditTransfer"       , "  = CreditTransfer"       , "      { nestedCreditorInfo :: CreditorInfo"@@ -913,27 +872,27 @@       ]  case40 :: Assertion-case40 = expected @=? testStep (step indentIndentStyle { cBreakSingleConstructors = False }) input+case40 = assertSnippet (step indentIndentStyle { cBreakSingleConstructors = False }) input expected   where-    input = unlines+    input =       [ "module X where"       , ""       , "data a :==> b    ="       , "                  Arr a b"       ] -    expected = unlines+    expected =       [ "module X where"       , ""       , "data a :==> b = Arr a b"       ]  case41 :: Assertion-case41 = expected @=? testStep (step indentIndentStyle) input+case41 = assertSnippet (step indentIndentStyle) input expected   where     input = expected -    expected = unlines+    expected =       [ "module X where"       , ""       , "data Callback"@@ -956,11 +915,11 @@       ]  case42 :: Assertion-case42 = expected @=? testStep (step indentIndentStyle) input+case42 = assertSnippet (step indentIndentStyle) input expected   where     input = expected -    expected = unlines+    expected =       [ "module X where"       , ""       , "data SignupError"@@ -970,11 +929,11 @@       ]  case43 :: Assertion-case43 = expected @=? testStep (step indentIndentStyle { cBreakEnums = True, cBreakSingleConstructors = False }) input+case43 = assertSnippet (step indentIndentStyle { cBreakEnums = True, cBreakSingleConstructors = False }) input expected   where     input = expected -    expected = unlines+    expected =       [ "module X where"       , ""       , "data CallbackResult"@@ -993,9 +952,9 @@ -- This means that we've needed to make the decision to put all inline comments -- before the deriving clause itself case44 :: Assertion-case44 = expected @=? testStep (step indentIndentStyle { cBreakEnums = True, cBreakSingleConstructors = False, cVia = Indent 2 }) input+case44 = assertSnippet (step indentIndentStyle { cBreakEnums = True, cBreakSingleConstructors = False, cVia = Indent 2 }) input expected   where-    input = unlines+    input =       [ "module X where"       , ""       , " data CreditTransfer = CreditTransfer"@@ -1012,7 +971,7 @@       , "        ]"       , "        (UntaggedEncoded CreditTransfer)"       ]-    expected = unlines+    expected =       [ "module X where"       , ""       , "data CreditTransfer = CreditTransfer"@@ -1029,10 +988,10 @@       ]  case45 :: Assertion-case45 = expected @=? testStep (step indentIndentStyle { cBreakEnums = True, cBreakSingleConstructors = False, cVia = Indent 2 }) input+case45 = assertSnippet (step indentIndentStyle { cBreakEnums = True, cBreakSingleConstructors = False, cVia = Indent 2 }) input expected   where     input = expected-    expected = unlines+    expected =       [ "module X where"       , ""       , "data CreditTransfer = CreditTransfer"@@ -1049,10 +1008,10 @@       ]  case46 :: Assertion-case46 = expected @=? testStep (step indentIndentStyle { cBreakEnums = True, cBreakSingleConstructors = False, cVia = Indent 2 }) input+case46 = assertSnippet (step indentIndentStyle { cBreakEnums = True, cBreakSingleConstructors = False, cVia = Indent 2 }) input expected   where     input = expected-    expected = unlines+    expected =       [ "module X where"       , ""       , "-- | A format detailing which encoding to use for the settlement events"@@ -1067,10 +1026,10 @@       ]  case47 :: Assertion-case47 = expected @=? testStep (step indentIndentStyle) input+case47 = assertSnippet (step indentIndentStyle) input expected   where     input = expected-    expected = unlines+    expected =       [ "module X where"       , ""       , "-- | A GADT example"@@ -1081,10 +1040,10 @@       ]  case48 :: Assertion-case48 = expected @=? testStep (step indentIndentStyle) input+case48 = assertSnippet (step indentIndentStyle) input expected   where     input = expected-    expected = unlines+    expected =       [ "module X where"       , ""       , "-- | A GADT example"@@ -1095,10 +1054,10 @@       ]  case49 :: Assertion-case49 = expected @=? testStep (step indentIndentStyle) input+case49 = assertSnippet (step indentIndentStyle) input expected   where     input = expected-    expected = unlines+    expected =       [ "module X where"       , ""       , "-- | A GADT example"@@ -1109,10 +1068,10 @@       ]  case50 :: Assertion-case50 = expected @=? testStep (step indentIndentStyle { cCurriedContext = True }) input+case50 = assertSnippet (step indentIndentStyle { cCurriedContext = True }) input expected   where     input = expected-    expected = unlines+    expected =       [ "module X where"       , ""       , "-- | A GADT example"@@ -1123,9 +1082,9 @@       ]  case51 :: Assertion-case51 = expected @=? testStep (step indentIndentStyle { cCurriedContext = True }) input+case51 = assertSnippet (step indentIndentStyle { cCurriedContext = True }) input expected   where-    input = unlines+    input =       [ "module X where"       , ""       , "-- | A GADT example"@@ -1134,7 +1093,7 @@       , "  D2 :: T Bool"       , "  D3 :: forall a. (Eq a) => (a, a) -> T [a]"       ]-    expected = unlines+    expected =       [ "module X where"       , ""       , "-- | A GADT example"@@ -1145,16 +1104,16 @@       ]  case52 :: Assertion-case52 = expected @=? testStep (step indentIndentStyle { cBreakSingleConstructors = False, cCurriedContext = True }) input+case52 = assertSnippet (step indentIndentStyle { cBreakSingleConstructors = False, cCurriedContext = True }) input expected   where-    input = unlines+    input =       [ "module X where"       , ""       , "data Foo = Foo"       , "  { foo :: forall a b. (Eq a, Bounded b) => a -> b -> [(a, b)]"       , "  }"       ]-    expected = unlines+    expected =       [ "module X where"       , ""       , "data Foo = Foo"@@ -1163,14 +1122,14 @@       ]  case53 :: Assertion-case53 = expected @=? testStep (step indentIndentStyle { cMaxColumns = MaxColumns 80 }) input+case53 = assertSnippet (step indentIndentStyle { cMaxColumns = MaxColumns 80 }) input expected   where-    input = unlines+    input =       [ "newtype Foo m a"       , "  = Foo (m a)"       , "  deriving newtype (Functor, Applicative, Monad, MonadError, MonadCatch, Foldable, Monoid)"       ]-    expected = unlines+    expected =       [ "newtype Foo m a"       , "  = Foo (m a)"       , "  deriving newtype"@@ -1185,23 +1144,23 @@       ]  case54 :: Assertion-case54 = expected @=? testStep (step indentIndentStyle { cMaxColumns = MaxColumns 80 }) input+case54 = assertSnippet (step indentIndentStyle { cMaxColumns = MaxColumns 80 }) input expected   where-    input = unlines+    input =       [ "newtype Foo m a"       , "  = Foo (m a)"       , "  deriving newtype (Functor, Applicative, Monad)"       ]-    expected = unlines+    expected =       [ "newtype Foo m a"       , "  = Foo (m a)"       , "  deriving newtype (Applicative, Functor, Monad)"       ]  case55 :: Assertion-case55 = expected @=? testStep (step sameSameNoSortStyle) input+case55 = assertSnippet (step sameSameNoSortStyle) input expected   where-    input = unlines+    input =        [ "data Foo = Foo deriving (Z, Y, X, Bar, Abcd)"        ] @@ -1283,9 +1242,9 @@ -- -- See https://github.com/haskell/stylish-haskell/issues/330 case58 :: Assertion-case58 = expected @=? testStep (step sameIndentStyle) input+case58 = assertSnippet (step sameIndentStyle) input expected   where-    input = unlines+    input =       [ "module Herp where"       , ""       , "data Foo a = Foo"@@ -1315,9 +1274,9 @@ -- -- Regression test for https://github.com/haskell/stylish-haskell/issues/282 case61 :: Assertion-case61 = expected @=? testStep (step sameIndentStyle) input+case61 = assertSnippet (step sameIndentStyle) input expected   where-    input = unlines+    input =       [ "module Herp where"       , ""       , "data Game = Game { _board    :: Board -- ^ Board state"@@ -1328,7 +1287,7 @@       , "                }"       ] -    expected = unlines+    expected =       [ "module Herp where"       , ""       , "data Game = Game"@@ -1349,33 +1308,64 @@ -- -- Regression test for https://github.com/haskell/stylish-haskell/issues/273 case62 :: Assertion-case62 = expected @=? testStep (step sameIndentStyle) input+case62 = assertSnippet (step sameIndentStyle)+    [ "module Herp where"+    , ""+    , "data Foo = Foo"+    , "   { -- | This is a comment above some line."+    , "    -- It can span multiple lines."+    , "     fooName :: String"+    , "   , fooAge :: Int"+    , "     -- ^ This is a comment below some line."+    , "     -- It can span multiple lines."+    , "   }"+    ]+    [ "module Herp where"+    , ""+    , "data Foo = Foo"+    , "             { -- | This is a comment above some line."+    , "               -- It can span multiple lines."+    , "               fooName :: String"+    , "             , fooAge :: Int"+    , "               -- ^ This is a comment below some line."+    , "               -- It can span multiple lines."+    , "             }"+    ]++case63 :: Assertion+case63 = assertSnippet (step indentIndentStyle) input expected   where-    input = unlines+    input =       [ "module Herp where"       , ""-      , "data Foo = Foo"-      , "   { -- | This is a comment above some line."-      , "    -- It can span multiple lines."-      , "     fooName :: String"-      , "   , fooAge :: Int"-      , "     -- ^ This is a comment below some line."-      , "     -- It can span multiple lines."-      , "   }"+      , "data Foo :: * -> * where"+      , "  Bar :: () -> Foo ()"       ]+    expected = input -    expected = unlines-      [ "module Herp where"-      , ""-      , "data Foo = Foo"-      , "             { -- | This is a comment above some line."-      , "             -- It can span multiple lines."-      , "               fooName :: String"-      , "             , fooAge :: Int"-      , "               -- ^ This is a comment below some line."-      , "               -- It can span multiple lines."-      , "             }"-      ]+case64 :: Assertion+case64 = assertSnippet (step indentIndentStyle) input input+  where+    input =+        [ "data Foo"+        , "  = Bar Int"+        , "  -- ^ Following comment"+        , "  | Qux Int"+        , "  -- ^ Second following comment"+        , "  deriving (Show)"+        ]++case65 :: Assertion+case65 = assertSnippet (step indentIndentStyle) input input+  where+    input =+        [ "data Foo"+        , "  = Bar"+        , "  -- ^ Following comment"+        , "  | Qux"+        , "  -- ^ Second following comment"+        , "  deriving (Show)"+        ]  sameSameStyle :: Config sameSameStyle = Config SameLine SameLine 2 2 False True SameLine False True NoMaxColumns

@@ -1,383 +1,321 @@+-------------------------------------------------------------------------------- -- | Tests contributed by Felix Mulder as part of -- <https://github.com/haskell/stylish-haskell/pull/293>.+{-# LANGUAGE OverloadedLists #-} module Language.Haskell.Stylish.Step.Imports.FelixTests   ( tests   ) where + ---------------------------------------------------------------------------------import           GHC.Stack                             (HasCallStack,-                                                        withFrozenCallStack) import           Prelude                               hiding (lines) import           Test.Framework                        (Test, testGroup) import           Test.Framework.Providers.HUnit        (testCase) import           Test.HUnit                            (Assertion) + ---------------------------------------------------------------------------------import           Language.Haskell.Stylish.Module import           Language.Haskell.Stylish.Step.Imports-import           Language.Haskell.Stylish.Tests.Util   (testStep', (@=??))-+import           Language.Haskell.Stylish.Tests.Util   (assertSnippet)   -------------------------------------------------------------------------------- tests :: Test-tests = testGroup "Language.Haskell.Stylish.Step.ImportsGHC"-  [ testCase "Hello world" ex0-  , testCase "Sorted simple" ex1-  , testCase "Sorted import lists" ex2-  , testCase "Sorted import lists and import decls" ex3-  , testCase "Import constructor all" ex4-  , testCase "Import constructor specific" ex5-  , testCase "Import constructor specific sorted" ex6-  , testCase "Imports step does not change rest of file" ex7-  , testCase "Imports respect groups" ex8-  , testCase "Imports respects whitespace between groups" ex9-  , testCase "Doesn't add extra space after 'hiding'" ex10-  , testCase "Should be able to format symbolic imports" ex11-  , testCase "Able to merge equivalent imports" ex12-  , testCase "Obeys max columns setting" ex13-  , testCase "Obeys max columns setting with two in each" ex14-  , testCase "Respects multiple groups" ex15-  , testCase "Doesn't delete nullary imports" ex16-  ]+tests = testGroup "Language.Haskell.Stylish.Step.Imports.FelixTests"+    [ testCase "Hello world" ex0+    , testCase "Sorted simple" ex1+    , testCase "Sorted import lists" ex2+    , testCase "Sorted import lists and import decls" ex3+    , testCase "Import constructor all" ex4+    , testCase "Import constructor specific" ex5+    , testCase "Import constructor specific sorted" ex6+    , testCase "Imports step does not change rest of file" ex7+    , testCase "Imports respect groups" ex8+    , testCase "Imports respects whitespace between groups" ex9+    , testCase "Doesn't add extra space after 'hiding'" ex10+    , testCase "Should be able to format symbolic imports" ex11+    , testCase "Able to merge equivalent imports" ex12+    , testCase "Obeys max columns setting" ex13+    , testCase "Obeys max columns setting with two in each" ex14+    , testCase "Respects multiple groups" ex15+    , testCase "Doesn't delete nullary imports" ex16+    ] + -------------------------------------------------------------------------------- ex0 :: Assertion-ex0 = input `assertFormatted` output-  where-    input =-      [ "import B"-      , "import A"-      ]-    output =-      [ "import           A"-      , "import           B"-      ]+ex0 = assertSnippet (step Nothing felixOptions)+    [ "import B"+    , "import A"+    ]+    [ "import           A"+    , "import           B"+    ]  ex1 :: Assertion-ex1 = input `assertFormatted` output-  where-    input =-      [ "import B"-      , "import A"-      , "import C"-      , "import qualified A"-      , "import qualified B as X"-      ]-    output =-      [ "import           A"-      , "import qualified A"-      , "import           B"-      , "import qualified B as X"-      , "import           C"-      ]+ex1 = assertSnippet (step Nothing felixOptions)+    [ "import B"+    , "import A"+    , "import C"+    , "import qualified A"+    , "import qualified B as X"+    ]+    [ "import           A"+    , "import qualified A"+    , "import           B"+    , "import qualified B as X"+    , "import           C"+    ]  ex2 :: Assertion-ex2 = input `assertFormatted` output-  where-    input =-      [ "import B"-      , "import A (X)"-      , "import C"-      , "import qualified A as Y (Y)"-      ]-    output =-      [ "import           A (X)"-      , "import qualified A as Y (Y)"-      , "import           B"-      , "import           C"-      ]+ex2 = assertSnippet (step Nothing felixOptions)+    [ "import B"+    , "import A (X)"+    , "import C"+    , "import qualified A as Y (Y)"+    ]+    [ "import           A (X)"+    , "import qualified A as Y (Y)"+    , "import           B"+    , "import           C"+    ]  ex3 :: Assertion-ex3 = input `assertFormatted` output-  where-    input =-      [ "import B"-      , "import A (X, Z, Y)"-      , "import C"-      , "import qualified A as A0 (b, Y, a)"-      , "import qualified D as D0 (Y, b, a)"-      , "import qualified E as E0 (b, a, Y)"-      ]-    output =-      [ "import           A (X, Y, Z)"-      , "import qualified A as A0 (Y, a, b)"-      , "import           B"-      , "import           C"-      , "import qualified D as D0 (Y, a, b)"-      , "import qualified E as E0 (Y, a, b)"-      ]+ex3 = assertSnippet (step Nothing felixOptions)+    [ "import B"+    , "import A (X, Z, Y)"+    , "import C"+    , "import qualified A as A0 (b, Y, a)"+    , "import qualified D as D0 (Y, b, a)"+    , "import qualified E as E0 (b, a, Y)"+    ]+    [ "import           A (X, Y, Z)"+    , "import qualified A as A0 (Y, a, b)"+    , "import           B"+    , "import           C"+    , "import qualified D as D0 (Y, a, b)"+    , "import qualified E as E0 (Y, a, b)"+    ]  ex4 :: Assertion-ex4 = input `assertFormatted` output-  where-    input =-      [ "import A (X, Z(..), Y)"-      ]-    output =-      [ "import           A (X, Y, Z (..))"-      ]+ex4 = assertSnippet (step Nothing felixOptions)+    [ "import A (X, Z(..), Y)"+    ]+    [ "import           A (X, Y, Z (..))"+    ]  ex5 :: Assertion-ex5 = input `assertFormatted` output-  where-    input =-      [ "import A (X, Z(Z), Y)"-      ]-    output =-      [ "import           A (X, Y, Z (Z))"-      ]+ex5 = assertSnippet (step Nothing felixOptions)+    [ "import A (X, Z(Z), Y)"+    ]+    [ "import           A (X, Y, Z (Z))"+    ]  ex6 :: Assertion-ex6 = input `assertFormatted` output-  where-    input =-      [ "import A (X, Z(X, Z, Y), Y)"-      ]-    output =-      [ "import           A (X, Y, Z (X, Y, Z))"-      ]+ex6 = assertSnippet (step Nothing felixOptions)+    [ "import A (X, Z(X, Z, Y), Y)"+    ]+    [ "import           A (X, Y, Z (X, Y, Z))"+    ]  ex7 :: Assertion-ex7 = input `assertFormatted` output-  where-    input =-      [ "module Foo (tests) where"-      , "import B"-      , "import A (X, Z, Y)"-      , "import C"-      , "import qualified A as A0 (b, Y, a)"-      , "import qualified D as D0 (Y, b, a)"-      , "import qualified E as E0 (b, a, Y)"-      , "-- hello"-      , "foo :: Int"-      , "foo = 1"-      ]-    output =-      [ "module Foo (tests) where"-      , "import           A (X, Y, Z)"-      , "import qualified A as A0 (Y, a, b)"-      , "import           B"-      , "import           C"-      , "import qualified D as D0 (Y, a, b)"-      , "import qualified E as E0 (Y, a, b)"-      , "-- hello"-      , "foo :: Int"-      , "foo = 1"-      ]+ex7 = assertSnippet (step Nothing felixOptions)+    [ "module Foo (tests) where"+    , "import B"+    , "import A (X, Z, Y)"+    , "import C"+    , "import qualified A as A0 (b, Y, a)"+    , "import qualified D as D0 (Y, b, a)"+    , "import qualified E as E0 (b, a, Y)"+    , "-- hello"+    , "foo :: Int"+    , "foo = 1"+    ]+    [ "module Foo (tests) where"+    , "import           A (X, Y, Z)"+    , "import qualified A as A0 (Y, a, b)"+    , "import           B"+    , "import           C"+    , "import qualified D as D0 (Y, a, b)"+    , "import qualified E as E0 (Y, a, b)"+    , "-- hello"+    , "foo :: Int"+    , "foo = 1"+    ]  ex8 :: Assertion-ex8 = input `assertFormatted` output-  where-    input =-      [ "import B"-      , "-- Group divisor"-      , "import A (X)"-      , "import C"-      , "import qualified  A as Y (Y)"-      ]-    output =-      [ "import           B"-      , "-- Group divisor"-      , "import           A (X)"-      , "import qualified A as Y (Y)"-      , "import           C"-      ]+ex8 = assertSnippet (step Nothing felixOptions)+    [ "import B"+    , "-- Group divisor"+    , "import A (X)"+    , "import C"+    , "import qualified  A as Y (Y)"+    ]+    [ "import           B"+    , "-- Group divisor"+    , "import           A (X)"+    , "import qualified A as Y (Y)"+    , "import           C"+    ]  ex9 :: Assertion-ex9 = input `assertFormatted` output-  where-    input =-      [ "--------"-      , "import B"-      , ""-      , "-- Group divisor"-      , "import A (X)"-      , "import C"-      , "import qualified A as Y (Y)"-      ]-    output =-      [ "--------"-      , "import           B"-      , ""-      , "-- Group divisor"-      , "import           A (X)"-      , "import qualified A as Y (Y)"-      , "import           C"-      ]+ex9 = assertSnippet (step Nothing felixOptions)+    [ "--------"+    , "import B"+    , ""+    , "-- Group divisor"+    , "import A (X)"+    , "import C"+    , "import qualified A as Y (Y)"+    ]+    [ "--------"+    , "import           B"+    , ""+    , "-- Group divisor"+    , "import           A (X)"+    , "import qualified A as Y (Y)"+    , "import           C"+    ]  ex10 :: Assertion-ex10 = input `assertFormatted` output-  where-    input =-      [ "import B         hiding      (X)"-      , "import A  hiding (X)"-      ]-    output =-      [ "import           A hiding (X)"-      , "import           B hiding (X)"-      ]+ex10 = assertSnippet (step Nothing felixOptions)+    [ "import B         hiding      (X)"+    , "import A  hiding (X)"+    ]+    [ "import           A hiding (X)"+    , "import           B hiding (X)"+    ]  ex11 :: Assertion-ex11 = input `assertFormatted` output-  where-    input =-      [ "import Data.Aeson ((.=))"-      , "import A  hiding (X)"-      ]-    output =-      [ "import           A          hiding (X)"-      , "import           Data.Aeson ((.=))"-      ]+ex11 = assertSnippet (step Nothing felixOptions)+    [ "import Data.Aeson ((.=))"+    , "import A  hiding (X)"+    ]+    [ "import           A          hiding (X)"+    , "import           Data.Aeson ((.=))"+    ]  ex12 :: Assertion-ex12 = input `assertFormatted` output-  where-    input =-      [ "import Data.Aeson ((.=))"-      , "import Data.Aeson ((.=))"-      , "import A  hiding (X)"-      ]-    output =-      [ "import           A          hiding (X)"-      , "import           Data.Aeson ((.=))"-      ]+ex12 = assertSnippet (step Nothing felixOptions)+    [ "import Data.Aeson ((.=))"+    , "import Data.Aeson ((.=))"+    , "import A  hiding (X)"+    ]+    [ "import           A          hiding (X)"+    , "import           Data.Aeson ((.=))"+    ]  ex13 :: Assertion-ex13 = input `assertFormattedCols` output-  where-    assertFormattedCols =-      assertFormatted' (Just 10)-    input =-      [ "import Foo (A, B, C, D)"-      , "import A  hiding (X)"-      ]-    output =-      [ "import           A   hiding (X)"-      , "import           Foo (A)"-      , "import           Foo (B)"-      , "import           Foo (C)"-      , "import           Foo (D)"-      ]+ex13 = assertSnippet (step (Just 10) felixOptions)+    [ "import Foo (A, B, C, D)"+    , "import A  hiding (X)"+    ]+    [ "import           A   hiding (X)"+    , "import           Foo (A)"+    , "import           Foo (B)"+    , "import           Foo (C)"+    , "import           Foo (D)"+    ]  ex14 :: Assertion-ex14 = input `assertFormattedCols` output-  where-    assertFormattedCols =-      assertFormatted' (Just 27)-    input =-      [ "import Foo (A, B, C, D)"-      , "import A  hiding (X)"-      ]-    output =-      [ "import           A   hiding (X)"-      , "import           Foo (A, B)"-      , "import           Foo (C, D)"-      ]+ex14 = assertSnippet (step (Just 27) felixOptions)+    [ "import Foo (A, B, C, D)"+    , "import A  hiding (X)"+    ]+    [ "import           A   hiding (X)"+    , "import           Foo (A, B)"+    , "import           Foo (C, D)"+    ]  ex15 :: Assertion-ex15 = input `assertFormattedCols` output-  where-    assertFormattedCols =-      assertFormatted' (Just 100)-    input =-      [ "module Custom.Prelude"-      , "  ( LazyByteString"-      , "  , UUID"-      , "  , decodeUtf8Lenient"-      , "  , error"-      , "  , headMay"-      , "  , module X"-      , "  , nextRandomUUID"-      , "  , onChars"-      , "  , proxyOf"-      , "  , show"-      , "  , showStr"-      , "  , toLazyByteString"-      , "  , toStrictByteString"-      , "  , type (~>)"-      , "  , uuidToText"-      , "  ) where"-      , ""-      , "--------------------------------------------------------------------------------"-      , "import Prelude as X hiding ((!!), appendFile, error, foldl, head, putStrLn, readFile, show, tail, take, unlines, unwords, words, writeFile)"-      , "import qualified Prelude"-      , ""-      , "--------------------------------------------------------------------------------"-      , "import Control.Lens as X ((%~), (&), (.~), (?~), (^.), (^?), _Left, _Right, iat, over, preview, sans, set, to, view)"-      , "import Control.Lens.Extras as X (is)"-      , ""-      , "--------------------------------------------------------------------------------"-      , "import Control.Applicative as X ((<|>))"-      , "import Control.Monad as X ((<=<), (>=>), guard, unless, when)"-      , "import Control.Monad.Except as X (ExceptT (..), MonadError (..), liftEither, runExceptT, withExceptT)"-      , "import Control.Monad.IO.Unlift as X"-      , "import Control.Monad.Reader as X (MonadReader (..), ReaderT (..), asks)"-      , "import Control.Monad.Trans.Class as X (MonadTrans (lift))"-      , "--------------------------------------------------------------------------------"-      ]-    output =-      [ "module Custom.Prelude"-      , "  ( LazyByteString"-      , "  , UUID"-      , "  , decodeUtf8Lenient"-      , "  , error"-      , "  , headMay"-      , "  , module X"-      , "  , nextRandomUUID"-      , "  , onChars"-      , "  , proxyOf"-      , "  , show"-      , "  , showStr"-      , "  , toLazyByteString"-      , "  , toStrictByteString"-      , "  , type (~>)"-      , "  , uuidToText"-      , "  ) where"-      , ""-      , "--------------------------------------------------------------------------------"-      , "import           Prelude                   as X hiding (appendFile, error, foldl, head, putStrLn, readFile, show, tail, take, unlines, unwords, words, writeFile, (!!))"-      , "import qualified Prelude"-      , ""-      , "--------------------------------------------------------------------------------"-      , "import           Control.Lens              as X (_Left, _Right, iat, over, preview, sans, set, to)"-      , "import           Control.Lens              as X (view, (%~), (&), (.~), (?~), (^.), (^?))"-      , "import           Control.Lens.Extras       as X (is)"-      , ""-      , "--------------------------------------------------------------------------------"-      , "import           Control.Applicative       as X ((<|>))"-      , "import           Control.Monad             as X (guard, unless, when, (<=<), (>=>))"-      , "import           Control.Monad.Except      as X (ExceptT (..), MonadError (..), liftEither)"-      , "import           Control.Monad.Except      as X (runExceptT, withExceptT)"-      , "import           Control.Monad.IO.Unlift   as X"-      , "import           Control.Monad.Reader      as X (MonadReader (..), ReaderT (..), asks)"-      , "import           Control.Monad.Trans.Class as X (MonadTrans (lift))"-      , "--------------------------------------------------------------------------------"-      ]+ex15 = assertSnippet (step (Just 100) felixOptions)+    [ "module Custom.Prelude"+    , "  ( LazyByteString"+    , "  , UUID"+    , "  , decodeUtf8Lenient"+    , "  , error"+    , "  , headMay"+    , "  , module X"+    , "  , nextRandomUUID"+    , "  , onChars"+    , "  , proxyOf"+    , "  , show"+    , "  , showStr"+    , "  , toLazyByteString"+    , "  , toStrictByteString"+    , "  , type (~>)"+    , "  , uuidToText"+    , "  ) where"+    , ""+    , "--------------------------------------------------------------------------------"+    , "import Prelude as X hiding ((!!), appendFile, error, foldl, head, putStrLn, readFile, show, tail, take, unlines, unwords, words, writeFile)"+    , "import qualified Prelude"+    , ""+    , "--------------------------------------------------------------------------------"+    , "import Control.Lens as X ((%~), (&), (.~), (?~), (^.), (^?), _Left, _Right, iat, over, preview, sans, set, to, view)"+    , "import Control.Lens.Extras as X (is)"+    , ""+    , "--------------------------------------------------------------------------------"+    , "import Control.Applicative as X ((<|>))"+    , "import Control.Monad as X ((<=<), (>=>), guard, unless, when)"+    , "import Control.Monad.Except as X (ExceptT (..), MonadError (..), liftEither, runExceptT, withExceptT)"+    , "import Control.Monad.IO.Unlift as X"+    , "import Control.Monad.Reader as X (MonadReader (..), ReaderT (..), asks)"+    , "import Control.Monad.Trans.Class as X (MonadTrans (lift))"+    , "--------------------------------------------------------------------------------"+    ]+    [ "module Custom.Prelude"+    , "  ( LazyByteString"+    , "  , UUID"+    , "  , decodeUtf8Lenient"+    , "  , error"+    , "  , headMay"+    , "  , module X"+    , "  , nextRandomUUID"+    , "  , onChars"+    , "  , proxyOf"+    , "  , show"+    , "  , showStr"+    , "  , toLazyByteString"+    , "  , toStrictByteString"+    , "  , type (~>)"+    , "  , uuidToText"+    , "  ) where"+    , ""+    , "--------------------------------------------------------------------------------"+    , "import           Prelude                   as X hiding (appendFile, error, foldl, head, putStrLn, readFile, show, tail, take, unlines, unwords, words, writeFile, (!!))"+    , "import qualified Prelude"+    , ""+    , "--------------------------------------------------------------------------------"+    , "import           Control.Lens              as X (_Left, _Right, iat, over, preview, sans, set, to)"+    , "import           Control.Lens              as X (view, (%~), (&), (.~), (?~), (^.), (^?))"+    , "import           Control.Lens.Extras       as X (is)"+    , ""+    , "--------------------------------------------------------------------------------"+    , "import           Control.Applicative       as X ((<|>))"+    , "import           Control.Monad             as X (guard, unless, when, (<=<), (>=>))"+    , "import           Control.Monad.Except      as X (ExceptT (..), MonadError (..), liftEither)"+    , "import           Control.Monad.Except      as X (runExceptT, withExceptT)"+    , "import           Control.Monad.IO.Unlift   as X"+    , "import           Control.Monad.Reader      as X (MonadReader (..), ReaderT (..), asks)"+    , "import           Control.Monad.Trans.Class as X (MonadTrans (lift))"+    , "--------------------------------------------------------------------------------"+    ]  ex16 :: Assertion-ex16 = input `assertFormatted` output-  where-    input =-      [ "module Foo where"-      , ""-      , "import           B ()"-      , "import           A ()"-      ]-    output =-      [ "module Foo where"-      , ""-      , "import           A ()"-      , "import           B ()"-      ]--assertFormatted :: HasCallStack => Lines -> Lines -> Assertion-assertFormatted = withFrozenCallStack $ assertFormatted' Nothing+ex16 = assertSnippet (step Nothing felixOptions)+    [ "module Foo where"+    , ""+    , "import           B ()"+    , "import           A ()"+    ]+    [ "module Foo where"+    , ""+    , "import           A ()"+    , "import           B ()"+    ] -assertFormatted' :: HasCallStack => Maybe Int -> Lines -> Lines -> Assertion-assertFormatted' maxColumns input expected =-  withFrozenCallStack $ expected @=?? testStep' (step maxColumns felixOptions) input-  where-    felixOptions = defaultOptions-        { listAlign = Repeat-        }+felixOptions :: Options+felixOptions = defaultOptions+    { listAlign = Repeat+    }

@@ -8,7 +8,7 @@ -------------------------------------------------------------------------------- import           Test.Framework                        (Test, testGroup) import           Test.Framework.Providers.HUnit        (testCase)-import           Test.HUnit                            (Assertion, (@=?))+import           Test.HUnit                            (Assertion)   --------------------------------------------------------------------------------@@ -69,6 +69,7 @@     , testCase "case 35" case35     , testCase "case 36" case36     , testCase "case 37" case37+    , testCase "case 38" case38     ]  @@ -600,21 +601,17 @@  -------------------------------------------------------------------------------- case20 :: Assertion-case20 = expected-    @=? testSnippet (step (Just 80) defaultOptions) input'-  where-    expected = Snippet-        [ "import {-# SOURCE #-}           Data.ByteString as BS"-        , "import                qualified Data.Map        as Map"-        , "import                          Data.Set        (empty)"-        , "import {-# SOURCE #-} qualified Data.Text       as T"-        ]-    input' = Snippet-        [ "import {-# SOURCE #-}    Data.ByteString as BS"-        , "import {-# SOURCE #-} qualified Data.Text as T"-        , "import qualified   Data.Map as Map"-        , "import Data.Set (empty)"-        ]+case20 = assertSnippet (step (Just 80) defaultOptions)+    [ "import {-# SOURCE #-}    Data.ByteString as BS"+    , "import {-# SOURCE #-} qualified Data.Text as T"+    , "import qualified   Data.Map as Map"+    , "import Data.Set (empty)"+    ]+    [ "import {-# SOURCE #-}           Data.ByteString as BS"+    , "import                qualified Data.Map        as Map"+    , "import                          Data.Set        (empty)"+    , "import {-# SOURCE #-} qualified Data.Text       as T"+    ]   --------------------------------------------------------------------------------@@ -922,4 +919,14 @@     , "import Data.Aeson qualified as JSON (encode, decode)"     ]     [ "import Data.Aeson qualified as JSON (Value, decode, encode)"+    ]++--------------------------------------------------------------------------------+case38 :: Assertion+case38 = assertSnippet (step (Just 80) $ fromImportAlign File)+    [ "import HSP"+    , "import Happstack.Server"+    ]+    [ "import Happstack.Server"+    , "import HSP"     ]

@@ -8,7 +8,7 @@ -------------------------------------------------------------------------------- import Test.Framework                 (Test, testGroup) import Test.Framework.Providers.HUnit (testCase)-import Test.HUnit                     (Assertion, (@=?))+import Test.HUnit                     (Assertion)   --------------------------------------------------------------------------------@@ -231,22 +231,18 @@  -------------------------------------------------------------------------------- case14 :: Assertion-case14 = expected @=? testStep (step Nothing VerticalCompact False False "language") input-  where-    input = unlines-        [ "{-# LANGUAGE ViewPatterns, OverloadedStrings #-}"-        , "{-# LANGUAGE TemplateHaskell, ViewPatterns #-}"-        , "{-# LANGUAGE ScopedTypeVariables, NoImplicitPrelude #-}"-        , "module Main where"-        ]--    expected = unlines-        [ "{-# language"-        , "    NoImplicitPrelude"-        , "  , OverloadedStrings"-        , "  , ScopedTypeVariables"-        , "  , TemplateHaskell"-        , "  , ViewPatterns"-        , "  #-}"-        , "module Main where"-        ]+case14 = assertSnippet (step Nothing VerticalCompact False False "language")+    [ "{-# LANGUAGE ViewPatterns, OverloadedStrings #-}"+    , "{-# LANGUAGE TemplateHaskell, ViewPatterns #-}"+    , "{-# LANGUAGE ScopedTypeVariables, NoImplicitPrelude #-}"+    , "module Main where"+    ]+    [ "{-# language"+    , "    NoImplicitPrelude"+    , "  , OverloadedStrings"+    , "  , ScopedTypeVariables"+    , "  , TemplateHaskell"+    , "  , ViewPatterns"+    , "  #-}"+    , "module Main where"+    ]

@@ -79,6 +79,8 @@     , testCase "Single two exports, open_bracket = same_line" ex30a     , testCase "Single one export with comment" ex31     , testCase "Single one export with comment, open_bracket = same_line" ex31a+    , testCase "Single one module comment" ex32+    , testCase "Inline comments" ex33     ]  --------------------------------------------------------------------------------@@ -882,6 +884,30 @@     [ "module Foo ("     , "      -- * Foo"     , "      Foo"+    , "    ) where"+    ]++ex32 :: Assertion+ex32 = assertSnippet (step Nothing $ defaultConfig {breakWhere = Single})+    [ "module Foo (bar) where -- Foo"+    ]+    [ "module Foo (bar) where -- Foo"+    ]++ex33 :: Assertion+ex33 = assertSnippet (step Nothing $ defaultConfig)+    [ "module Foo ("+    , "  -- Bar"+    , "  bar, -- Inline bar"+    , "  -- Foo"+    , "  foo -- Inline foo"+    , ") where"+    ]+    [ "module Foo"+    , "    ( -- Bar"+    , "      bar -- Inline bar"+    , "      -- Foo"  -- NOTE(jaspervdj): I would prefer to have the `,` here+    , "    , foo -- Inline foo"     , "    ) where"     ] 

@@ -1,4 +1,5 @@ --------------------------------------------------------------------------------+{-# LANGUAGE OverloadedLists #-} module Language.Haskell.Stylish.Step.Tabs.Tests     ( tests     ) where@@ -7,7 +8,7 @@ -------------------------------------------------------------------------------- import           Test.Framework                 (Test, testGroup) import           Test.Framework.Providers.HUnit (testCase)-import           Test.HUnit                     (Assertion, (@=?))+import           Test.HUnit                     (Assertion)   --------------------------------------------------------------------------------@@ -24,20 +25,16 @@  -------------------------------------------------------------------------------- case01 :: Assertion-case01 = expected @=? testStep (step 4) input-  where-    input = unlines-        [ "module Main"-        , "\t\twhere"-        , "data Foo"-        , "\t= Bar"-        , "    | Qux"-        ]--    expected = unlines-        [ "module Main"-        , "        where"-        , "data Foo"-        , "    = Bar"-        , "    | Qux"-        ]+case01 = assertSnippet (step 4)+    [ "module Main"+    , "\t\twhere"+    , "data Foo"+    , "\t= Bar"+    , "    | Qux"+    ]+    [ "module Main"+    , "        where"+    , "data Foo"+    , "    = Bar"+    , "    | Qux"+    ]

@@ -1,4 +1,5 @@ --------------------------------------------------------------------------------+{-# LANGUAGE OverloadedLists #-} module Language.Haskell.Stylish.Step.TrailingWhitespace.Tests     ( tests     ) where@@ -7,7 +8,7 @@ -------------------------------------------------------------------------------- import           Test.Framework                         (Test, testGroup) import           Test.Framework.Providers.HUnit         (testCase)-import           Test.HUnit                             (Assertion, (@=?))+import           Test.HUnit                             (Assertion)   --------------------------------------------------------------------------------@@ -24,20 +25,16 @@  -------------------------------------------------------------------------------- case01 :: Assertion-case01 = expected @=? testStep step input-  where-    input = unlines-        [ "module Main where"-        , " \t"-        , "data Foo = Bar | Qux\t "-        , "\12"    -- page break-        , "   \12" -- malformed page break-        ]--    expected = unlines-        [ "module Main where"-        , ""-        , "data Foo = Bar | Qux"-        , "\12" -- page break-        , ""-        ]+case01 = assertSnippet step+    [ "module Main where"+    , " \t"+    , "data Foo = Bar | Qux\t "+    , "\12"    -- page break+    , "   \12" -- malformed page break+    ]+    [ "module Main where"+    , ""+    , "data Foo = Bar | Qux"+    , "\12" -- page break+    , ""+    ]

@@ -1,13 +1,14 @@ --------------------------------------------------------------------------------+{-# LANGUAGE OverloadedLists #-} module Language.Haskell.Stylish.Step.UnicodeSyntax.Tests     ( tests     ) where   ---------------------------------------------------------------------------------import           Test.Framework                    (Test, testGroup)-import           Test.Framework.Providers.HUnit    (testCase)-import           Test.HUnit                        (Assertion, (@=?))+import           Test.Framework                              (Test, testGroup)+import           Test.Framework.Providers.HUnit              (testCase)+import           Test.HUnit                                  (Assertion)   --------------------------------------------------------------------------------@@ -25,31 +26,23 @@  -------------------------------------------------------------------------------- case01 :: Assertion-case01 = expected @=? testStep (step True "LANGUAGE") input-  where-    input = unlines-        [ "sort :: Ord a => [a] -> [a]"-        , "sort _ = []"-        ]--    expected = unlines-        [ "{-# LANGUAGE UnicodeSyntax #-}"-        , "sort ∷ Ord a ⇒ [a] → [a]"-        , "sort _ = []"-        ]+case01 = assertSnippet (step True "LANGUAGE")+    [ "sort :: Ord a => [a] -> [a]"+    , "sort _ = []"+    ]+    [ "{-# LANGUAGE UnicodeSyntax #-}"+    , "sort ∷ Ord a ⇒ [a] → [a]"+    , "sort _ = []"+    ]   -------------------------------------------------------------------------------- case02 :: Assertion-case02 = expected @=? testStep (step True "LaNgUaGe") input-  where-    input = unlines-        [ "sort :: Ord a => [a] -> [a]"-        , "sort _ = []"-        ]--    expected = unlines-        [ "{-# LaNgUaGe UnicodeSyntax #-}"-        , "sort ∷ Ord a ⇒ [a] → [a]"-        , "sort _ = []"-        ]+case02 = assertSnippet (step True "LaNgUaGe")+    [ "sort :: Ord a => [a] -> [a]"+    , "sort _ = []"+    ]+    [ "{-# LaNgUaGe UnicodeSyntax #-}"+    , "sort ∷ Ord a ⇒ [a] → [a]"+    , "sort _ = []"+    ]

@@ -1,16 +1,18 @@ --------------------------------------------------------------------------------+{-# LANGUAGE LambdaCase #-} module Language.Haskell.Stylish.Tests     ( tests     ) where   ---------------------------------------------------------------------------------import           Data.List                           (sort)+import           Data.List                           (isInfixOf, sort) import           System.Directory                    (createDirectory) import           System.FilePath                     (normalise, (</>)) import           Test.Framework                      (Test, testGroup) import           Test.Framework.Providers.HUnit      (testCase)-import           Test.HUnit                          (Assertion, (@?=))+import           Test.HUnit                          (Assertion, assertFailure,+                                                      (@?=))   --------------------------------------------------------------------------------@@ -93,15 +95,21 @@                    , "               }"                    ] + -------------------------------------------------------------------------------- case04 :: Assertion-case04 = (@?= result) =<< format Nothing (Just fileLocation) input+case04 = format Nothing (Just fileLocation) input >>= \case+    Right _                      -> assertFailure "expected error"+    Left err+        | fileLocation `isInfixOf` err+        , needle `isInfixOf` err -> pure ()+        | otherwise              ->+            assertFailure $ "Unexpected error: " ++ show err   where-    fileLocation = "directory/File.hs"     input = "module Herp"-    result = Left $-      fileLocation <> ": RealSrcSpan SrcSpanPoint \"directory/File.hs\" 2 1:" -      <> " parse error (possibly incorrect indentation or mismatched brackets)\n"+    fileLocation = "directory/File.hs"+    needle = "possibly incorrect indentation or mismatched brackets"+  -------------------------------------------------------------------------------- -- | When providing current dir including folders and files.

@@ -3,40 +3,34 @@ module Language.Haskell.Stylish.Tests.Util     ( dumpAst     , dumpModule-    , testStep-    , testStep'     , Snippet (..)-    , testSnippet     , assertSnippet     , withTestDirTree-    , (@=??)     ) where   ---------------------------------------------------------------------------------import           Control.Exception              (bracket, try)-import           Control.Monad.Writer           (execWriter, tell)-import           Data.List                      (intercalate)-import           GHC.Exts                       (IsList (..))-import           GHC.Hs.Dump                    (showAstData, BlankSrcSpan(..))-import           Language.Haskell.Stylish.GHC   (baseDynFlags)-import           System.Directory               (createDirectory,-                                                 getCurrentDirectory,-                                                 getTemporaryDirectory,-                                                 removeDirectoryRecursive,-                                                 setCurrentDirectory)-import           System.FilePath                ((</>))-import           System.IO.Error                (isAlreadyExistsError)-import           System.Random                  (randomIO)-import           Test.HUnit                     (Assertion, assertFailure,-                                                 (@=?))-import           Outputable                     (showSDoc)-import           Data.Data                      (Data(..))+import           Control.Exception               (bracket, try)+import           Data.Data                       (Data (..))+import           GHC.Exts                        (IsList (..))+import           GHC.Hs.Dump                     (BlankEpAnnotations (..),+                                                  BlankSrcSpan (..),+                                                  showAstData)+import           System.Directory                (createDirectory,+                                                  getCurrentDirectory,+                                                  getTemporaryDirectory,+                                                  removeDirectoryRecursive,+                                                  setCurrentDirectory)+import           System.FilePath                 ((</>))+import           System.IO.Error                 (isAlreadyExistsError)+import           System.Random                   (randomIO)+import           Test.HUnit                      (Assertion, (@=?))  --------------------------------------------------------------------------------+import           Language.Haskell.Stylish.GHC    (showOutputable)+import           Language.Haskell.Stylish.Module (Module) import           Language.Haskell.Stylish.Parse import           Language.Haskell.Stylish.Step-import           Language.Haskell.Stylish.Module (Module)  -------------------------------------------------------------------------------- -- | Takes a Haskell source as an argument and parse it into a Module.@@ -49,8 +43,8 @@ dumpAst extract str =   let Right(theModule) = parseModule [] Nothing str       ast              = extract theModule-      sdoc             = showAstData BlankSrcSpan ast-  in  showSDoc baseDynFlags sdoc+      sdoc             = showAstData BlankSrcSpan BlankEpAnnotations ast+  in  showOutputable sdoc  dumpModule :: String -> String dumpModule = dumpAst id@@ -67,11 +61,6 @@   ---------------------------------------------------------------------------------testStep' :: Step -> Lines -> Lines-testStep' s ls = lines $ testStep s (unlines ls)----------------------------------------------------------------------------------- -- | 'Lines' that show as a normal string. newtype Snippet = Snippet {unSnippet :: Lines} deriving (Eq) @@ -124,15 +113,3 @@         setCurrentDirectory current *>         removeDirectoryRecursive temp)     (\(_, temp) -> setCurrentDirectory temp *> action)--(@=??) :: Lines -> Lines -> Assertion-expected @=?? actual =-  if expected == actual then pure ()-  else assertFailure $ intercalate "\n" $ execWriter do-    tell ["Expected:"]-    printLines expected-    tell ["Got:"]-    printLines actual-  where-    printLines =-      mapM_ \line -> tell ["  " <> line]