git.iko.soy/elk
on master help sign in
Make print out of doc Types prettier
12af230Evan Czaplicki
src/Elm/Compiler/Type.hs+62−42
compare with master
unifiedsplit
@@ -9,11 +9,10 @@ import Control.Arrow (second)
9import Data.Aeson ((.:), (.=))
9import Data.Aeson ((.:), (.=))
10import qualified Data.Aeson as Json
10import qualified Data.Aeson as Json
11import qualified Data.ByteString.Lazy.Char8 as BS
11import qualified Data.ByteString.Lazy.Char8 as BS
12−import qualified Data.List as List
13import qualified Data.Text as Text
12import qualified Data.Text as Text
13+import Text.PrettyPrint as P
14
14
15import qualified AST.Helpers as Help
15import qualified AST.Helpers as Help
16−import Elm.Utils ((|>))
17
16
18
17
19data Type
18data Type
@@ -31,66 +30,87 @@ data Context = None | ADT | Function
31
30
32toString :: Type -> String
31toString :: Type -> String
33toString tipe =
32toString tipe =
34− toStringHelp None tipe
33+ P.render (toDoc None tipe)
35
34
36
35
37−toStringHelp :: Context -> Type -> String
36+toDoc :: Context -> Type -> P.Doc
38−toStringHelp context tipe =
37+toDoc context tipe =
39 case tipe of
38 case tipe of
40− Lambda t1 t2 ->
39+ Lambda _ _ ->
41− let string = toStringHelp Function t1 ++ " -> " ++ toString t2
40+ let t:ts =
41+ map (toDoc Function) (collectLambdas tipe)
42+
43+ lambda =
44+ P.sep [ t, P.sep (map (P.text "->" <+>) ts) ]
42 in
45 in
43 case context of
46 case context of
44− None -> string
47+ None -> lambda
45− _ -> parens string
48+ _ -> P.parens lambda
46
49
47− Var name -> name
50+ Var name ->
51+ P.text name
48
52
49− Type name -> name
53+ Type name ->
54+ P.text (if name == "_Tuple0" then "()" else name)
50
55
51 App (Type name) args
56 App (Type name) args
52 | Help.isTuple name ->
57 | Help.isTuple name ->
53− map toString args
58+ P.sep
54− |> List.intercalate ", "
59+ [ P.cat (zipWith (<+>) (P.lparen : repeat P.comma) (map (toDoc None) args))
55− |> parens
60+ , P.rparen
61+ ]
56
62
57 | otherwise ->
63 | otherwise ->
58− let string = name ++ spacePrefix (map (toStringHelp ADT) args)
64+ let adt = P.hang (P.text name) 2 (P.sep $ map (toDoc ADT) args)
59 in
65 in
60 case (context, args) of
66 case (context, args) of
61− (ADT, _ : _) -> parens string
67+ (ADT, _ : _) -> P.parens adt
62− _ -> string
68+ _ -> adt
63−
69+
64− Record fields maybeExtension ->
70+ Record _ _ ->
65− let viewField (key, value) =
71+ case flattenRecord tipe of
66− key ++ " : " ++ toString value
67−
68− viewExtension maybeType =
69− case maybeType of
70− Nothing -> ""
72+ ([], Nothing) ->
71− Just t -> toString t ++ " | "
73+ P.text "{}"
72− in
74+
73− sandwich "{ " " }" $
75+ (fields, Nothing) ->
74− concat
76+ P.sep
75− [ viewExtension maybeExtension
77+ [ P.cat (zipWith (<+>) (P.lbrace : repeat P.comma) (map prettyField fields))
76− , map viewField fields
78+ , P.rbrace
77− |> List.intercalate ", "
78− ]
79+ ]
79
80
81+ (fields, Just x) ->
82+ P.hang
83+ (P.lbrace <+> P.text x <+> P.text "|")
84+ 4
85+ (P.sep
86+ [ P.cat (zipWith (<+>) (P.space : repeat P.comma) (map prettyField fields))
87+ , P.rbrace
88+ ])
89+ where
90+ prettyField (field, tipe) =
91+ P.text field <+> P.text ":" <+> toDoc None tipe
92+
93+
94+collectLambdas :: Type -> [Type]
95+collectLambdas tipe =
96+ case tipe of
97+ Lambda arg body -> arg : collectLambdas body
98+ _ -> [tipe]
80
99
81−parens :: String -> String
82−parens string =
83− sandwich "(" ")" string
84
100
101+flattenRecord :: Type -> ( [(String, Type)], Maybe String )
102+flattenRecord tipe =
103+ case tipe of
104+ Var x -> ([], Just x)
85
105
86−spacePrefix :: [String] -> String
106+ Record fields Nothing -> (fields, Nothing)
87−spacePrefix strings =
88− concatMap (" " ++) strings
89
107
108+ Record fields (Just ext) ->
109+ let (fields',ext') = flattenRecord ext
110+ in
111+ (fields' ++ fields, ext')
90
112
91−sandwich :: String -> String -> String -> String
113+ _ -> error "Trying to flatten ill-formed record."
92−sandwich start stop string =
93− start ++ string ++ stop
94
114
95
115
96-- JSON for TYPE
116-- JSON for TYPE