From 3fbc130a0962ab236d87711beae1895d84a68362 Mon Sep 17 00:00:00 2001 From: Mark Karpov Date: Mon, 27 Apr 2020 16:51:16 +0200 Subject: [PATCH] =?UTF-8?q?Factor=20out=20the=20=E2=80=98isModule=E2=80=99?= =?UTF-8?q?=20function=20and=20the=20use=20of=20module=20span?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Module span is dummy and misleading. Right now it is not used at all, but we still organize code as if it were used. --- src/GHC.hs | 3 --- src/Ormolu/Diff.hs | 17 +++++--------- src/Ormolu/Parser.hs | 4 ++-- src/Ormolu/Parser/Result.hs | 2 +- src/Ormolu/Printer/Combinators.hs | 25 +++++---------------- src/Ormolu/Printer/Comments.hs | 37 ++++++++++++++----------------- src/Ormolu/Printer/Meat/Module.hs | 4 ++-- src/Ormolu/Utils.hs | 6 ----- 8 files changed, 33 insertions(+), 65 deletions(-) diff --git a/src/GHC.hs b/src/GHC.hs index 8431dff..665c1e9 100644 --- a/src/GHC.hs +++ b/src/GHC.hs @@ -1,6 +1,5 @@ module GHC ( module X, - ParsedSource, ) where @@ -11,5 +10,3 @@ import GHC.Hs.Instances as X () import Module as X import RdrName as X import SrcLoc as X - -type ParsedSource = Located (HsModule GhcPs) diff --git a/src/Ormolu/Diff.hs b/src/Ormolu/Diff.hs index c258004..50da2de 100644 --- a/src/Ormolu/Diff.hs +++ b/src/Ormolu/Diff.hs @@ -38,14 +38,16 @@ diffParseResult :: ParseResult -> ParseResult -> Diff diffParseResult ParseResult { prCommentStream = cstream0, - prParsedSource = ps0 + prParsedSource = hs0 } ParseResult { prCommentStream = cstream1, - prParsedSource = ps1 + prParsedSource = hs1 } = matchIgnoringSrcSpans cstream0 cstream1 - <> matchIgnoringSrcSpans ps0 ps1 + <> matchIgnoringSrcSpans + hs0 {hsmodImports = sortImports (hsmodImports hs0)} + hs1 {hsmodImports = sortImports (hsmodImports hs1)} -- | Compare two values for equality disregarding differences in 'SrcSpan's -- and the ordering of import lists. @@ -67,7 +69,6 @@ matchIgnoringSrcSpans = genericQuery gzipWithQ ( genericQuery `extQ` srcSpanEq - `extQ` hsModuleEq `extQ` sourceTextEq `extQ` hsDocStringEq `extQ` importDeclQualifiedStyleEq @@ -78,14 +79,6 @@ matchIgnoringSrcSpans = genericQuery | otherwise = Different [] srcSpanEq :: SrcSpan -> GenericQ Diff srcSpanEq _ _ = Same - hsModuleEq :: HsModule GhcPs -> GenericQ Diff - hsModuleEq hs0 hs1' = - case cast hs1' :: Maybe (HsModule GhcPs) of - Nothing -> Different [] - Just hs1 -> - matchIgnoringSrcSpans - hs0 {hsmodImports = sortImports (hsmodImports hs0)} - hs1 {hsmodImports = sortImports (hsmodImports hs1)} sourceTextEq :: SourceText -> GenericQ Diff sourceTextEq _ _ = Same importDeclQualifiedStyleEq :: ImportDeclQualifiedStyle -> GenericQ Diff diff --git a/src/Ormolu/Parser.hs b/src/Ormolu/Parser.hs index 2b32d51..28ef83a 100644 --- a/src/Ormolu/Parser.hs +++ b/src/Ormolu/Parser.hs @@ -88,7 +88,7 @@ parseModule Config {..} path rawInput = liftIO $ do case pStateErrors pstate of Just err -> Left err Nothing -> error "PFailed does not have an error" - GHC.POk pstate pmod -> + GHC.POk pstate (L _ hsModule) -> case pStateErrors pstate of -- Some parse errors (pattern/arrow syntax in expr context) -- do not cause a parse error, but they are replaced with "_" @@ -100,7 +100,7 @@ parseModule Config {..} path rawInput = liftIO $ do mkCommentStream extraComments pstate in Right ParseResult - { prParsedSource = pmod, + { prParsedSource = hsModule, prAnns = mkAnns pstate, prStackHeader = stackHeader, prShebangs = shebangs, diff --git a/src/Ormolu/Parser/Result.hs b/src/Ormolu/Parser/Result.hs index c0d66f7..5b16075 100644 --- a/src/Ormolu/Parser/Result.hs +++ b/src/Ormolu/Parser/Result.hs @@ -17,7 +17,7 @@ import Ormolu.Parser.Shebang (Shebang) -- | A collection of data that represents a parsed module in Ormolu. data ParseResult = ParseResult { -- | 'ParsedSource' from GHC - prParsedSource :: ParsedSource, + prParsedSource :: HsModule GhcPs, -- | Ormolu-specfic representation of annotations prAnns :: Anns, -- | Stack header diff --git a/src/Ormolu/Printer/Combinators.hs b/src/Ormolu/Printer/Combinators.hs index 7d05d31..dae25b6 100644 --- a/src/Ormolu/Printer/Combinators.hs +++ b/src/Ormolu/Printer/Combinators.hs @@ -62,12 +62,10 @@ module Ormolu.Printer.Combinators where import Control.Monad -import Data.Data (Data) import Data.List (intersperse) import Data.Text (Text) import Ormolu.Printer.Comments import Ormolu.Printer.Internal -import Ormolu.Utils (isModule) import SrcLoc ---------------------------------------------------------------------------- @@ -79,31 +77,20 @@ import SrcLoc -- 'Located' wrapper, it should be “discharged” with a corresponding -- 'located' invocation. located :: - Data a => -- | Thing to enter Located a -> -- | How to render inner value (a -> R ()) -> R () -located loc f = do - let withRealLocated (L l a) g = - case l of - UnhelpfulSpan _ -> return () - RealSrcSpan l' -> g (L l' a) - withRealLocated loc spitPrecedingComments - let setEnclosingSpan = - case getLoc loc of - UnhelpfulSpan _ -> id - RealSrcSpan orf -> - if isModule (unLoc loc) - then id - else withEnclosingSpan orf - setEnclosingSpan $ switchLayout [getLoc loc] (f (unLoc loc)) - withRealLocated loc spitFollowingComments +located (L (UnhelpfulSpan _) a) f = f a +located (L (RealSrcSpan l) a) f = do + spitPrecedingComments l + withEnclosingSpan l $ + switchLayout [RealSrcSpan l] (f a) + spitFollowingComments l -- | A version of 'located' with arguments flipped. located' :: - Data a => -- | How to render inner value (a -> R ()) -> -- | Thing to enter diff --git a/src/Ormolu/Printer/Comments.hs b/src/Ormolu/Printer/Comments.hs index a529daa..610fb21 100644 --- a/src/Ormolu/Printer/Comments.hs +++ b/src/Ormolu/Printer/Comments.hs @@ -14,12 +14,10 @@ where import Control.Monad import Data.Coerce (coerce) -import Data.Data (Data) import qualified Data.List.NonEmpty as NE import qualified Data.Text as T import Ormolu.Parser.CommentStream import Ormolu.Printer.Internal -import Ormolu.Utils (isModule) import SrcLoc ---------------------------------------------------------------------------- @@ -27,9 +25,8 @@ import SrcLoc -- | Output all preceding comments for an element at given location. spitPrecedingComments :: - Data a => - -- | AST element to attach comments to - RealLocated a -> + -- | Span of the element to attach comments to + RealSrcSpan -> R () spitPrecedingComments ref = do gotSome <- handleCommentSeries (spitPrecedingComment ref) @@ -37,16 +34,15 @@ spitPrecedingComments ref = do lastMark <- getSpanMark -- Insert a blank line between the preceding comments and the thing -- after them if there was a blank line in the input. - when (needsNewlineBefore (getRealSrcSpan ref) lastMark) newline + when (needsNewlineBefore ref lastMark) newline -- | Output all comments following an element at given location. spitFollowingComments :: - Data a => - -- | AST element of attach comments to - RealLocated a -> + -- | Span of the element to attach comments to + RealSrcSpan -> R () spitFollowingComments ref = do - trimSpanStream (getRealSrcSpan ref) + trimSpanStream ref void $ handleCommentSeries (spitFollowingComment ref) -- | Output all remaining comments in the comment stream. @@ -62,14 +58,13 @@ spitRemainingComments = do -- | Output a single preceding comment for an element at given location. spitPrecedingComment :: - Data a => - -- | AST element to attach comments to - RealLocated a -> + -- | Span of the element to attach comments to + RealSrcSpan -> -- | Location of last comment in the series Maybe SpanMark -> -- | Are we done? R Bool -spitPrecedingComment (L ref a) mlastMark = do +spitPrecedingComment ref mlastMark = do let p (L l _) = realSrcSpanEnd l <= realSrcSpanStart ref withPoppedComment p $ \l comment -> do dirtyLine <- @@ -80,31 +75,33 @@ spitPrecedingComment (L ref a) mlastMark = do -- immediately because it'll be attached to the previous element (on -- the same line) on the next run, so we play safe here and output -- an extra 'newline' in this case. - Nothing -> isLineDirty -- only for very first preceding comment + -- + -- We check 'mlastMark' to do this only for the very first preceding + -- comment. Just _ -> return False + _ -> isLineDirty when (dirtyLine || needsNewlineBefore l mlastMark) newline spitCommentNow l comment - if theSameLinePre l ref && not (isModule a) + if theSameLinePre l ref then space else newline -- | Output a comment that follows element at given location immediately on -- the same line, if there is any. spitFollowingComment :: - Data a => -- | AST element to attach comments to - RealLocated a -> + RealSrcSpan -> -- | Location of last comment in the series Maybe SpanMark -> -- | Are we done? R Bool -spitFollowingComment (L ref a) mlastMark = do +spitFollowingComment ref mlastMark = do mnSpn <- nextEltSpan -- Get first enclosing span that is not equal to reference span, i.e. it's -- truly something enclosing the AST element. meSpn <- getEnclosingSpan (/= ref) withPoppedComment (commentFollowsElt ref mnSpn meSpn mlastMark) $ \l comment -> - if theSameLinePost l ref && not (isModule a) + if theSameLinePost l ref then if isMultilineComment comment then space >> spitCommentNow l comment diff --git a/src/Ormolu/Printer/Meat/Module.hs b/src/Ormolu/Printer/Meat/Module.hs index 1d8b222..259866c 100644 --- a/src/Ormolu/Printer/Meat/Module.hs +++ b/src/Ormolu/Printer/Meat/Module.hs @@ -34,9 +34,9 @@ p_hsModule :: -- | Whether to use postfix qualified imports Bool -> -- | AST to print - ParsedSource -> + HsModule GhcPs -> R () -p_hsModule mstackHeader shebangs pragmas qualifiedPost (L _ HsModule {..}) = do +p_hsModule mstackHeader shebangs pragmas qualifiedPost HsModule {..} = do let deprecSpan = maybe [] (\(L s _) -> [s]) hsmodDeprecMessage exportSpans = maybe [] (\(L s _) -> [s]) hsmodExports switchLayout (deprecSpan <> exportSpans) $ do diff --git a/src/Ormolu/Utils.hs b/src/Ormolu/Utils.hs index 5e504cd..a5eed2c 100644 --- a/src/Ormolu/Utils.hs +++ b/src/Ormolu/Utils.hs @@ -6,7 +6,6 @@ module Ormolu.Utils ( RelativePos (..), attachRelativePos, combineSrcSpans', - isModule, notImplemented, showOutputable, splitDocString, @@ -18,7 +17,6 @@ module Ormolu.Utils ) where -import Data.Data (Data, showConstr, toConstr) import Data.List (dropWhileEnd) import qualified Data.List.NonEmpty as NE import Data.List.NonEmpty (NonEmpty (..)) @@ -52,10 +50,6 @@ attachRelativePos = \case combineSrcSpans' :: NonEmpty SrcSpan -> SrcSpan combineSrcSpans' (x :| xs) = foldr combineSrcSpans x xs --- | Return 'True' if given element of AST is module. -isModule :: Data a => a -> Bool -isModule x = showConstr (toConstr x) == "HsModule" - -- | Placeholder for things that are not yet implemented. notImplemented :: String -> a notImplemented msg = error $ "not implemented yet: " ++ msg