format: retain top-level comments

builder/src/Build.hs

@@ -269,14 +269,14 @@ crawlFile env@(Env _ root projectType _ _ buildID _ _) mvar docsNeed expectedNam
     case Parse.fromByteString projectType source of
       Left err ->
         return $ SBadSyntax path time source err
-      Right modul@(Src.Module maybeActualName _ _ imports values _ _ _ _ _) ->
+      Right modul@(Src.Module maybeActualName _ _ imports values _ _ _ _ _ _) ->
         case maybeActualName of
           Nothing ->
             return $ SBadSyntax path time source (Syntax.ModuleNameUnspecified expectedName)
           Just name@(A.At _ actualName) ->
             if expectedName == actualName
               then
-                let deps = map Src.getImportName imports
+                let deps = map (Src.getImportName . snd) imports
                     local = Details.Local path time deps (any (isMain . snd) values) lastChange buildID
                  in crawlDeps env mvar deps (SChanged local source modul docsNeed)
               else return $ SBadSyntax path time source (Syntax.ModuleNameMismatch expectedName name)
@@ -335,11 +335,11 @@ checkModule env@(Env _ root projectType _ _ _ _ _) foreigns resultsMVar name sta
                 RProblem $
                   Error.Module name path time source $
                     case Parse.fromByteString projectType source of
-                      Right (Src.Module _ _ _ imports _ _ _ _ _ _) ->
+                      Right (Src.Module _ _ _ imports _ _ _ _ _ _ _) ->
                         Error.BadImports (toImportErrors env results imports problems)
                       Left err ->
                         Error.BadSyntax err
-    SChanged local@(Details.Local path time deps _ _ lastCompile) source modul@(Src.Module _ _ _ imports _ _ _ _ _ _) docsNeed ->
+    SChanged local@(Details.Local path time deps _ _ lastCompile) source modul@(Src.Module _ _ _ imports _ _ _ _ _ _ _) docsNeed ->
       do
         results <- readMVar resultsMVar
         depsStatus <- checkDeps root results deps lastCompile
@@ -430,7 +430,7 @@ checkDepsHelp root results deps new same cached importProblems isBlocked lastDep
 
 -- TO IMPORT ERROR
 
-toImportErrors :: Env -> ResultDict -> [Src.Import] -> NE.List (ModuleName.Raw, Import.Problem) -> NE.List Import.Error
+toImportErrors :: Env -> ResultDict -> [([Src.Comment], Src.Import)] -> NE.List (ModuleName.Raw, Import.Problem) -> NE.List Import.Error
 toImportErrors (Env _ _ _ _ _ _ locals foreigns) results imports problems =
   let knownModules =
         Set.unions
@@ -440,10 +440,10 @@ toImportErrors (Env _ _ _ _ _ _ locals foreigns) results imports problems =
           ]
 
       unimportedModules =
-        Set.difference knownModules (Set.fromList (map Src.getImportName imports))
+        Set.difference knownModules (Set.fromList (map (Src.getImportName . snd) 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
@@ -760,11 +760,11 @@ fromRepl root details source =
     case Parse.fromByteString projectType source of
       Left syntaxError ->
         return $ Left $ Exit.ReplBadInput source $ Error.BadSyntax syntaxError
-      Right modul@(Src.Module _ _ _ imports _ _ _ _ _ _) ->
+      Right modul@(Src.Module _ _ _ imports _ _ _ _ _ _ _) ->
         do
           dmvar <- Details.loadInterfaces root details
 
-          let deps = map Src.getImportName imports
+          let deps = map (Src.getImportName . snd) imports
           mvar <- newMVar Map.empty
           crawlDeps env mvar deps ()
 
@@ -785,7 +785,7 @@ fromRepl root details source =
                 finalizeReplArtifacts env source modul depsStatus resultMVars results
 
 finalizeReplArtifacts :: Env -> B.ByteString -> Src.Module -> DepsStatus -> ResultDict -> Map.Map ModuleName.Raw Result -> IO (Either Exit.Repl ReplArtifacts)
-finalizeReplArtifacts env@(Env _ root projectType platform _ _ _ _) source modul@(Src.Module _ _ _ imports _ _ _ _ _ _) depsStatus resultMVars results =
+finalizeReplArtifacts env@(Env _ root projectType platform _ _ _ _) source modul@(Src.Module _ _ _ imports _ _ _ _ _ _ _) depsStatus resultMVars results =
   let pkg =
         projectTypeToPkg projectType
 
@@ -951,9 +951,9 @@ crawlRoot env@(Env _ _ projectType _ _ buildID _ _) mvar root =
         time <- File.getTime path
         source <- File.readUtf8 path
         case Parse.fromByteString projectType source of
-          Right modul@(Src.Module _ _ _ imports values _ _ _ _ _) ->
+          Right modul@(Src.Module _ _ _ imports values _ _ _ _ _ _) ->
             do
-              let deps = map Src.getImportName imports
+              let deps = map (Src.getImportName . snd) imports
               let local = Details.Local path time deps (any (isMain . snd) values) buildID buildID
               crawlDeps env mvar deps (SOutsideOk local source modul)
           Left syntaxError ->
@@ -976,7 +976,7 @@ checkRoot env@(Env _ root _ _ _ _ _ _) results rootStatus =
       return (RInside name)
     SOutsideErr err ->
       return (ROutsideErr err)
-    SOutsideOk local@(Details.Local path time deps _ _ lastCompile) source modul@(Src.Module _ _ _ imports _ _ _ _ _ _) ->
+    SOutsideOk local@(Details.Local path time deps _ _ lastCompile) source modul@(Src.Module _ _ _ imports _ _ _ _ _ _ _) ->
       do
         depsStatus <- checkDeps root results deps lastCompile
         case depsStatus of

builder/src/Gren/Details.hs

@@ -491,9 +491,9 @@ crawlFile foreignDeps mvar pkg src docsStatus expectedName path =
   do
     bytes <- File.readUtf8 path
     case Parse.fromByteString (Parse.Package pkg) bytes of
-      Right modul@(Src.Module (Just (A.At _ actualName)) _ _ imports _ _ _ _ _ _) | expectedName == actualName ->
+      Right modul@(Src.Module (Just (A.At _ actualName)) _ _ imports _ _ _ _ _ _ _) | expectedName == actualName ->
         do
-          deps <- crawlImports foreignDeps mvar pkg src imports
+          deps <- crawlImports foreignDeps mvar pkg src (fmap snd imports)
           return (Just (SLocal docsStatus deps modul))
       _ ->
         return Nothing

compiler/src/AST/Source.hs

@@ -37,6 +37,7 @@ where
 import AST.SourceComments (Comment, GREN_COMMENT)
 import AST.SourceComments qualified as SC
 import AST.Utils.Binop qualified as Binop
+import Data.List.NonEmpty (NonEmpty)
 import Data.Name (Name)
 import Data.Name qualified as Name
 import Gren.Float qualified as EF
@@ -58,12 +59,12 @@ data Expr_
   | Array [Expr]
   | Op Name
   | Negate Expr
-  | Binops [(Expr, A.Located Name)] Expr
+  | Binops [(Expr, [Comment], A.Located Name)] Expr
   | Lambda [Pattern] Expr
-  | Call Expr [Expr]
+  | Call Expr [([Comment], Expr)]
   | If [(Expr, Expr)] Expr
   | Let [A.Located Def] Expr
-  | Case Expr [(Pattern, Expr)]
+  | Case Expr [([Comment], Pattern, Expr)]
   | Accessor Name
   | Access Expr (A.Located Name)
   | Update Expr [(A.Located Name, Expr)]
@@ -111,8 +112,8 @@ type Type =
 data Type_
   = TLambda Type Type
   | TVar Name
-  | TType A.Region Name [Type]
-  | TTypeQual A.Region Name Name [Type]
+  | TType A.Region Name [([Comment], Type)]
+  | TTypeQual A.Region Name Name [([Comment], Type)]
   | TRecord [(A.Located Name, Type)] (Maybe (A.Located Name))
   deriving (Show)
 
@@ -124,18 +125,19 @@ data Module = Module
   { _name :: Maybe (A.Located Name),
     _exports :: A.Located Exposing,
     _docs :: Docs,
-    _imports :: [Import],
+    _imports :: [([Comment], Import)],
     _values :: [(SourceOrder, A.Located Value)],
     _unions :: [(SourceOrder, A.Located Union)],
     _aliases :: [(SourceOrder, A.Located Alias)],
     _binops :: [A.Located Infix],
+    _topLevelComments :: [(SourceOrder, NonEmpty Comment)],
     _headerComments :: SC.HeaderComments,
     _effects :: Effects
   }
   deriving (Show)
 
 getName :: Module -> Name
-getName (Module maybeName _ _ _ _ _ _ _ _ _) =
+getName (Module maybeName _ _ _ _ _ _ _ _ _ _) =
   case maybeName of
     Just (A.At _ name) ->
       name
@@ -158,7 +160,7 @@ data Import = Import
 data Value = Value (A.Located Name) [Pattern] Expr (Maybe Type)
   deriving (Show)
 
-data Union = Union (A.Located Name) [A.Located Name] [(A.Located Name, [Type])]
+data Union = Union (A.Located Name) [A.Located Name] [(A.Located Name, [([Comment], Type)])]
   deriving (Show)
 
 data Alias = Alias (A.Located Name) [A.Located Name] Type

compiler/src/Canonicalize/Environment/Local.hs

@@ -46,7 +46,7 @@ addVars module_ (Env.Env home vs ts cs bs qvs qts qcs) =
     Result.ok $ Env.Env home vs2 ts cs bs qvs qts qcs
 
 collectVars :: Src.Module -> Result i w (Map.Map Name.Name Env.Var)
-collectVars (Src.Module _ _ _ _ values _ _ _ _ effects) =
+collectVars (Src.Module _ _ _ _ values _ _ _ _ _ effects) =
   let addDecl dict (A.At _ (Src.Value (A.At region name) _ _ _)) =
         Dups.insert name region (Env.TopLevel region) dict
    in Dups.detect Error.DuplicateDecl $
@@ -75,7 +75,7 @@ toEffectDups effects =
 -- ADD TYPES
 
 addTypes :: Src.Module -> Env.Env -> Result i w Env.Env
-addTypes (Src.Module _ _ _ _ _ unions aliases _ _ _) (Env.Env home vs ts cs bs qvs qts qcs) =
+addTypes (Src.Module _ _ _ _ _ unions aliases _ _ _ _) (Env.Env home vs ts cs bs qvs qts qcs) =
   let addAliasDups dups (A.At _ (Src.Alias (A.At region name) _ _)) = Dups.insert name region () dups
       addUnionDups dups (A.At _ (Src.Union (A.At region name) _ _)) = Dups.insert name region () dups
       typeNameDups =
@@ -132,9 +132,9 @@ getEdges edges (A.At _ tipe) =
     Src.TVar _ ->
       edges
     Src.TType _ name args ->
-      List.foldl' getEdges (name : edges) args
+      List.foldl' getEdges (name : edges) (fmap snd args)
     Src.TTypeQual _ _ _ args ->
-      List.foldl' getEdges edges args
+      List.foldl' getEdges edges (fmap snd args)
     Src.TRecord fields _ ->
       List.foldl' (\es (_, t) -> getEdges es t) edges fields
 
@@ -146,7 +146,7 @@ checkUnionFreeVars (A.At unionRegion (Src.Union (A.At _ name) args ctors)) =
         Dups.insert arg region region dict
 
       addCtorFreeVars (_, tipes) freeVars =
-        List.foldl' addFreeVars freeVars tipes
+        List.foldl' addFreeVars freeVars (fmap snd tipes)
    in do
         boundVars <- Dups.detect (Error.DuplicateUnionArg name) (foldr addArg Dups.none args)
         let freeVars = foldr addCtorFreeVars Map.empty ctors
@@ -184,9 +184,9 @@ addFreeVars freeVars (A.At region tipe) =
     Src.TVar name ->
       Map.insert name region freeVars
     Src.TType _ _ args ->
-      List.foldl' addFreeVars freeVars args
+      List.foldl' addFreeVars freeVars (fmap snd args)
     Src.TTypeQual _ _ _ args ->
-      List.foldl' addFreeVars freeVars args
+      List.foldl' addFreeVars freeVars (fmap snd args)
     Src.TRecord fields maybeExt ->
       let extFreeVars =
             case maybeExt of
@@ -199,7 +199,7 @@ addFreeVars freeVars (A.At region tipe) =
 -- ADD CTORS
 
 addCtors :: Src.Module -> Env.Env -> Result i w (Env.Env, Unions, Aliases)
-addCtors (Src.Module _ _ _ _ _ unions aliases _ _ _) env@(Env.Env home vs ts cs bs qvs qts qcs) =
+addCtors (Src.Module _ _ _ _ _ unions aliases _ _ _ _) env@(Env.Env home vs ts cs bs qvs qts qcs) =
   do
     unionInfo <- traverse (canonicalizeUnion env) (fmap snd unions)
     aliasInfo <- traverse (canonicalizeAlias env) (fmap snd aliases)
@@ -244,15 +244,15 @@ canonicalizeUnion env@(Env.Env home _ _ _ _ _ _ _) (A.At _ (Src.Union (A.At _ na
         Dups.unions $ map (toCtor home name union) cctors
       )
 
-canonicalizeCtor :: Env.Env -> Index.ZeroBased -> (A.Located Name.Name, [Src.Type]) -> Result i w (A.Located Can.Ctor)
+canonicalizeCtor :: Env.Env -> Index.ZeroBased -> (A.Located Name.Name, [([Src.Comment], Src.Type)]) -> Result i w (A.Located Can.Ctor)
 canonicalizeCtor env index (A.At region ctor, tipes) =
   do
-    ctipes <- traverse (Type.canonicalize env) tipes
+    ctipes <- traverse (Type.canonicalize env) (fmap snd tipes)
     Result.ok $
       A.At region $
         Can.Ctor ctor index (length ctipes) ctipes
 
-toOpts :: [(A.Located Name.Name, [Src.Type])] -> Can.CtorOpts
+toOpts :: [(A.Located Name.Name, [([Src.Comment], Src.Type)])] -> Can.CtorOpts
 toOpts ctors =
   case ctors of
     [(_, [_])] ->

compiler/src/Canonicalize/Expression.hs

@@ -93,7 +93,7 @@ canonicalize env (A.At region expression) =
       Src.Call func args ->
         Can.Call
           <$> canonicalize env func
-          <*> traverse (canonicalize env) args
+          <*> traverse (canonicalize env) (fmap snd args)
       Src.If branches finally ->
         Can.If
           <$> traverse (canonicalizeIfBranch env) branches
@@ -133,8 +133,8 @@ canonicalizeIfBranch env (condition, branch) =
 
 -- CANONICALIZE CASE BRANCH
 
-canonicalizeCaseBranch :: Env.Env -> (Src.Pattern, Src.Expr) -> Result FreeLocals [W.Warning] Can.CaseBranch
-canonicalizeCaseBranch env (pattern, expr) =
+canonicalizeCaseBranch :: Env.Env -> ([Src.Comment], Src.Pattern, Src.Expr) -> Result FreeLocals [W.Warning] Can.CaseBranch
+canonicalizeCaseBranch env (_, pattern, expr) =
   directUsage $
     do
       (cpattern, bindings) <-
@@ -149,9 +149,9 @@ canonicalizeCaseBranch env (pattern, expr) =
 
 -- CANONICALIZE BINOPS
 
-canonicalizeBinops :: A.Region -> Env.Env -> [(Src.Expr, A.Located Name.Name)] -> Src.Expr -> Result FreeLocals [W.Warning] Can.Expr
+canonicalizeBinops :: A.Region -> Env.Env -> [(Src.Expr, [Src.Comment], A.Located Name.Name)] -> Src.Expr -> Result FreeLocals [W.Warning] Can.Expr
 canonicalizeBinops overallRegion env ops final =
-  let canonicalizeHelp (expr, A.At region op) =
+  let canonicalizeHelp (expr, _, A.At region op) =
         (,)
           <$> canonicalize env expr
           <*> Env.findBinop region env op

compiler/src/Canonicalize/Module.hs

@@ -35,15 +35,15 @@ type Result i w a =
 -- MODULES
 
 canonicalize :: Pkg.Name -> Map.Map ModuleName.Raw I.Interface -> Src.Module -> Result i [W.Warning] Can.Module
-canonicalize pkg ifaces modul@(Src.Module _ exports docs imports valuesWithSourceOrder _ _ binops _ effects) =
+canonicalize pkg ifaces modul@(Src.Module _ exports docs imports valuesWithSourceOrder _ _ binops _ _ effects) =
   do
     let values = fmap snd valuesWithSourceOrder
     let home = ModuleName.Canonical pkg (Src.getName modul)
     let cbinops = Map.fromList (map canonicalizeBinop binops)
 
     (env, cunions, caliases) <-
       Local.add modul
-        =<< Foreign.createInitialEnv home ifaces imports
+        =<< Foreign.createInitialEnv home ifaces (fmap snd imports)
 
     cvalues <- canonicalizeValues env values
     ceffects <- Effects.canonicalize env values cunions effects

compiler/src/Canonicalize/Type.hs

@@ -39,10 +39,10 @@ canonicalize env (A.At typeRegion tipe) =
     Src.TVar x ->
       Result.ok (Can.TVar x)
     Src.TType region name args ->
-      canonicalizeType env typeRegion name args
+      canonicalizeType env typeRegion name (fmap snd args)
         =<< Env.findType region env name
     Src.TTypeQual region home name args ->
-      canonicalizeType env typeRegion name args
+      canonicalizeType env typeRegion name (fmap snd args)
         =<< Env.findTypeQual region env home name
     Src.TLambda a b ->
       Can.TLambda

compiler/src/Gren/Compiler/Type.hs

@@ -87,7 +87,7 @@ encode tipe =
 decoder :: D.Decoder () Type
 decoder =
   let parser =
-        P.specialize (\_ _ _ -> ()) (fromRawType . fst <$> Type.expression)
+        P.specialize (\_ _ _ -> ()) (fromRawType . fst . fst <$> Type.expression)
    in D.customString parser (\_ _ -> ())
 
 fromRawType :: Src.Type -> Type
@@ -98,9 +98,9 @@ fromRawType (A.At _ astType) =
     Src.TVar x ->
       Var x
     Src.TType _ name args ->
-      Type name (map fromRawType args)
+      Type name (map (fromRawType . snd) args)
     Src.TTypeQual _ _ name args ->
-      Type name (map fromRawType args)
+      Type name (map (fromRawType . snd) args)
     Src.TRecord fields ext ->
       let fromField (A.At _ field, tipe) = (field, fromRawType tipe)
        in Record