From c670be60152af8c59e4beee84fbe0e1565aafa70 Mon Sep 17 00:00:00 2001 From: Aaron VonderHaar Date: Sat, 17 Sep 2022 15:37:10 -0700 Subject: [PATCH 1/8] format: sort imports by module name --- compiler/src/Gren/Format/Normalize.hs | 7 +++++- tests/Integration/FormatSpec.hs | 31 +++++++++++++++++++++++++++ 2 files changed, 37 insertions(+), 1 deletion(-) diff --git a/compiler/src/Gren/Format/Normalize.hs b/compiler/src/Gren/Format/Normalize.hs index 3a59814f9..84d4a19fc 100644 --- a/compiler/src/Gren/Format/Normalize.hs +++ b/compiler/src/Gren/Format/Normalize.hs @@ -8,6 +8,7 @@ module Gren.Format.Normalize (normalize) where import AST.Source qualified as Src +import Data.List qualified as List import Data.Map (Map) import Data.Map qualified as Map import Data.Maybe (mapMaybe) @@ -18,9 +19,13 @@ import Reporting.Annotation qualified as A normalize :: Src.Module -> Src.Module normalize module_ = module_ - { Src._imports = mapMaybe removeDefaultImports $ Src._imports module_ + { Src._imports = List.sortOn importSortKey $ mapMaybe removeDefaultImports $ Src._imports module_ } +importSortKey :: Src.Import -> Name +importSortKey (Src.Import name _ _) = + A.toValue name + removeDefaultImports :: Src.Import -> Maybe Src.Import removeDefaultImports import_@(Src.Import name alias exposing) = case Map.lookup (A.toValue name) defaultImports of diff --git a/tests/Integration/FormatSpec.hs b/tests/Integration/FormatSpec.hs index e8a233ff5..76e1a83e6 100644 --- a/tests/Integration/FormatSpec.hs +++ b/tests/Integration/FormatSpec.hs @@ -50,6 +50,37 @@ spec = do formattedModuleBody ] + describe "imports" $ do + let formattedModuleHeader = "module M exposing (..)\n" + let formattedModuleBody = "\n\nf =\n {}" + + it "formats already formatted" $ + assertFormatted + [ formattedModuleHeader, + "import APlainImport", + "import BNamespace.QualifiedImport", + "import CAliasImport as C", + "import DExposingImport exposing (..)", + "import EAliasAndExposing as E exposing (..)", + formattedModuleBody + ] + + it "sorts imports by name" $ + [ formattedModuleHeader, + "import A.B", + "import A", + "import C as Z", + "import B", + formattedModuleBody + ] + `shouldFormatAs` [ formattedModuleHeader, + "import A", + "import A.B", + "import B", + "import C as Z", + formattedModuleBody + ] + describe "top-level definition" $ do it "formats already formatted" $ assertFormattedModuleBody From c0ea0bd457eca6e9402bab00bb06d00debb9ce11 Mon Sep 17 00:00:00 2001 From: Aaron VonderHaar Date: Thu, 29 Sep 2022 15:51:05 -0700 Subject: [PATCH 2/8] WIP: import comments --- builder/src/Build.hs | 2 +- compiler/src/AST/Source.hs | 5 ++-- compiler/src/AST/SourceComments.hs | 8 ++++++ .../src/Canonicalize/Environment/Foreign.hs | 4 +-- compiler/src/Gren/Compiler/Imports.hs | 3 ++- compiler/src/Gren/Format.hs | 20 ++++++++------- compiler/src/Gren/Format/Normalize.hs | 6 ++--- compiler/src/Gren/Kernel.hs | 2 +- compiler/src/Parse/Module.hs | 25 ++++++++++--------- .../src/Reporting/Render/Type/Localizer.hs | 2 +- terminal/src/Repl.hs | 2 +- tests/Integration/FormatSpec.hs | 13 ++++++++++ 12 files changed, 59 insertions(+), 33 deletions(-) diff --git a/builder/src/Build.hs b/builder/src/Build.hs index 42c17f0a9..d141a702b 100644 --- a/builder/src/Build.hs +++ b/builder/src/Build.hs @@ -443,7 +443,7 @@ toImportErrors (Env _ _ _ _ _ _ locals foreigns) results imports problems = Set.difference knownModules (Set.fromList (map Src.getImportName imports)) regionDict = - Map.fromList (map (\(Src.Import (A.At region name) _ _) -> (name, region)) imports) + Map.fromList (map (\(Src.Import (A.At region name) _ _ _) -> (name, region)) imports) toError (name, problem) = Import.Error (regionDict ! name) name unimportedModules problem diff --git a/compiler/src/AST/Source.hs b/compiler/src/AST/Source.hs index 7858148de..5899c62ca 100644 --- a/compiler/src/AST/Source.hs +++ b/compiler/src/AST/Source.hs @@ -143,13 +143,14 @@ getName (Module maybeName _ _ _ _ _ _ _ _ _) = Name._Main getImportName :: Import -> Name -getImportName (Import (A.At _ name) _ _) = +getImportName (Import (A.At _ name) _ _ _) = name data Import = Import { _import :: A.Located Name, _alias :: Maybe Name, - _exposing :: Exposing + _exposing :: Exposing, + _importComments :: SC.ImportComments } deriving (Show) diff --git a/compiler/src/AST/SourceComments.hs b/compiler/src/AST/SourceComments.hs index 2f9605146..d644ab92b 100644 --- a/compiler/src/AST/SourceComments.hs +++ b/compiler/src/AST/SourceComments.hs @@ -54,3 +54,11 @@ data FxComments = FxComments _subComments :: SubComments } deriving (Show) + +-- Import + +data ImportComments = ImportComments + { _afterImportKeyword :: [Comment], + _afterImportName :: [Comment] + } + deriving (Show) diff --git a/compiler/src/Canonicalize/Environment/Foreign.hs b/compiler/src/Canonicalize/Environment/Foreign.hs index a46e857aa..209ee2aad 100644 --- a/compiler/src/Canonicalize/Environment/Foreign.hs +++ b/compiler/src/Canonicalize/Environment/Foreign.hs @@ -68,7 +68,7 @@ toSafeImports (ModuleName.Canonical pkg _) imports = else imports isNormal :: Src.Import -> Bool -isNormal (Src.Import (A.At _ name) maybeAlias _) = +isNormal (Src.Import (A.At _ name) maybeAlias _ _) = if Name.isKernel name then case maybeAlias of Nothing -> False @@ -78,7 +78,7 @@ isNormal (Src.Import (A.At _ name) maybeAlias _) = -- ADD IMPORTS addImport :: Map.Map ModuleName.Raw I.Interface -> State -> Src.Import -> Result i w State -addImport ifaces (State vs ts cs bs qvs qts qcs) (Src.Import (A.At _ name) maybeAlias exposing) = +addImport ifaces (State vs ts cs bs qvs qts qcs) (Src.Import (A.At _ name) maybeAlias exposing _) = let (I.Interface pkg defs unions aliases binops) = ifaces ! name !prefix = maybe name id maybeAlias !home = ModuleName.Canonical pkg name diff --git a/compiler/src/Gren/Compiler/Imports.hs b/compiler/src/Gren/Compiler/Imports.hs index f5b181571..2774dbed1 100644 --- a/compiler/src/Gren/Compiler/Imports.hs +++ b/compiler/src/Gren/Compiler/Imports.hs @@ -7,6 +7,7 @@ module Gren.Compiler.Imports where import AST.Source qualified as Src +import AST.SourceComments qualified as SC import Data.Name qualified as Name import Gren.ModuleName qualified as ModuleName import Reporting.Annotation qualified as A @@ -29,7 +30,7 @@ defaults = import_ :: ModuleName.Canonical -> Maybe Name.Name -> Src.Exposing -> Src.Import import_ (ModuleName.Canonical _ name) maybeAlias exposing = - Src.Import (A.At A.zero name) maybeAlias exposing + Src.Import (A.At A.zero name) maybeAlias exposing (SC.ImportComments [] []) -- EXPOSING diff --git a/compiler/src/Gren/Format.hs b/compiler/src/Gren/Format.hs index 0b0cc6a1c..636565bc6 100644 --- a/compiler/src/Gren/Format.hs +++ b/compiler/src/Gren/Format.hs @@ -300,15 +300,17 @@ formatExposed = \case Src.Operator _ name -> Block.line $ Block.char7 '(' <> utf8 name <> Block.char7 ')' formatImport :: Src.Import -> Block -formatImport (Src.Import name alias exposing) = - spaceOrIndent $ - NonEmpty.fromList $ - catMaybes - [ Just $ Block.line $ Block.string7 "import", - Just $ Block.line $ utf8 $ A.toValue name, - fmap formatImportAlias alias, - formatExposing [] exposing - ] +formatImport (Src.Import name alias exposing comments) = + let (SC.ImportComments commentsAfterKeyword commentsAfterName) = comments + in spaceOrIndent $ + NonEmpty.fromList $ + catMaybes + [ Just $ Block.line $ Block.string7 "import", + Just $ withCommentsBefore commentsAfterKeyword $ Block.line $ utf8 $ A.toValue name, + (spaceOrStack . fmap formatComment) <$> NonEmpty.nonEmpty commentsAfterName, + fmap formatImportAlias alias, + formatExposing [] exposing + ] formatImportAlias :: Name -> Block formatImportAlias name = Block.line $ Block.string7 "as" <> Block.space <> utf8 name diff --git a/compiler/src/Gren/Format/Normalize.hs b/compiler/src/Gren/Format/Normalize.hs index 84d4a19fc..b2cd40697 100644 --- a/compiler/src/Gren/Format/Normalize.hs +++ b/compiler/src/Gren/Format/Normalize.hs @@ -23,13 +23,13 @@ normalize module_ = } importSortKey :: Src.Import -> Name -importSortKey (Src.Import name _ _) = +importSortKey (Src.Import name _ _ _) = A.toValue name removeDefaultImports :: Src.Import -> Maybe Src.Import -removeDefaultImports import_@(Src.Import name alias exposing) = +removeDefaultImports import_@(Src.Import name alias exposing _) = case Map.lookup (A.toValue name) defaultImports of - Just (Src.Import _ defAlias defExposing) -> + Just (Src.Import _ defAlias defExposing _) -> if alias == defAlias && exposingEq exposing defExposing then Nothing else Just import_ diff --git a/compiler/src/Gren/Kernel.hs b/compiler/src/Gren/Kernel.hs index 46d1feb92..1020e8502 100644 --- a/compiler/src/Gren/Kernel.hs +++ b/compiler/src/Gren/Kernel.hs @@ -218,7 +218,7 @@ toVarTable pkg foreigns imports = List.foldl' (addImport pkg foreigns) Map.empty imports addImport :: Pkg.Name -> Foreigns -> VarTable -> Src.Import -> VarTable -addImport pkg foreigns vtable (Src.Import (A.At _ importName) maybeAlias exposing) = +addImport pkg foreigns vtable (Src.Import (A.At _ importName) maybeAlias exposing _) = if Name.isKernel importName then case maybeAlias of Just _ -> diff --git a/compiler/src/Parse/Module.hs b/compiler/src/Parse/Module.hs index 12d077fea..1afb095de 100644 --- a/compiler/src/Parse/Module.hs +++ b/compiler/src/Parse/Module.hs @@ -383,25 +383,26 @@ chompImport :: Parser E.Module Src.Import chompImport = do Keyword.import_ E.ImportStart - Space.chompAndCheckIndent E.ModuleSpace E.ImportIndentName + commentsAfterImportKeyword <- Space.chompAndCheckIndent E.ModuleSpace E.ImportIndentName name@(A.At (A.Region _ end) _) <- addLocation (Var.moduleName E.ImportName) - Space.chomp E.ModuleSpace + commentsAfterName <- Space.chomp E.ModuleSpace + let comments = SC.ImportComments commentsAfterImportKeyword commentsAfterName oneOf E.ImportEnd [ do Space.checkFreshLine E.ImportEnd - return $ Src.Import name Nothing (Src.Explicit []), + return $ Src.Import name Nothing (Src.Explicit []) comments, do Space.checkIndent end E.ImportEnd oneOf E.ImportAs - [ chompAs name, - chompExposing name Nothing + [ chompAs name comments, + chompExposing name Nothing comments ] ] -chompAs :: A.Located Name.Name -> Parser E.Module Src.Import -chompAs name = +chompAs :: A.Located Name.Name -> SC.ImportComments -> Parser E.Module Src.Import +chompAs name comments = do Keyword.as_ E.ImportAs Space.chompAndCheckIndent E.ModuleSpace E.ImportIndentAlias @@ -412,20 +413,20 @@ chompAs name = E.ImportEnd [ do Space.checkFreshLine E.ImportEnd - return $ Src.Import name (Just alias) (Src.Explicit []), + return $ Src.Import name (Just alias) (Src.Explicit []) comments, do Space.checkIndent end E.ImportEnd - chompExposing name (Just alias) + chompExposing name (Just alias) comments ] -chompExposing :: A.Located Name.Name -> Maybe Name.Name -> Parser E.Module Src.Import -chompExposing name maybeAlias = +chompExposing :: A.Located Name.Name -> Maybe Name.Name -> SC.ImportComments -> Parser E.Module Src.Import +chompExposing name maybeAlias comments = do Keyword.exposing_ E.ImportExposing Space.chompAndCheckIndent E.ModuleSpace E.ImportIndentExposingArray exposed <- specialize E.ImportExposingArray exposing freshLine E.ImportEnd - return $ Src.Import name maybeAlias exposed + return $ Src.Import name maybeAlias exposed comments -- LISTING diff --git a/compiler/src/Reporting/Render/Type/Localizer.hs b/compiler/src/Reporting/Render/Type/Localizer.hs index 43cd89c2a..ee81f1752 100644 --- a/compiler/src/Reporting/Render/Type/Localizer.hs +++ b/compiler/src/Reporting/Render/Type/Localizer.hs @@ -72,7 +72,7 @@ fromModule modul@(Src.Module _ _ _ imports _ _ _ _ _ _) = (Src.getName modul, Import Nothing All) : map toPair imports toPair :: Src.Import -> (Name.Name, Import) -toPair (Src.Import (A.At _ name) alias exposing) = +toPair (Src.Import (A.At _ name) alias exposing _) = ( name, Import alias (toExposing exposing) ) diff --git a/terminal/src/Repl.hs b/terminal/src/Repl.hs index 52491e8b0..e695b6554 100644 --- a/terminal/src/Repl.hs +++ b/terminal/src/Repl.hs @@ -257,7 +257,7 @@ attemptImport lines = let src = linesToByteString lines parser = P.specialize (\_ _ _ -> ()) PM.chompImport in case P.fromByteString parser (\_ _ -> ()) src of - Right (Src.Import (A.At _ name) _ _) -> + Right (Src.Import (A.At _ name) _ _ _) -> Done (Import name src) Left () -> ifFail lines (Import "ERR" src) diff --git a/tests/Integration/FormatSpec.hs b/tests/Integration/FormatSpec.hs index 76e1a83e6..8c35ea849 100644 --- a/tests/Integration/FormatSpec.hs +++ b/tests/Integration/FormatSpec.hs @@ -81,6 +81,19 @@ spec = do formattedModuleBody ] + it "formats comments" $ + [ formattedModuleHeader, + "import{-A-}Module1{-B-}", + "{-C-}", + "import{-D-}Module2{-E-}as{-F-}M2{-G-}", + formattedModuleBody + ] + `shouldFormatAs` [ formattedModuleHeader, + "import {- A -} Module1 {- B -} {- C -}", + "import {- D -} Module2 {- E -} as M2", -- TODO: retain F, G + formattedModuleBody + ] + describe "top-level definition" $ do it "formats already formatted" $ assertFormattedModuleBody From 3a2b382fa56b8abf545b56461f4088f944226d01 Mon Sep 17 00:00:00 2001 From: Aaron VonderHaar Date: Sat, 12 Nov 2022 11:24:03 -0800 Subject: [PATCH 3/8] format: retain comments in 'as' clause of 'import' lines --- compiler/src/AST/Source.hs | 2 +- compiler/src/AST/SourceComments.hs | 8 +++++- .../src/Canonicalize/Environment/Foreign.hs | 2 +- compiler/src/Gren/Compiler/Imports.hs | 3 ++- compiler/src/Gren/Format.hs | 27 +++++++++++++------ compiler/src/Gren/Kernel.hs | 5 ++-- compiler/src/Parse/Module.hs | 12 +++++---- .../src/Reporting/Render/Type/Localizer.hs | 2 +- tests/Helpers/Instances.hs | 3 --- tests/Integration/FormatSpec.hs | 22 ++++++++++++++- tests/Parse/AliasSpec.hs | 2 +- 11 files changed, 63 insertions(+), 25 deletions(-) diff --git a/compiler/src/AST/Source.hs b/compiler/src/AST/Source.hs index 5899c62ca..fd2bd3a86 100644 --- a/compiler/src/AST/Source.hs +++ b/compiler/src/AST/Source.hs @@ -148,7 +148,7 @@ getImportName (Import (A.At _ name) _ _ _) = data Import = Import { _import :: A.Located Name, - _alias :: Maybe Name, + _alias :: Maybe (Name, SC.ImportAliasComments), _exposing :: Exposing, _importComments :: SC.ImportComments } diff --git a/compiler/src/AST/SourceComments.hs b/compiler/src/AST/SourceComments.hs index d644ab92b..334facef3 100644 --- a/compiler/src/AST/SourceComments.hs +++ b/compiler/src/AST/SourceComments.hs @@ -7,7 +7,7 @@ data GREN_COMMENT data Comment = BlockComment (Utf8.Utf8 GREN_COMMENT) | LineComment (Utf8.Utf8 GREN_COMMENT) - deriving (Show) + deriving (Eq, Show) -- Module @@ -62,3 +62,9 @@ data ImportComments = ImportComments _afterImportName :: [Comment] } deriving (Show) + +data ImportAliasComments = ImportAliasComments + { _afterAs :: [Comment], + _afterAliasName :: [Comment] + } + deriving (Eq, Show) diff --git a/compiler/src/Canonicalize/Environment/Foreign.hs b/compiler/src/Canonicalize/Environment/Foreign.hs index 209ee2aad..fd7f65980 100644 --- a/compiler/src/Canonicalize/Environment/Foreign.hs +++ b/compiler/src/Canonicalize/Environment/Foreign.hs @@ -80,7 +80,7 @@ isNormal (Src.Import (A.At _ name) maybeAlias _ _) = addImport :: Map.Map ModuleName.Raw I.Interface -> State -> Src.Import -> Result i w State addImport ifaces (State vs ts cs bs qvs qts qcs) (Src.Import (A.At _ name) maybeAlias exposing _) = let (I.Interface pkg defs unions aliases binops) = ifaces ! name - !prefix = maybe name id maybeAlias + !prefix = maybe name id (fmap fst maybeAlias) !home = ModuleName.Canonical pkg name !rawTypeInfo = diff --git a/compiler/src/Gren/Compiler/Imports.hs b/compiler/src/Gren/Compiler/Imports.hs index 2774dbed1..189d0d5d0 100644 --- a/compiler/src/Gren/Compiler/Imports.hs +++ b/compiler/src/Gren/Compiler/Imports.hs @@ -30,7 +30,8 @@ defaults = import_ :: ModuleName.Canonical -> Maybe Name.Name -> Src.Exposing -> Src.Import import_ (ModuleName.Canonical _ name) maybeAlias exposing = - Src.Import (A.At A.zero name) maybeAlias exposing (SC.ImportComments [] []) + let maybeAliasWithComments = fmap (,(SC.ImportAliasComments [] [])) maybeAlias + in Src.Import (A.At A.zero name) maybeAliasWithComments exposing (SC.ImportComments [] []) -- EXPOSING diff --git a/compiler/src/Gren/Format.hs b/compiler/src/Gren/Format.hs index 636565bc6..970ec91d5 100644 --- a/compiler/src/Gren/Format.hs +++ b/compiler/src/Gren/Format.hs @@ -129,12 +129,19 @@ extendedGroup open baseSep sep fieldSep close base fields = ] withCommentsBefore :: [Src.Comment] -> Block -> Block -withCommentsBefore [] block = block -withCommentsBefore (first : rest) block = - spaceOrStack - [ spaceOrStack $ fmap formatComment (first :| rest), - block - ] +withCommentsBefore before = withCommentsAround before [] + +withCommentsAround :: [Src.Comment] -> [Src.Comment] -> Block -> Block +withCommentsAround [] [] block = block +withCommentsAround before after block = + case (formatCommentBlock before, formatCommentBlock after) of + (Nothing, Nothing) -> block + (Just beforeBlock, Nothing) -> + spaceOrStack [beforeBlock, block] + (Nothing, Just afterBlock) -> + spaceOrIndent [block, afterBlock] + (Just beforeBlock, Just afterBlock) -> + spaceOrStack [beforeBlock, spaceOrIndent [block, afterBlock]] -- -- AST -> Block @@ -312,8 +319,12 @@ formatImport (Src.Import name alias exposing comments) = formatExposing [] exposing ] -formatImportAlias :: Name -> Block -formatImportAlias name = Block.line $ Block.string7 "as" <> Block.space <> utf8 name +formatImportAlias :: (Name, SC.ImportAliasComments) -> Block +formatImportAlias (name, SC.ImportAliasComments afterAs afterAliasName) = + spaceOrIndent + [ Block.line $ Block.string7 "as", + withCommentsAround afterAs afterAliasName (Block.line $ utf8 name) + ] formatDocComment :: Src.DocComment -> Block formatDocComment (Src.DocComment doc) = diff --git a/compiler/src/Gren/Kernel.hs b/compiler/src/Gren/Kernel.hs index 1020e8502..c477a6f68 100644 --- a/compiler/src/Gren/Kernel.hs +++ b/compiler/src/Gren/Kernel.hs @@ -15,6 +15,7 @@ module Gren.Kernel where import AST.Source qualified as Src +import AST.SourceComments qualified as SC import Control.Monad (liftM, liftM2) import Data.Binary (Binary, get, getWord8, put, putWord8) import Data.ByteString.Internal qualified as B @@ -235,10 +236,10 @@ addImport pkg foreigns vtable (Src.Import (A.At _ importName) maybeAlias exposin Map.insert (Name.sepBy 0x5F {-_-} prefix name) (GrenVar home name) table in List.foldl' add vtable (toNames exposing) -toPrefix :: Name.Name -> Maybe Name.Name -> Name.Name +toPrefix :: Name.Name -> Maybe (Name.Name, SC.ImportAliasComments) -> Name.Name toPrefix home maybeAlias = case maybeAlias of - Just alias -> + Just (alias, _) -> alias Nothing -> if Name.hasDot home diff --git a/compiler/src/Parse/Module.hs b/compiler/src/Parse/Module.hs index 3e9ea2612..da8f8eb8f 100644 --- a/compiler/src/Parse/Module.hs +++ b/compiler/src/Parse/Module.hs @@ -405,21 +405,23 @@ chompAs :: A.Located Name.Name -> SC.ImportComments -> Parser E.Module Src.Impor chompAs name comments = do Keyword.as_ E.ImportAs - Space.chompAndCheckIndent E.ModuleSpace E.ImportIndentAlias + commentsAfterAs <- Space.chompAndCheckIndent E.ModuleSpace E.ImportIndentAlias alias <- Var.moduleName E.ImportAlias end <- getPosition - Space.chomp E.ModuleSpace + commentsAfterAliasName <- Space.chomp E.ModuleSpace + let aliasComments = SC.ImportAliasComments commentsAfterAs commentsAfterAliasName + let aliasWithComments = Just (alias, aliasComments) oneOf E.ImportEnd [ do Space.checkFreshLine E.ImportEnd - return $ Src.Import name (Just alias) (Src.Explicit []) comments, + return $ Src.Import name aliasWithComments (Src.Explicit []) comments, do Space.checkIndent end E.ImportEnd - chompExposing name (Just alias) comments + chompExposing name aliasWithComments comments ] -chompExposing :: A.Located Name.Name -> Maybe Name.Name -> SC.ImportComments -> Parser E.Module Src.Import +chompExposing :: A.Located Name.Name -> Maybe (Name.Name, SC.ImportAliasComments) -> SC.ImportComments -> Parser E.Module Src.Import chompExposing name maybeAlias comments = do Keyword.exposing_ E.ImportExposing diff --git a/compiler/src/Reporting/Render/Type/Localizer.hs b/compiler/src/Reporting/Render/Type/Localizer.hs index ee81f1752..f6e44e565 100644 --- a/compiler/src/Reporting/Render/Type/Localizer.hs +++ b/compiler/src/Reporting/Render/Type/Localizer.hs @@ -74,7 +74,7 @@ fromModule modul@(Src.Module _ _ _ imports _ _ _ _ _ _) = toPair :: Src.Import -> (Name.Name, Import) toPair (Src.Import (A.At _ name) alias exposing _) = ( name, - Import alias (toExposing exposing) + Import (fmap fst alias) (toExposing exposing) ) toExposing :: Src.Exposing -> Exposing diff --git a/tests/Helpers/Instances.hs b/tests/Helpers/Instances.hs index a10e1087c..bd2fca1f0 100644 --- a/tests/Helpers/Instances.hs +++ b/tests/Helpers/Instances.hs @@ -3,13 +3,10 @@ module Helpers.Instances where -import AST.Source qualified as Src import Data.String (IsString (..)) import Data.Utf8 qualified as Utf8 import Reporting.Error.Syntax qualified as E -deriving instance Eq Src.Comment - deriving instance Eq E.Space instance IsString (Utf8.Utf8 a) where diff --git a/tests/Integration/FormatSpec.hs b/tests/Integration/FormatSpec.hs index 0b8218bc3..a31be02cb 100644 --- a/tests/Integration/FormatSpec.hs +++ b/tests/Integration/FormatSpec.hs @@ -91,7 +91,27 @@ spec = do ] `shouldFormatAs` [ formattedModuleHeader, "import {- A -} Module1 {- B -} {- C -}", - "import {- D -} Module2 {- E -} as M2", -- TODO: retain F, G + "import {- D -} Module2 {- E -} as {- F -} M2 {- G -}", + formattedModuleBody + ] + it "allows indented comments after module name" $ + [ formattedModuleHeader, + "import Module1", + " {-A-}", + formattedModuleBody + ] + `shouldFormatAs` [ formattedModuleHeader, + "import Module1 {- A -}", + formattedModuleBody + ] + it "allows indented comments after 'as' clause" $ + [ formattedModuleHeader, + "import Module1 as M1", + " {-A-}", + formattedModuleBody + ] + `shouldFormatAs` [ formattedModuleHeader, + "import Module1 as M1 {- A -}", formattedModuleBody ] diff --git a/tests/Parse/AliasSpec.hs b/tests/Parse/AliasSpec.hs index 840193e7f..9477a7f9e 100644 --- a/tests/Parse/AliasSpec.hs +++ b/tests/Parse/AliasSpec.hs @@ -30,7 +30,7 @@ parse expectedAlias str = case result of Right imp -> case Src._alias imp of - Just alias -> + Just (alias, _) -> Name.toChars alias == expectedAlias Nothing -> False From 4d329e703dd70d32a8ce0cdb3bbf003314350294 Mon Sep 17 00:00:00 2001 From: Aaron VonderHaar Date: Sat, 12 Nov 2022 11:24:43 -0800 Subject: [PATCH 4/8] Integration.FormatSpec: give more detailed error when a format test fails to parse the input --- tests/Integration/FormatSpec.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/Integration/FormatSpec.hs b/tests/Integration/FormatSpec.hs index a31be02cb..44ad37d29 100644 --- a/tests/Integration/FormatSpec.hs +++ b/tests/Integration/FormatSpec.hs @@ -165,8 +165,8 @@ shouldFormatAs inputLines expectedOutputLines = expectedOutput = LazyText.unlines $ fmap LazyText.fromStrict expectedOutputLines actualOutput = LTE.decodeUtf8 . Builder.toLazyByteString <$> Format.formatByteString Parse.Application input in case actualOutput of - Left _ -> - expectationFailure "shouldFormatAs: failed to format" + Left err -> + expectationFailure ("shouldFormatAs: failed to format: " <> show err) Right actualModuleBody -> actualModuleBody `shouldBe` expectedOutput From 5b95e7c8f3e9d8a259f4c7245cc716585dbc7fe0 Mon Sep 17 00:00:00 2001 From: Aaron VonderHaar Date: Sat, 12 Nov 2022 12:07:02 -0800 Subject: [PATCH 5/8] format: comments at the end of an import line must be indented --- compiler/src/Parse/Module.hs | 6 +++-- compiler/src/Parse/Space.hs | 43 +++++++++++++++++++-------------- tests/Integration/FormatSpec.hs | 24 ++++++++++++++++-- 3 files changed, 51 insertions(+), 22 deletions(-) diff --git a/compiler/src/Parse/Module.hs b/compiler/src/Parse/Module.hs index da8f8eb8f..d228275dc 100644 --- a/compiler/src/Parse/Module.hs +++ b/compiler/src/Parse/Module.hs @@ -385,7 +385,8 @@ chompImport = Keyword.import_ E.ImportStart commentsAfterImportKeyword <- Space.chompAndCheckIndent E.ModuleSpace E.ImportIndentName name@(A.At (A.Region _ end) _) <- addLocation (Var.moduleName E.ImportName) - commentsAfterName <- Space.chomp E.ModuleSpace + commentsAfterName <- Space.chompIndentedAtLeast 1 E.ModuleSpace + commentsAfterImportLine <- Space.chomp E.ModuleSpace let comments = SC.ImportComments commentsAfterImportKeyword commentsAfterName oneOf E.ImportEnd @@ -408,7 +409,8 @@ chompAs name comments = commentsAfterAs <- Space.chompAndCheckIndent E.ModuleSpace E.ImportIndentAlias alias <- Var.moduleName E.ImportAlias end <- getPosition - commentsAfterAliasName <- Space.chomp E.ModuleSpace + commentsAfterAliasName <- Space.chompIndentedAtLeast 1 E.ModuleSpace + commentsAfterImportLine <- Space.chomp E.ModuleSpace let aliasComments = SC.ImportAliasComments commentsAfterAs commentsAfterAliasName let aliasWithComments = Just (alias, aliasComments) oneOf diff --git a/compiler/src/Parse/Space.hs b/compiler/src/Parse/Space.hs index b2a70f00b..374b4d58e 100644 --- a/compiler/src/Parse/Space.hs +++ b/compiler/src/Parse/Space.hs @@ -6,6 +6,7 @@ module Parse.Space ( Parser, -- chomp, + chompIndentedAtLeast, chompAndCheckIndent, -- checkIndent, @@ -34,9 +35,13 @@ type Parser x a = -- CHOMP chomp :: (E.Space -> Row -> Col -> x) -> P.Parser x [Src.Comment] -chomp toError = +chomp = + chompIndentedAtLeast 0 + +chompIndentedAtLeast :: Col -> (E.Space -> Row -> Col -> x) -> P.Parser x [Src.Comment] +chompIndentedAtLeast requiredIndent toError = P.Parser $ \(P.State src pos end indent row col) cok _ cerr _ -> - let (# status, newPos, newRow, newCol #) = eatSpaces pos end row col [] + let (# status, newPos, newRow, newCol #) = eatSpacesIndentedAtLeast requiredIndent pos end row col [] in case status of Good comments -> let !newState = P.State src newPos end indent newRow newCol @@ -72,7 +77,7 @@ checkFreshLine toError = chompAndCheckIndent :: (E.Space -> Row -> Col -> x) -> (Row -> Col -> x) -> P.Parser x [Src.Comment] chompAndCheckIndent toSpaceError toIndentError = P.Parser $ \(P.State src pos end indent row col) cok _ cerr _ -> - let (# status, newPos, newRow, newCol #) = eatSpaces pos end row col [] + let (# status, newPos, newRow, newCol #) = eatSpacesIndentedAtLeast 0 pos end row col [] in case status of Good comments -> if newCol > indent && newCol > 1 @@ -90,26 +95,28 @@ data Status | HasTab | EndlessMultiComment -eatSpaces :: Ptr Word8 -> Ptr Word8 -> Row -> Col -> [Src.Comment] -> (# Status, Ptr Word8, Row, Col #) -eatSpaces pos end row col comments = +eatSpacesIndentedAtLeast :: Col -> Ptr Word8 -> Ptr Word8 -> Row -> Col -> [Src.Comment] -> (# Status, Ptr Word8, Row, Col #) +eatSpacesIndentedAtLeast indent pos end row col comments = if pos >= end then (# Good (reverse comments), pos, row, col #) else case P.unsafeIndex pos of 0x20 {- -} -> - eatSpaces (plusPtr pos 1) end row (col + 1) comments + eatSpacesIndentedAtLeast indent (plusPtr pos 1) end row (col + 1) comments 0x0A {- \n -} -> - eatSpaces (plusPtr pos 1) end (row + 1) 1 comments + eatSpacesIndentedAtLeast indent (plusPtr pos 1) end (row + 1) 1 comments 0x7B {- { -} -> - eatMultiComment pos end row col comments + if col > indent + then eatMultiComment indent pos end row col comments + else (# Good (reverse comments), pos, row, col #) 0x2D {- - -} -> let !pos1 = plusPtr pos 1 - in if pos1 < end && P.unsafeIndex pos1 == 0x2D {- - -} + in if pos1 < end && col > indent && P.unsafeIndex pos1 == 0x2D {- - -} then let !start = plusPtr pos 2 - in eatLineComment start start end row (col + 2) comments + in eatLineComment indent start start end row (col + 2) comments else (# Good (reverse comments), pos, row, col #) 0x0D {- \r -} -> - eatSpaces (plusPtr pos 1) end row col comments + eatSpacesIndentedAtLeast indent (plusPtr pos 1) end row col comments 0x09 {- \t -} -> (# HasTab, pos, row, col #) _ -> @@ -117,8 +124,8 @@ eatSpaces pos end row col comments = -- LINE COMMENTS -eatLineComment :: Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Row -> Col -> [Src.Comment] -> (# Status, Ptr Word8, Row, Col #) -eatLineComment start pos end row col comments = +eatLineComment :: Col -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Row -> Col -> [Src.Comment] -> (# Status, Ptr Word8, Row, Col #) +eatLineComment indent start pos end row col comments = if pos >= end then let !comment = Utf8.fromPtr start end @@ -130,15 +137,15 @@ eatLineComment start pos end row col comments = then let !comment = Utf8.fromPtr start pos !newComments = Src.LineComment comment : comments - in eatSpaces (plusPtr pos 1) end (row + 1) 1 newComments + in eatSpacesIndentedAtLeast indent (plusPtr pos 1) end (row + 1) 1 newComments else let !newPos = plusPtr pos (P.getCharWidth word) - in eatLineComment start newPos end row (col + 1) comments + in eatLineComment indent start newPos end row (col + 1) comments -- MULTI COMMENTS -eatMultiComment :: Ptr Word8 -> Ptr Word8 -> Row -> Col -> [Src.Comment] -> (# Status, Ptr Word8, Row, Col #) -eatMultiComment pos end row col comments = +eatMultiComment :: Col -> Ptr Word8 -> Ptr Word8 -> Row -> Col -> [Src.Comment] -> (# Status, Ptr Word8, Row, Col #) +eatMultiComment indent pos end row col comments = let !pos1 = plusPtr pos 1 !pos2 = plusPtr pos 2 in if pos2 >= end @@ -152,7 +159,7 @@ eatMultiComment pos end row col comments = let (# status, newPos, newRow, newCol #) = eatMultiCommentHelp pos2 pos2 end row (col + 2) 1 in case status of - MultiGood comment -> eatSpaces newPos end newRow newCol (Src.BlockComment comment : comments) + MultiGood comment -> eatSpacesIndentedAtLeast indent newPos end newRow newCol (Src.BlockComment comment : comments) MultiTab -> (# HasTab, newPos, newRow, newCol #) MultiEndless -> (# EndlessMultiComment, pos, row, col #) else (# Good (reverse comments), pos, row, col #) diff --git a/tests/Integration/FormatSpec.hs b/tests/Integration/FormatSpec.hs index 44ad37d29..cc445961c 100644 --- a/tests/Integration/FormatSpec.hs +++ b/tests/Integration/FormatSpec.hs @@ -85,15 +85,35 @@ spec = do it "formats comments" $ [ formattedModuleHeader, "import{-A-}Module1{-B-}", - "{-C-}", "import{-D-}Module2{-E-}as{-F-}M2{-G-}", formattedModuleBody ] `shouldFormatAs` [ formattedModuleHeader, - "import {- A -} Module1 {- B -} {- C -}", + "import {- A -} Module1 {- B -}", "import {- D -} Module2 {- E -} as {- F -} M2 {- G -}", formattedModuleBody ] + it "does not attach unindented comments to the import line" $ + -- TODO: eventually all these comments should be retained instead of dropped + [ formattedModuleHeader, + "import Module1", + "{-A-}", + "import Module2WithAs as M2", + "{-B-}", + "import Module3WithExposing exposing (..)", + "{-C-}", + "import Module4WithAsAndExposing as M4 exposing (..)", + "{-D-}", + formattedModuleBody + ] + `shouldFormatAs` [ formattedModuleHeader, + "import Module1", + "import Module2WithAs as M2", + "import Module3WithExposing exposing (..)", + "import Module4WithAsAndExposing as M4 exposing (..)", + formattedModuleBody + ] + it "allows indented comments after module name" $ [ formattedModuleHeader, "import Module1", From 51c259246de4fa2ad2661c60f0048846d3323a4c Mon Sep 17 00:00:00 2001 From: Aaron VonderHaar Date: Sat, 12 Nov 2022 12:10:25 -0800 Subject: [PATCH 6/8] Silence warning about ignored comments when parsing Kernel (javascript) modules --- compiler/src/Gren/Kernel.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/src/Gren/Kernel.hs b/compiler/src/Gren/Kernel.hs index c477a6f68..4133342dc 100644 --- a/compiler/src/Gren/Kernel.hs +++ b/compiler/src/Gren/Kernel.hs @@ -85,7 +85,7 @@ parser :: Pkg.Name -> Foreigns -> Parser () Content parser pkg foreigns = do word2 0x2F 0x2A {-/*-} toError - Space.chomp ignoreError + _ <- Space.chomp ignoreError Space.checkFreshLine toError imports <- specialize ignoreError (Module.chompImports []) word2 0x2A 0x2F toError -- / From a1fcc0516baeffe36b99a0dd33be5e5272848420 Mon Sep 17 00:00:00 2001 From: Aaron VonderHaar Date: Sat, 12 Nov 2022 12:39:59 -0800 Subject: [PATCH 7/8] format: retain comments in 'exposing' clause of 'import' lines --- builder/src/Build.hs | 2 +- compiler/src/AST/Source.hs | 3 ++- compiler/src/AST/SourceComments.hs | 6 ++++++ .../src/Canonicalize/Environment/Foreign.hs | 4 ++-- compiler/src/Gren/Compiler/Imports.hs | 2 +- compiler/src/Gren/Format.hs | 19 +++++++++++-------- compiler/src/Gren/Format/Normalize.hs | 6 +++--- compiler/src/Gren/Kernel.hs | 2 +- compiler/src/Parse/Module.hs | 12 +++++++----- .../src/Reporting/Render/Type/Localizer.hs | 2 +- terminal/src/Repl.hs | 2 +- tests/Integration/FormatSpec.hs | 12 ++++++++++-- 12 files changed, 46 insertions(+), 26 deletions(-) diff --git a/builder/src/Build.hs b/builder/src/Build.hs index d141a702b..cc346b4c1 100644 --- a/builder/src/Build.hs +++ b/builder/src/Build.hs @@ -443,7 +443,7 @@ toImportErrors (Env _ _ _ _ _ _ locals foreigns) results imports problems = Set.difference knownModules (Set.fromList (map Src.getImportName imports)) regionDict = - Map.fromList (map (\(Src.Import (A.At region name) _ _ _) -> (name, region)) imports) + Map.fromList (map (\(Src.Import (A.At region name) _ _ _ _) -> (name, region)) imports) toError (name, problem) = Import.Error (regionDict ! name) name unimportedModules problem diff --git a/compiler/src/AST/Source.hs b/compiler/src/AST/Source.hs index fd2bd3a86..aaf2c62fd 100644 --- a/compiler/src/AST/Source.hs +++ b/compiler/src/AST/Source.hs @@ -143,13 +143,14 @@ getName (Module maybeName _ _ _ _ _ _ _ _ _) = Name._Main getImportName :: Import -> Name -getImportName (Import (A.At _ name) _ _ _) = +getImportName (Import (A.At _ name) _ _ _ _) = name data Import = Import { _import :: A.Located Name, _alias :: Maybe (Name, SC.ImportAliasComments), _exposing :: Exposing, + _exposingComments :: Maybe SC.ImportExposingComments, _importComments :: SC.ImportComments } deriving (Show) diff --git a/compiler/src/AST/SourceComments.hs b/compiler/src/AST/SourceComments.hs index 334facef3..bb0c095ab 100644 --- a/compiler/src/AST/SourceComments.hs +++ b/compiler/src/AST/SourceComments.hs @@ -68,3 +68,9 @@ data ImportAliasComments = ImportAliasComments _afterAliasName :: [Comment] } deriving (Eq, Show) + +data ImportExposingComments = ImportExposingComments + { _afterExposing :: [Comment], + _afterExposingListing :: [Comment] + } + deriving (Show) diff --git a/compiler/src/Canonicalize/Environment/Foreign.hs b/compiler/src/Canonicalize/Environment/Foreign.hs index fd7f65980..139942f7a 100644 --- a/compiler/src/Canonicalize/Environment/Foreign.hs +++ b/compiler/src/Canonicalize/Environment/Foreign.hs @@ -68,7 +68,7 @@ toSafeImports (ModuleName.Canonical pkg _) imports = else imports isNormal :: Src.Import -> Bool -isNormal (Src.Import (A.At _ name) maybeAlias _ _) = +isNormal (Src.Import (A.At _ name) maybeAlias _ _ _) = if Name.isKernel name then case maybeAlias of Nothing -> False @@ -78,7 +78,7 @@ isNormal (Src.Import (A.At _ name) maybeAlias _ _) = -- ADD IMPORTS addImport :: Map.Map ModuleName.Raw I.Interface -> State -> Src.Import -> Result i w State -addImport ifaces (State vs ts cs bs qvs qts qcs) (Src.Import (A.At _ name) maybeAlias exposing _) = +addImport ifaces (State vs ts cs bs qvs qts qcs) (Src.Import (A.At _ name) maybeAlias exposing _ _) = let (I.Interface pkg defs unions aliases binops) = ifaces ! name !prefix = maybe name id (fmap fst maybeAlias) !home = ModuleName.Canonical pkg name diff --git a/compiler/src/Gren/Compiler/Imports.hs b/compiler/src/Gren/Compiler/Imports.hs index 189d0d5d0..b41f72f8a 100644 --- a/compiler/src/Gren/Compiler/Imports.hs +++ b/compiler/src/Gren/Compiler/Imports.hs @@ -31,7 +31,7 @@ defaults = import_ :: ModuleName.Canonical -> Maybe Name.Name -> Src.Exposing -> Src.Import import_ (ModuleName.Canonical _ name) maybeAlias exposing = let maybeAliasWithComments = fmap (,(SC.ImportAliasComments [] [])) maybeAlias - in Src.Import (A.At A.zero name) maybeAliasWithComments exposing (SC.ImportComments [] []) + in Src.Import (A.At A.zero name) maybeAliasWithComments exposing Nothing (SC.ImportComments [] []) -- EXPOSING diff --git a/compiler/src/Gren/Format.hs b/compiler/src/Gren/Format.hs index 970ec91d5..55f34ddd9 100644 --- a/compiler/src/Gren/Format.hs +++ b/compiler/src/Gren/Format.hs @@ -175,7 +175,7 @@ formatModule (Src.Module moduleName exports docs imports values unions aliases b Just $ Block.line $ maybe (Block.string7 "Main") (utf8 . A.toValue) moduleName, formatCommentBlock commentsAfterName, formatEffectsModuleWhereClause effects, - formatExposing commentsAfterExposingKeyword (A.toValue exports) + formatExposing commentsAfterExposingKeyword [] (A.toValue exports) ], case docs of Src.NoDocs _ -> Nothing @@ -279,23 +279,23 @@ formatManager manager = ] ) -formatExposing :: [Src.Comment] -> Src.Exposing -> Maybe Block -formatExposing commentsAfterKeyword = \case +formatExposing :: [Src.Comment] -> [Src.Comment] -> Src.Exposing -> Maybe Block +formatExposing commentsAfterKeyword commentsAfterListing = \case Src.Open -> Just $ spaceOrIndent [ Block.line $ Block.string7 "exposing", - withCommentsBefore commentsAfterKeyword $ + withCommentsAround commentsAfterKeyword commentsAfterListing $ Block.line $ Block.string7 "(..)" ] Src.Explicit [] -> - formatCommentBlock commentsAfterKeyword + formatCommentBlock (commentsAfterKeyword <> commentsAfterListing) Src.Explicit exposed -> Just $ spaceOrIndent [ Block.line $ Block.string7 "exposing", - withCommentsBefore commentsAfterKeyword $ + withCommentsAround commentsAfterKeyword commentsAfterListing $ group '(' ',' ')' False $ fmap formatExposed exposed ] @@ -307,7 +307,7 @@ formatExposed = \case Src.Operator _ name -> Block.line $ Block.char7 '(' <> utf8 name <> Block.char7 ')' formatImport :: Src.Import -> Block -formatImport (Src.Import name alias exposing comments) = +formatImport (Src.Import name alias exposing exposingComments comments) = let (SC.ImportComments commentsAfterKeyword commentsAfterName) = comments in spaceOrIndent $ NonEmpty.fromList $ @@ -316,7 +316,10 @@ formatImport (Src.Import name alias exposing comments) = Just $ withCommentsBefore commentsAfterKeyword $ Block.line $ utf8 $ A.toValue name, (spaceOrStack . fmap formatComment) <$> NonEmpty.nonEmpty commentsAfterName, fmap formatImportAlias alias, - formatExposing [] exposing + formatExposing + (maybe [] SC._afterExposing exposingComments) + (maybe [] SC._afterExposingListing exposingComments) + exposing ] formatImportAlias :: (Name, SC.ImportAliasComments) -> Block diff --git a/compiler/src/Gren/Format/Normalize.hs b/compiler/src/Gren/Format/Normalize.hs index 6125a4e4f..f71fb34a1 100644 --- a/compiler/src/Gren/Format/Normalize.hs +++ b/compiler/src/Gren/Format/Normalize.hs @@ -25,13 +25,13 @@ normalize projectType module_ = } importSortKey :: Src.Import -> Name -importSortKey (Src.Import name _ _ _) = +importSortKey (Src.Import name _ _ _ _) = A.toValue name removeDefaultImports :: Parse.ProjectType -> Src.Import -> Maybe Src.Import -removeDefaultImports projectType import_@(Src.Import name alias exposing _) = +removeDefaultImports projectType import_@(Src.Import name alias exposing _ _) = case Map.lookup (A.toValue name) (defaultImports projectType) of - Just (Src.Import _ defAlias defExposing _) -> + Just (Src.Import _ defAlias defExposing _ _) -> if alias == defAlias && exposingEq exposing defExposing then Nothing else Just import_ diff --git a/compiler/src/Gren/Kernel.hs b/compiler/src/Gren/Kernel.hs index 4133342dc..325e05076 100644 --- a/compiler/src/Gren/Kernel.hs +++ b/compiler/src/Gren/Kernel.hs @@ -219,7 +219,7 @@ toVarTable pkg foreigns imports = List.foldl' (addImport pkg foreigns) Map.empty imports addImport :: Pkg.Name -> Foreigns -> VarTable -> Src.Import -> VarTable -addImport pkg foreigns vtable (Src.Import (A.At _ importName) maybeAlias exposing _) = +addImport pkg foreigns vtable (Src.Import (A.At _ importName) maybeAlias exposing _ _) = if Name.isKernel importName then case maybeAlias of Just _ -> diff --git a/compiler/src/Parse/Module.hs b/compiler/src/Parse/Module.hs index d228275dc..8095b6e95 100644 --- a/compiler/src/Parse/Module.hs +++ b/compiler/src/Parse/Module.hs @@ -392,7 +392,7 @@ chompImport = E.ImportEnd [ do Space.checkFreshLine E.ImportEnd - return $ Src.Import name Nothing (Src.Explicit []) comments, + return $ Src.Import name Nothing (Src.Explicit []) Nothing comments, do Space.checkIndent end E.ImportEnd oneOf @@ -417,7 +417,7 @@ chompAs name comments = E.ImportEnd [ do Space.checkFreshLine E.ImportEnd - return $ Src.Import name aliasWithComments (Src.Explicit []) comments, + return $ Src.Import name aliasWithComments (Src.Explicit []) Nothing comments, do Space.checkIndent end E.ImportEnd chompExposing name aliasWithComments comments @@ -427,10 +427,12 @@ chompExposing :: A.Located Name.Name -> Maybe (Name.Name, SC.ImportAliasComments chompExposing name maybeAlias comments = do Keyword.exposing_ E.ImportExposing - Space.chompAndCheckIndent E.ModuleSpace E.ImportIndentExposingArray + commentsAfterExposing <- Space.chompAndCheckIndent E.ModuleSpace E.ImportIndentExposingArray exposed <- specialize E.ImportExposingArray exposing - freshLine E.ImportEnd - return $ Src.Import name maybeAlias exposed comments + commentsAfterListing <- Space.chompIndentedAtLeast 1 E.ModuleSpace + commentsAfterImportLine <- freshLine E.ImportEnd + let exposingComments = SC.ImportExposingComments commentsAfterExposing commentsAfterListing + return $ Src.Import name maybeAlias exposed (Just exposingComments) comments -- LISTING diff --git a/compiler/src/Reporting/Render/Type/Localizer.hs b/compiler/src/Reporting/Render/Type/Localizer.hs index f6e44e565..d1ddd0083 100644 --- a/compiler/src/Reporting/Render/Type/Localizer.hs +++ b/compiler/src/Reporting/Render/Type/Localizer.hs @@ -72,7 +72,7 @@ fromModule modul@(Src.Module _ _ _ imports _ _ _ _ _ _) = (Src.getName modul, Import Nothing All) : map toPair imports toPair :: Src.Import -> (Name.Name, Import) -toPair (Src.Import (A.At _ name) alias exposing _) = +toPair (Src.Import (A.At _ name) alias exposing _ _) = ( name, Import (fmap fst alias) (toExposing exposing) ) diff --git a/terminal/src/Repl.hs b/terminal/src/Repl.hs index e695b6554..253bea546 100644 --- a/terminal/src/Repl.hs +++ b/terminal/src/Repl.hs @@ -257,7 +257,7 @@ attemptImport lines = let src = linesToByteString lines parser = P.specialize (\_ _ _ -> ()) PM.chompImport in case P.fromByteString parser (\_ _ -> ()) src of - Right (Src.Import (A.At _ name) _ _ _) -> + Right (Src.Import (A.At _ name) _ _ _ _) -> Done (Import name src) Left () -> ifFail lines (Import "ERR" src) diff --git a/tests/Integration/FormatSpec.hs b/tests/Integration/FormatSpec.hs index cc445961c..91c934476 100644 --- a/tests/Integration/FormatSpec.hs +++ b/tests/Integration/FormatSpec.hs @@ -85,12 +85,20 @@ spec = do it "formats comments" $ [ formattedModuleHeader, "import{-A-}Module1{-B-}", + " {-C-}", "import{-D-}Module2{-E-}as{-F-}M2{-G-}", + " {-H-}", + "import{-I-}Module3{-J-}exposing{-K-}(..){-L-}", + " {-M-}", + "import{-N-}Module4{-O-}as{-P-}M4{-Q-}exposing{-R-}(..){-S-}", + " {-T-}", formattedModuleBody ] `shouldFormatAs` [ formattedModuleHeader, - "import {- A -} Module1 {- B -}", - "import {- D -} Module2 {- E -} as {- F -} M2 {- G -}", + "import {- A -} Module1 {- B -} {- C -}", + "import {- D -} Module2 {- E -} as {- F -} M2 {- G -} {- H -}", + "import {- I -} Module3 {- J -} exposing {- K -} (..) {- L -} {- M -}", + "import {- N -} Module4 {- O -} as {- P -} M4 {- Q -} exposing {- R -} (..) {- S -} {- T -}", formattedModuleBody ] it "does not attach unindented comments to the import line" $ From c0a4082c1a42269597278906162169b523aa8e0e Mon Sep 17 00:00:00 2001 From: Aaron VonderHaar Date: Sat, 12 Nov 2022 13:01:07 -0800 Subject: [PATCH 8/8] Remove duplicate tests that are already covered by the "formats comments" test --- tests/Integration/FormatSpec.hs | 21 --------------------- 1 file changed, 21 deletions(-) diff --git a/tests/Integration/FormatSpec.hs b/tests/Integration/FormatSpec.hs index 91c934476..82e262ec8 100644 --- a/tests/Integration/FormatSpec.hs +++ b/tests/Integration/FormatSpec.hs @@ -122,27 +122,6 @@ spec = do formattedModuleBody ] - it "allows indented comments after module name" $ - [ formattedModuleHeader, - "import Module1", - " {-A-}", - formattedModuleBody - ] - `shouldFormatAs` [ formattedModuleHeader, - "import Module1 {- A -}", - formattedModuleBody - ] - it "allows indented comments after 'as' clause" $ - [ formattedModuleHeader, - "import Module1 as M1", - " {-A-}", - formattedModuleBody - ] - `shouldFormatAs` [ formattedModuleHeader, - "import Module1 as M1 {- A -}", - formattedModuleBody - ] - describe "top-level definition" $ do it "formats already formatted" $ assertFormattedModuleBody