on master help sign in
Make nested record types prettier.
a7b0d3fEvan Czaplicki
compiler/SourceSyntax/Type.hs+11−1
@@ -41,8 +41,11 @@ instance Pretty Type where
41 | Help.isTuple name -> P.parens . P.sep . P.punctuate P.comma $ map pretty tipes
41 | Help.isTuple name -> P.parens . P.sep . P.punctuate P.comma $ map pretty tipes
42 | otherwise -> P.hang (P.text name) 2 (P.sep $ map prettyParens tipes)
42 | otherwise -> P.hang (P.text name) 2 (P.sep $ map prettyParens tipes)
43 EmptyRecord -> P.braces P.empty
43 EmptyRecord -> P.braces P.empty
44+ Record _ _ -> P.braces $ case ext of
45+ EmptyRecord -> prettyFields
44− Record fields ext -> P.braces $ P.hang (pretty ext <+> P.text "|") 4 prettyFields
46+ _ -> P.hang (pretty ext <+> P.text "|") 4 prettyFields
45 where
47 where
48+ (fields, ext) = collectRecords tipe
46 prettyField (f,t) = P.text f <+> P.text ":" <+> pretty t
49 prettyField (f,t) = P.text f <+> P.text ":" <+> pretty t
47 prettyFields = commaSep . map prettyField $ fields
50 prettyFields = commaSep . map prettyField $ fields
48
51
@@ -52,6 +55,13 @@ collectLambdas tipe =
52 Lambda arg body -> pretty arg : collectLambdas body
55 Lambda arg body -> pretty arg : collectLambdas body
53 _ -> [pretty tipe]
56 _ -> [pretty tipe]
54
57
58+collectRecords = go []
59+ where
60+ go fields tipe =
61+ case tipe of
62+ Record fs ext -> go (fs ++ fields) ext
63+ _ -> (fields, tipe)
64+
55prettyParens tipe = parensIf needed (pretty tipe)
65prettyParens tipe = parensIf needed (pretty tipe)
56 where
66 where
57 needed =
67 needed =
compiler/Type/State.hs+2−1
@@ -49,7 +49,8 @@ modifyPool f = modify $ \state -> state { sPool = f (sPool state) }
49addError span message t1 t2 =
49addError span message t1 t2 =
50 modify $ \state -> state { sErrors = err : sErrors state }
50 modify $ \state -> state { sErrors = err : sErrors state }
51 where
51 where
52+ prty t = pretty `fmap` toSrcType t
52− err = makeError <$> extraPretty t1 <*> extraPretty t2
53+ err = makeError <$> prty t1 <*> prty t2
53
54
54 location = case span of
55 location = case span of
55 NoSpan msg -> ""
56 NoSpan msg -> ""