c7f8746 · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

Pretty printer for let expressions. Only show first and last errors when not using -v

commitc7f8746b9f45978ef42f8432bd72a84a550e4db5 authorPhil Freeman <paf31@cantab.net> dateFri 28 Mar 2014, 18:12 (13 years ago) parentabde79f

2 files changed+21−32

compare with golang

unifiedsplit

src/Language/PureScript/Pretty/Values.hs+18−11 src/Language/PureScript/TypeChecker/Monad.hs+3−21

src/Language/PureScript/Pretty/Values.hs+18−11

@@ -26,10 +26,9 @@ import Control.PatternArrows

2626import Control.Monad.State

2727import Control.Applicative

2828

29−import Language.PureScript.Types

3029import Language.PureScript.Declarations

3130import Language.PureScript.Pretty.Common

32−import Language.PureScript.Pretty.Types

31+import Language.PureScript.Pretty.Types (prettyPrintType)

3332

3433literals :: Pattern PrinterState Value String

3534literals = mkPattern' match

@@ -44,6 +43,7 @@ literals = mkPattern' match

4443 , withIndent $ prettyPrintMany prettyPrintValue' xs

4544 , return " ]"

4645 ]

46+ match (ObjectLiteral []) = return "{}"

4747 match (ObjectLiteral ps) = fmap concat $ sequence

4848 [ return "{\n"

4949 , withIndent $ prettyPrintMany prettyPrintObjectProperty ps

@@ -58,8 +58,12 @@ literals = mkPattern' match

5858 , withIndent $ prettyPrintMany prettyPrintCaseAlternative binders

5959 , currentIndent

6060 ]

61− match (Let _ val) = fmap concat $ sequence

62− [ return "let ... in " -- TODO

61+ match (Let ds val) = fmap concat $ sequence

62+ [ return "let\n"

63+ , withIndent $ prettyPrintMany prettyPrintDeclaration ds

64+ , return "\n"

65+ , currentIndent

66+ , return "in "

6367 , prettyPrintValue' val

6468 ]

6569 match (Var ident) = return $ show ident

@@ -69,9 +73,19 @@ literals = mkPattern' match

6973 , currentIndent

7074 ]

7175 match (TypeClassDictionary _ _) = error "Type class dictionary was not replaced"

76+ match (TypedValue _ val _) = prettyPrintValue' val

7277 match (PositionedValue _ val) = prettyPrintValue' val

7378 match _ = mzero

7479

80+prettyPrintDeclaration :: Declaration -> StateT PrinterState Maybe String

81+prettyPrintDeclaration (TypeDeclaration ident ty) = return $ show ident ++ " :: " ++ prettyPrintType ty

82+prettyPrintDeclaration (ValueDeclaration ident _ [] Nothing val) = fmap concat $ sequence

83+ [ return $ show ident ++ " = "

84+ , prettyPrintValue' val

85+ ]

86+prettyPrintDeclaration (PositionedDeclaration _ d) = prettyPrintDeclaration d

87+prettyPrintDeclaration _ = error "Invalid argument to prettyPrintDeclaration"

88+

7589prettyPrintCaseAlternative :: CaseAlternative -> StateT PrinterState Maybe String

7690prettyPrintCaseAlternative (CaseAlternative binders grd val) =

7791 fmap concat $ sequence

@@ -129,12 +143,6 @@ lam = mkPattern match

129143 match (Abs (Left arg) val) = Just (show arg, val)

130144 match _ = Nothing

131145

132−typed :: Pattern PrinterState Value (Type, Value)

133−typed = mkPattern match

134− where

135− match (TypedValue _ val ty) = Just (ty, val)

136− match _ = Nothing

137−

138146-- |

139147-- Generate a pretty-printed string representing an expression

140148--

@@ -153,7 +161,6 @@ prettyPrintValue' = runKleisli $ runPattern matchValue

153161 , [ Wrap app $ \arg val -> val ++ "(" ++ arg ++ ")" ]

154162 , [ Split lam $ \arg val -> "\\" ++ arg ++ " -> " ++ prettyPrintValue val ]

155163 , [ Wrap ifThenElse $ \(th, el) cond -> "if " ++ cond ++ " then " ++ prettyPrintValue th ++ " else " ++ prettyPrintValue el ]

156− , [ Wrap typed $ \ty val -> val ++ " :: " ++ prettyPrintType ty ]

157164 ]

158165

159166prettyPrintBinderAtom :: Pattern PrinterState Binder String

src/Language/PureScript/TypeChecker/Monad.hs+3−21

@@ -91,27 +91,9 @@ prettyPrintUnifyErrorStack opts (UnifyErrorStack es) =

9191 | otherwise =

9292 let

9393 es' = filter isErrorNonEmpty es

94− errorsWithValues = filter (isJust . unifyErrorValue) es'

95− mostSpecificError = last es'

96− in case (length errorsWithValues, isJust (unifyErrorValue mostSpecificError)) of

97− (0, _) -> showError mostSpecificError

98− (1, True) -> showError mostSpecificError

99− (1, False) ->

100− let errorWithValue = head errorsWithValues

101− in showError errorWithValue ++ "\n" ++

102− showError mostSpecificError

103− (_, True) ->

104− let errorWithValue = head errorsWithValues

105− in showError errorWithValue ++ "\n" ++

106− showError mostSpecificError

107− (_, False) ->

108− let

109− leastSpecificErrorWithValue = head errorsWithValues

110− mostSpecificErrorWithValue = last errorsWithValues

111− in

112− showError leastSpecificErrorWithValue ++ "\n" ++

113− showError mostSpecificErrorWithValue ++ "\n" ++

114− showError mostSpecificError

94+ in case length es' of

95+ 1 -> showError (head es')

96+ _ -> showError (head es') ++ "\n" ++ showError (last es')

11597

11698isErrorNonEmpty :: UnifyError -> Bool

11799isErrorNonEmpty = not . null . unifyErrorMessage