git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Merge pull request #1908 from purescript/1905-fix-pretty-spin

Fix pretty printer spinning

commitf698f2bf6dca06eedf2fa05737870e2988f1bdee authorGary Burgess <gary.burgess@gmail.com> dateMon 29 Feb 2016, 17:09 (11 years ago) parente5f034d6aef07d
1 file changed+30−2
src/Language/PureScript/Pretty/Values.hs+30−2
src/Language/PureScript/Pretty/Values.hs+30−2
@@ -57,6 +57,7 @@ prettyPrintValue d (Accessor prop val) = prettyPrintValueAtom (d - 1) val <> tex
5757prettyPrintValue d (ObjectUpdate o ps) = prettyPrintValueAtom (d - 1) o <> text " " <> list '{' '}' (\(key, val) -> text (key ++ " = ") <> prettyPrintValue (d - 1) val) ps
5858prettyPrintValue d (App val arg) = prettyPrintValueAtom (d - 1) val `beforeWithSpace` prettyPrintValueAtom (d - 1) arg
5959prettyPrintValue d (Abs (Left arg) val) = text ('\\' : showIdent arg ++ " -> ") // moveRight 2 (prettyPrintValue (d - 1) val)
60+prettyPrintValue d (Abs (Right arg) val) = text ('\\' : prettyPrintBinder arg ++ " -> ") // moveRight 2 (prettyPrintValue (d - 1) val)
6061prettyPrintValue d (TypeClassDictionaryConstructorApp className ps) =
6162 text (runProperName (disqualify className) ++ " ") <> prettyPrintValueAtom (d - 1) ps
6263prettyPrintValue d (Case values binders) =
@@ -70,9 +71,24 @@ prettyPrintValue d (Do els) =
7071 text "do " <> vcat left (map (prettyPrintDoNotationElement (d - 1)) els)
7172prettyPrintValue _ (TypeClassDictionary (name, tys) _) = foldl1 beforeWithSpace $ text ("#dict " ++ runProperName (disqualify name)) : map typeAtomAsBox tys
7273prettyPrintValue _ (SuperClassDictionary name _) = text $ "#dict " ++ runProperName (disqualify name)
74+prettyPrintValue _ (TypeClassDictionaryAccessor className ident) =
75+ text "#dict-accessor " <> text (runProperName (disqualify className)) <> text "." <> text (showIdent ident) <> text ">"
7376prettyPrintValue d (TypedValue _ val _) = prettyPrintValue d val
7477prettyPrintValue d (PositionedValue _ _ val) = prettyPrintValue d val
75−prettyPrintValue d expr = prettyPrintValueAtom d expr
78+prettyPrintValue d expr@NumericLiteral{} = prettyPrintValueAtom d expr
79+prettyPrintValue d expr@StringLiteral{} = prettyPrintValueAtom d expr
80+prettyPrintValue d expr@CharLiteral{} = prettyPrintValueAtom d expr
81+prettyPrintValue d expr@BooleanLiteral{} = prettyPrintValueAtom d expr
82+prettyPrintValue d expr@ArrayLiteral{} = prettyPrintValueAtom d expr
83+prettyPrintValue d expr@ObjectLiteral{} = prettyPrintValueAtom d expr
84+prettyPrintValue d expr@AnonymousArgument{} = prettyPrintValueAtom d expr
85+prettyPrintValue d expr@Constructor{} = prettyPrintValueAtom d expr
86+prettyPrintValue d expr@Var{} = prettyPrintValueAtom d expr
87+prettyPrintValue d expr@OperatorSection{} = prettyPrintValueAtom d expr
88+prettyPrintValue d expr@BinaryNoParens{} = prettyPrintValueAtom d expr
89+prettyPrintValue d expr@Parens{} = prettyPrintValueAtom d expr
90+prettyPrintValue d expr@UnaryMinus{} = prettyPrintValueAtom d expr
91+prettyPrintValue d expr@ObjectGetter{} = prettyPrintValueAtom d expr
7692
7793-- | Pretty-print an atomic expression, adding parentheses if necessary.
7894prettyPrintValueAtom :: Int -> Expr -> Box
@@ -88,8 +104,16 @@ prettyPrintValueAtom _ (Constructor name) = text $ runProperName (disqualify nam
88104prettyPrintValueAtom _ (Var ident) = text $ showIdent (disqualify ident)
89105prettyPrintValueAtom d (OperatorSection op (Right val)) = ((text "(" <> prettyPrintValue (d - 1) op) `beforeWithSpace` prettyPrintValue (d - 1) val) `before` text ")"
90106prettyPrintValueAtom d (OperatorSection op (Left val)) = ((text "(" <> prettyPrintValue (d - 1) val) `beforeWithSpace` prettyPrintValue (d - 1) op) `before` text ")"
107+prettyPrintValueAtom d (BinaryNoParens op lhs rhs) =
108+ prettyPrintValue (d - 1) lhs `beforeWithSpace` printOp op `beforeWithSpace` prettyPrintValue (d - 1) rhs
109+ where
110+ printOp (Var (Qualified _ (Op opName))) = text opName
111+ printOp expr = text "`" <> prettyPrintValue (d - 1) expr <> text "`"
91112prettyPrintValueAtom d (TypedValue _ val _) = prettyPrintValueAtom d val
92113prettyPrintValueAtom d (PositionedValue _ _ val) = prettyPrintValueAtom d val
114+prettyPrintValueAtom d (Parens expr) = (text "(" <> prettyPrintValue d expr) `before` text ")"
115+prettyPrintValueAtom d (UnaryMinus expr) = text "(-" <> prettyPrintValue d expr <> text ")"
116+prettyPrintValueAtom _ (ObjectGetter field) = text "_." <> text field
93117prettyPrintValueAtom d expr = (text "(" <> prettyPrintValue d expr) `before` text ")"
94118
95119prettyPrintDeclaration :: Int -> Declaration -> Box
@@ -143,6 +167,7 @@ prettyPrintBinderAtom (BooleanBinder True) = "true"
143167prettyPrintBinderAtom (BooleanBinder False) = "false"
144168prettyPrintBinderAtom (VarBinder ident) = showIdent ident
145169prettyPrintBinderAtom (ConstructorBinder ctor []) = runProperName (disqualify ctor)
170+prettyPrintBinderAtom b@ConstructorBinder{} = parens (prettyPrintBinder b)
146171prettyPrintBinderAtom (ObjectBinder bs) =
147172 "{ "
148173 ++ intercalate ", " (map prettyPrintObjectPropertyBinder bs)
@@ -157,7 +182,10 @@ prettyPrintBinderAtom (ArrayBinder bs) =
157182prettyPrintBinderAtom (NamedBinder ident binder) = showIdent ident ++ "@" ++ prettyPrintBinder binder
158183prettyPrintBinderAtom (PositionedBinder _ _ binder) = prettyPrintBinderAtom binder
159184prettyPrintBinderAtom (TypedBinder _ binder) = prettyPrintBinderAtom binder
160−prettyPrintBinderAtom b = parens (prettyPrintBinder b)
185+prettyPrintBinderAtom (OpBinder op) = showIdent (disqualify op)
186+prettyPrintBinderAtom (BinaryNoParensBinder op b1 b2) =
187+ prettyPrintBinderAtom b1 ++ " " ++ prettyPrintBinderAtom op ++ " " ++ prettyPrintBinderAtom b2
188+prettyPrintBinderAtom (ParensInBinder b) = parens (prettyPrintBinder b)
161189
162190-- |
163191-- Generate a pretty-printed string representing a Binder