format: retain comments in import statements

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

compiler/src/AST/Source.hs

@@ -143,13 +143,15 @@ 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
+    _alias :: Maybe (Name, SC.ImportAliasComments),
+    _exposing :: Exposing,
+    _exposingComments :: Maybe SC.ImportExposingComments,
+    _importComments :: SC.ImportComments
   }
   deriving (Show)
 

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
 
@@ -54,3 +54,23 @@ data FxComments = FxComments
     _subComments :: SubComments
   }
   deriving (Show)
+
+-- Import
+
+data ImportComments = ImportComments
+  { _afterImportKeyword :: [Comment],
+    _afterImportName :: [Comment]
+  }
+  deriving (Show)
+
+data ImportAliasComments = ImportAliasComments
+  { _afterAs :: [Comment],
+    _afterAliasName :: [Comment]
+  }
+  deriving (Eq, Show)
+
+data ImportExposingComments = ImportExposingComments
+  { _afterExposing :: [Comment],
+    _afterExposingListing :: [Comment]
+  }
+  deriving (Show)

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,9 +78,9 @@ 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
+      !prefix = maybe name id (fmap fst maybeAlias)
       !home = ModuleName.Canonical pkg name
 
       !rawTypeInfo =

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,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
+  let maybeAliasWithComments = fmap (,(SC.ImportAliasComments [] [])) maybeAlias
+   in Src.Import (A.At A.zero name) maybeAliasWithComments exposing Nothing (SC.ImportComments [] [])
 
 -- EXPOSING
 

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
@@ -168,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
@@ -272,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
         ]
@@ -300,18 +307,27 @@ 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 exposingComments 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
+                (maybe [] SC._afterExposing exposingComments)
+                (maybe [] SC._afterExposingListing exposingComments)
+                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) =

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)
@@ -20,13 +21,17 @@ import Reporting.Annotation qualified as A
 normalize :: Parse.ProjectType -> Src.Module -> Src.Module
 normalize projectType module_ =
   module_
-    { Src._imports = mapMaybe (removeDefaultImports projectType) $ Src._imports module_
+    { Src._imports = List.sortOn importSortKey $ mapMaybe (removeDefaultImports projectType) $ Src._imports module_
     }
 
+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_

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
@@ -84,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 -- /
@@ -218,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 _ ->
@@ -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

compiler/src/Parse/Module.hs

@@ -383,49 +383,56 @@ 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.chompIndentedAtLeast 1 E.ModuleSpace
+    commentsAfterImportLine <- 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 []) Nothing 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
+    commentsAfterAs <- Space.chompAndCheckIndent E.ModuleSpace E.ImportIndentAlias
     alias <- Var.moduleName E.ImportAlias
     end <- getPosition
-    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
       E.ImportEnd
       [ do
           Space.checkFreshLine E.ImportEnd
-          return $ Src.Import name (Just alias) (Src.Explicit []),
+          return $ Src.Import name aliasWithComments (Src.Explicit []) Nothing comments,
         do
           Space.checkIndent end E.ImportEnd
-          chompExposing name (Just alias)
+          chompExposing name aliasWithComments 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.ImportAliasComments) -> SC.ImportComments -> Parser E.Module Src.Import
+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
+    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