git.iko.soy/elk
on master help sign in
Improve the style of records in error messages
73cb511Evan Czaplicki
src/AST/Expression/General.hs+103−77
compare with master
unifiedsplit
@@ -87,83 +87,106 @@ dummyLet defs =
87
87
88instance (Pretty def, Pretty var, Var.ToString var) => Pretty (Expr' ann def var) where
88instance (Pretty def, Pretty var, Var.ToString var) => Pretty (Expr' ann def var) where
89 pretty expr =
89 pretty expr =
90− case expr of
90+ case expr of
91− Literal lit -> pretty lit
91+ Literal lit ->
92+ pretty lit
93+
94+ Var x ->
95+ pretty x
96+
97+ Range e1 e2 ->
98+ P.brackets (pretty e1 <> P.text ".." <> pretty e2)
99+
100+ ExplicitList es ->
101+ P.brackets (commaCat (map pretty es))
102+
103+ Binop op (Annotation.A _ (Literal (Literal.IntNum 0))) e
104+ | Var.toString op == "-" ->
105+ P.text "-" <> prettyParens e
106+
107+ Binop op e1 e2 ->
108+ P.hang (prettyParens e1) 2 (P.text op'' <+> prettyParens e2)
109+ where
110+ op' = Var.toString op
111+ op'' = if Help.isOp op' then op' else "`" ++ op' ++ "`"
112+
113+ Lambda p e ->
114+ P.text "\\" <> args <+> P.text "->" <+> pretty body
115+ where
116+ (ps,body) = collectLambdas (Annotation.A undefined $ Lambda p e)
117+ args = P.sep (map Pattern.prettyParens ps)
118+
119+ App _ _ ->
120+ P.hang func 2 (P.sep args)
121+ where
122+ func:args =
123+ map prettyParens (collectApps (Annotation.A undefined expr))
124+
125+ MultiIf branches ->
126+ P.text "if" $$ nest 3 (vcat $ map iff branches)
127+ where
128+ iff (b,e) = P.text "|" <+> P.hang (pretty b <+> P.text "->") 2 (pretty e)
129+
130+ Let defs e ->
131+ P.sep
132+ [ P.hang (P.text "let") 4 (P.vcat (map pretty defs))
133+ , P.text "in" <+> pretty e
134+ ]
135+
136+ Case e pats ->
137+ P.hang pexpr 2 (P.vcat (map pretty' pats))
138+ where
139+ pexpr = P.sep [ P.text "case" <+> pretty e, P.text "of" ]
140+ pretty' (p,b) = pretty p <+> P.text "->" <+> pretty b
141+
142+ Data "::" [hd,tl] -> pretty hd <+> P.text "::" <+> pretty tl
143+ Data "[]" [] -> P.text "[]"
144+ Data name es
145+ | Help.isTuple name -> P.parens (commaCat (map pretty es))
146+ | otherwise -> P.hang (P.text name) 2 (P.sep (map prettyParens es))
147+
148+ Access e x ->
149+ prettyParens e <> P.text "." <> variable x
150+
151+ Remove e x ->
152+ P.braces (pretty e <+> P.text "-" <+> variable x)
153+
154+ Insert (Annotation.A _ (Remove e y)) x v ->
155+ P.braces $
156+ P.hsep
157+ [ pretty e, P.text "-", variable y, P.text "|"
158+ , variable x, P.equals, pretty v
159+ ]
160+
161+ Insert e x v ->
162+ P.braces (pretty e <+> P.text "|" <+> variable x <+> P.equals <+> pretty v)
163+
164+ Modify e fs ->
165+ P.braces $
166+ P.hang
167+ (pretty e <+> P.text "|")
168+ 4
169+ (commaSep $ map field fs)
170+ where
171+ field (k,v) = variable k <+> P.text "<-" <+> pretty v
172+
173+ Record fs ->
174+ P.sep
175+ [ P.cat (zipWith (<+>) (P.lbrace : repeat P.comma) (map field fs))
176+ , P.rbrace
177+ ]
178+ where
179+ field (field, value) =
180+ variable field <+> P.equals <+> pretty value
181+
182+ Markdown _ _ -> P.text "[markdown| ... |]"
183+
184+ GLShader _ _ _ -> P.text "[glsl| ... |]"
185+
186+ PortIn name _ -> P.text $ "<port:" ++ name ++ ">"
187+
188+ PortOut _ _ signal -> pretty signal
92
189
93− Var x -> pretty x
94−
95− Range e1 e2 -> P.brackets (pretty e1 <> P.text ".." <> pretty e2)
96−
97− ExplicitList es -> P.brackets (commaCat (map pretty es))
98−
99− Binop op (Annotation.A _ (Literal (Literal.IntNum 0))) e
100− | Var.toString op == "-" ->
101− P.text "-" <> prettyParens e
102−
103− Binop op e1 e2 -> P.sep [ prettyParens e1 <+> P.text op'', prettyParens e2 ]
104− where
105− op' = Var.toString op
106− op'' = if Help.isOp op' then op' else "`" ++ op' ++ "`"
107−
108− Lambda p e -> P.text "\\" <> args <+> P.text "->" <+> pretty body
109− where
110− (ps,body) = collectLambdas (Annotation.A undefined $ Lambda p e)
111− args = P.sep (map Pattern.prettyParens ps)
112−
113− App _ _ -> P.hang func 2 (P.sep args)
114− where
115− func:args = map prettyParens (collectApps (Annotation.A undefined expr))
116−
117− MultiIf branches -> P.text "if" $$ nest 3 (vcat $ map iff branches)
118− where
119− iff (b,e) = P.text "|" <+> P.hang (pretty b <+> P.text "->") 2 (pretty e)
120−
121− Let defs e ->
122− P.sep [ P.hang (P.text "let") 4 (P.vcat (map pretty defs))
123− , P.text "in" <+> pretty e ]
124−
125− Case e pats ->
126− P.hang pexpr 2 (P.vcat (map pretty' pats))
127− where
128− pexpr = P.sep [ P.text "case" <+> pretty e, P.text "of" ]
129− pretty' (p,b) = pretty p <+> P.text "->" <+> pretty b
130−
131− Data "::" [hd,tl] -> pretty hd <+> P.text "::" <+> pretty tl
132− Data "[]" [] -> P.text "[]"
133− Data name es
134− | Help.isTuple name -> P.parens (commaCat (map pretty es))
135− | otherwise -> P.hang (P.text name) 2 (P.sep (map prettyParens es))
136−
137− Access e x -> prettyParens e <> P.text "." <> variable x
138−
139− Remove e x -> P.braces (pretty e <+> P.text "-" <+> variable x)
140−
141− Insert (Annotation.A _ (Remove e y)) x v ->
142− P.braces $ P.hsep [ pretty e, P.text "-", variable y, P.text "|"
143− , variable x, P.equals, pretty v ]
144−
145− Insert e x v ->
146− P.braces (pretty e <+> P.text "|" <+> variable x <+> P.equals <+> pretty v)
147−
148− Modify e fs ->
149− P.braces $ P.hang (pretty e <+> P.text "|")
150− 4
151− (commaSep $ map field fs)
152− where
153− field (k,v) = variable k <+> P.text "<-" <+> pretty v
154−
155− Record fs ->
156− P.braces $ P.nest 2 (commaSep $ map field fs)
157− where
158− field (x,e) = variable x <+> P.equals <+> pretty e
159−
160− Markdown _ _ -> P.text "[markdown| ... |]"
161−
162− GLShader _ _ _ -> P.text "[glsl| ... |]"
163−
164− PortIn name _ -> P.text $ "<port:" ++ name ++ ">"
165−
166− PortOut _ _ signal -> pretty signal
167
190
168collectApps :: Expr ann def var -> [Expr ann def var]
191collectApps :: Expr ann def var -> [Expr ann def var]
169collectApps annExpr@(Annotation.A _ expr) =
192collectApps annExpr@(Annotation.A _ expr) =
@@ -171,6 +194,7 @@ collectApps annExpr@(Annotation.A _ expr) =
171 App a b -> collectApps a ++ [b]
194 App a b -> collectApps a ++ [b]
172 _ -> [annExpr]
195 _ -> [annExpr]
173
196
197+
174collectLambdas :: Expr ann def var -> ([Pattern.Pattern var], Expr ann def var)
198collectLambdas :: Expr ann def var -> ([Pattern.Pattern var], Expr ann def var)
175collectLambdas lexpr@(Annotation.A _ expr) =
199collectLambdas lexpr@(Annotation.A _ expr) =
176 case expr of
200 case expr of
@@ -180,8 +204,10 @@ collectLambdas lexpr@(Annotation.A _ expr) =
180
204
181 _ -> ([], lexpr)
205 _ -> ([], lexpr)
182
206
207+
183prettyParens :: (Pretty def, Pretty var, Var.ToString var) => Expr ann def var -> Doc
208prettyParens :: (Pretty def, Pretty var, Var.ToString var) => Expr ann def var -> Doc
184−prettyParens (Annotation.A _ expr) = parensIf needed (pretty expr)
209+prettyParens (Annotation.A _ expr) =
210+ parensIf needed (pretty expr)
185 where
211 where
186 needed =
212 needed =
187 case expr of
213 case expr of
src/AST/Type.hs+17−6
@@ -61,13 +61,24 @@ instance (Var.ToString var, Pretty var) => Pretty (Type var) where
61 _ -> P.hang (pretty f) 2 (P.sep $ map prettyParens args)
61 _ -> P.hang (pretty f) 2 (P.sep $ map prettyParens args)
62
62
63 Record _ _ ->
63 Record _ _ ->
64− P.braces $ case flattenRecord tipe of
64+ case flattenRecord tipe of
65− (fields, Nothing) -> prettyFields fields
65+ (fields, Nothing) ->
66+ P.sep
67+ [ P.cat (zipWith (<+>) (P.lbrace : repeat P.comma) (map prettyField fields))
68+ , P.rbrace
69+ ]
70+
66− (fields, Just x) ->
71+ (fields, Just x) ->
72+ P.hang
67− P.hang (P.text x <+> P.text "|") 4 (prettyFields fields)
73+ (P.lbrace <+> P.text x <+> P.text "|")
74+ 4
75+ (P.sep
76+ [ P.cat (zipWith (<+>) (P.space : repeat P.comma) (map prettyField fields))
77+ , P.rbrace
78+ ])
68 where
79 where
80+ prettyField (field, tipe) =
69− prettyField (f,t) = P.text f <+> P.text ":" <+> pretty t
81+ P.text field <+> P.text ":" <+> pretty tipe
70− prettyFields fields = commaSep (map prettyField fields)
71
82
72 Aliased name t ->
83 Aliased name t ->
73 let t' = pretty t in
84 let t' = pretty t in