format: retain comments in arrays and records

compiler/src/AST/Source.hs

@@ -8,15 +8,19 @@ module AST.Source
     Expr,
     Expr_ (..),
     VarType (..),
+    ArrayEntry,
     IfBranch,
     CaseBranch,
+    RecordField,
     Def (..),
     Pattern,
     Pattern_ (..),
     RecordFieldPattern,
     RecordFieldPattern_ (..),
+    PArrayEntry,
     Type,
     Type_ (..),
+    TRecordField,
     SourceOrder,
     Module (..),
     getName,
@@ -59,7 +63,7 @@ data Expr_
   | Float EF.Float
   | Var VarType Name
   | VarQual VarType Name Name
-  | Array [Expr]
+  | Array [ArrayEntry]
   | Op Name
   | Negate Expr
   | Binops [(Expr, [Comment], A.Located Name)] Expr
@@ -70,20 +74,26 @@ data Expr_
   | Case Expr [CaseBranch] SC.CaseComments
   | Accessor Name
   | Access Expr (A.Located Name)
-  | Update Expr [(A.Located Name, Expr)]
-  | Record [(A.Located Name, Expr)]
+  | Update Expr [RecordField] SC.UpdateComments
+  | Record [RecordField]
   | Parens [Comment] Expr [Comment]
   deriving (Show)
 
 data VarType = LowVar | CapVar
   deriving (Show)
 
+type ArrayEntry =
+  (Expr, SC.ArrayEntryComments)
+
 type IfBranch =
   (Expr, Expr, SC.IfBranchComments)
 
 type CaseBranch =
   (Pattern, Expr, SC.CaseBranchComments)
 
+type RecordField =
+  (A.Located Name, Expr, SC.RecordFieldComments)
+
 -- DEFINITIONS
 
 data Def
@@ -102,7 +112,7 @@ data Pattern_
   | PAlias Pattern (A.Located Name)
   | PCtor A.Region Name [([Comment], Pattern)]
   | PCtorQual A.Region Name Name [([Comment], Pattern)]
-  | PArray [Pattern]
+  | PArray [PArrayEntry]
   | PChr ES.String
   | PStr ES.String
   | PInt Int
@@ -113,6 +123,8 @@ type RecordFieldPattern = A.Located RecordFieldPattern_
 data RecordFieldPattern_ = RFPattern (A.Located Name) Pattern
   deriving (Show)
 
+type PArrayEntry = (Pattern, SC.PArrayEntryComments)
+
 -- TYPE
 
 type Type =
@@ -123,9 +135,11 @@ data Type_
   | TVar Name
   | TType A.Region Name [([Comment], Type)]
   | TTypeQual A.Region Name Name [([Comment], Type)]
-  | TRecord [(A.Located Name, Type)] (Maybe (A.Located Name))
+  | TRecord [TRecordField] (Maybe (A.Located Name, SC.UpdateComments))
   deriving (Show)
 
+type TRecordField = (A.Located Name, Type, SC.RecordFieldComments)
+
 -- MODULE
 
 type SourceOrder = Int

compiler/src/AST/SourceComments.hs

@@ -89,6 +89,12 @@ data ValueComments = ValueComments
 
 -- Expressions
 
+data ArrayEntryComments = ArrayEntryComments
+  { _beforeArrayEntry :: [Comment],
+    _afterArrayEntry :: [Comment]
+  }
+  deriving (Show)
+
 data LambdaComments = LambdaComments
   { _beforeArrow :: [Comment],
     _afterArrow :: [Comment]
@@ -128,3 +134,25 @@ data CaseBranchComments = CaseBranchComments
     _afterBranchBody :: [Comment]
   }
   deriving (Show)
+
+data UpdateComments = UpdateComments
+  { _beforeBase :: [Comment],
+    _afterBase :: [Comment]
+  }
+  deriving (Show)
+
+data RecordFieldComments = RecordFieldComments
+  { _beforeFieldName :: [Comment],
+    _afterFieldName :: [Comment],
+    _beforeFieldValue :: [Comment],
+    _afterFieldValue :: [Comment]
+  }
+  deriving (Show)
+
+-- Patterns
+
+data PArrayEntryComments = PArrayEntryComments
+  { _beforePArrayEntry :: [Comment],
+    _afterPArrayEntry :: [Comment]
+  }
+  deriving (Show)

compiler/src/Canonicalize/Environment/Dups.hs

@@ -52,20 +52,20 @@ detectHelp toError name values =
 
 -- CHECK FIELDS
 
-checkFields :: [(A.Located Name.Name, a)] -> Result.Result i w Error.Error (Map.Map Name.Name a)
+checkFields :: [(A.Located Name.Name, a, comments)] -> Result.Result i w Error.Error (Map.Map Name.Name a)
 checkFields fields =
   detect Error.DuplicateField (foldr addField none fields)
 
-addField :: (A.Located Name.Name, a) -> Dict a -> Dict a
-addField (A.At region name, value) dups =
+addField :: (A.Located Name.Name, a, comments) -> Dict a -> Dict a
+addField (A.At region name, value, _) dups =
   Map.insertWith OneOrMore.more name (OneOrMore.one (Info region value)) dups
 
-checkFields' :: (A.Region -> a -> b) -> [(A.Located Name.Name, a)] -> Result.Result i w Error.Error (Map.Map Name.Name b)
+checkFields' :: (A.Region -> a -> b) -> [(A.Located Name.Name, a, comments)] -> Result.Result i w Error.Error (Map.Map Name.Name b)
 checkFields' toValue fields =
   detect Error.DuplicateField (foldr (addField' toValue) none fields)
 
-addField' :: (A.Region -> a -> b) -> (A.Located Name.Name, a) -> Dict b -> Dict b
-addField' toValue (A.At region name, value) dups =
+addField' :: (A.Region -> a -> b) -> (A.Located Name.Name, a, comments) -> Dict b -> Dict b
+addField' toValue (A.At region name, value, _) dups =
   Map.insertWith OneOrMore.more name (OneOrMore.one (Info region (toValue region value))) dups
 
 -- BUILDING DICTIONARIES

compiler/src/Canonicalize/Environment/Local.hs

@@ -136,7 +136,7 @@ getEdges edges (A.At _ tipe) =
     Src.TTypeQual _ _ _ args ->
       List.foldl' getEdges edges (fmap snd args)
     Src.TRecord fields _ ->
-      List.foldl' (\es (_, t) -> getEdges es t) edges fields
+      List.foldl' (\es (_, t, _) -> getEdges es t) edges fields
 
 -- CHECK FREE VARIABLES
 
@@ -192,9 +192,9 @@ addFreeVars freeVars (A.At region tipe) =
             case maybeExt of
               Nothing ->
                 freeVars
-              Just (A.At extRegion ext) ->
+              Just (A.At extRegion ext, _) ->
                 Map.insert ext extRegion freeVars
-       in List.foldl' (\fvs (_, t) -> addFreeVars fvs t) extFreeVars fields
+       in List.foldl' (\fvs (_, t, _) -> addFreeVars fvs t) extFreeVars fields
 
 -- ADD CTORS
 

compiler/src/Canonicalize/Expression.hs

@@ -67,7 +67,7 @@ canonicalize env (A.At region expression) =
           Src.LowVar -> findVarQual region env prefix name
           Src.CapVar -> toVarCtor name <$> Env.findCtorQual region env prefix name
       Src.Array exprs ->
-        Can.Array <$> traverse (canonicalize env) exprs
+        Can.Array <$> traverse (canonicalize env) (fmap fst exprs)
       Src.Op op ->
         do
           (Env.Binop _ home name annotation _ _) <- Env.findBinop region env op
@@ -110,7 +110,7 @@ canonicalize env (A.At region expression) =
         Can.Access
           <$> canonicalize env record
           <*> Result.ok field
-      Src.Update baseRecord fields ->
+      Src.Update baseRecord fields _ ->
         let makeCanFields =
               Dups.checkFields' (\r t -> Can.FieldUpdate r <$> canonicalize env t) fields
          in Can.Update
@@ -250,7 +250,7 @@ addBindingsHelp bindings (A.At region pattern) =
     Src.PCtorQual _ _ _ patterns ->
       List.foldl' addBindingsHelp bindings (fmap snd patterns)
     Src.PArray patterns ->
-      List.foldl' addBindingsHelp bindings patterns
+      List.foldl' addBindingsHelp bindings (fmap fst patterns)
     Src.PAlias aliasPattern (A.At nameRegion name) ->
       Dups.insert name nameRegion nameRegion $
         addBindingsHelp bindings aliasPattern
@@ -358,7 +358,7 @@ getPatternNames names (A.At region pattern) =
     Src.PAlias ptrn name -> getPatternNames (name : names) ptrn
     Src.PCtor _ _ args -> List.foldl' getPatternNames names (fmap snd args)
     Src.PCtorQual _ _ _ args -> List.foldl' getPatternNames names (fmap snd args)
-    Src.PArray patterns -> List.foldl' getPatternNames names patterns
+    Src.PArray patterns -> List.foldl' getPatternNames names (fmap fst patterns)
     Src.PChr _ -> names
     Src.PStr _ -> names
     Src.PInt _ -> names

compiler/src/Canonicalize/Pattern.hs

@@ -69,7 +69,7 @@ canonicalize env (A.At region pattern) =
       Src.PCtorQual nameRegion home name patterns ->
         canonicalizeCtor env region name (fmap snd patterns) =<< Env.findCtorQual nameRegion env home name
       Src.PArray patterns ->
-        Can.PArray <$> canonicalizeList env patterns
+        Can.PArray <$> canonicalizeList env (fmap fst patterns)
       Src.PAlias ptrn (A.At reg name) ->
         do
           cpattern <- canonicalize env ptrn

compiler/src/Canonicalize/Type.hs

@@ -51,13 +51,13 @@ canonicalize env (A.At typeRegion tipe) =
     Src.TRecord fields ext ->
       do
         cfields <- sequenceA =<< Dups.checkFields (canonicalizeFields env fields)
-        return $ Can.TRecord cfields (fmap A.toValue ext)
+        return $ Can.TRecord cfields (fmap (A.toValue . fst) ext)
 
-canonicalizeFields :: Env.Env -> [(A.Located Name.Name, Src.Type)] -> [(A.Located Name.Name, Result i w Can.FieldType)]
+canonicalizeFields :: Env.Env -> [Src.TRecordField] -> [(A.Located Name.Name, Result i w Can.FieldType, ())]
 canonicalizeFields env fields =
   let len = fromIntegral (length fields)
-      canonicalizeField index (name, srcType) =
-        (name, Can.FieldType index <$> canonicalize env srcType)
+      canonicalizeField index (name, srcType, _) =
+        (name, Can.FieldType index <$> canonicalize env srcType, ())
    in zipWith canonicalizeField [0 .. len] fields
 
 -- CANONICALIZE TYPE

compiler/src/Gren/Compiler/Type.hs

@@ -102,10 +102,10 @@ fromRawType (A.At _ astType) =
     Src.TTypeQual _ _ name args ->
       Type name (map (fromRawType . snd) args)
     Src.TRecord fields ext ->
-      let fromField (A.At _ field, tipe) = (field, fromRawType tipe)
+      let fromField (A.At _ field, tipe, _) = (field, fromRawType tipe)
        in Record
             (map fromField fields)
-            (fmap A.toValue ext)
+            (fmap (A.toValue . fst) ext)
 
 -- JSON for PROGRAM