56613a8 · rowtype-yoga/purescript-native

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

on golang help sign in

Pretty-print suggested types differently (#2369)

56613a8Phil Freeman10 years ago

src/Language/PureScript/Errors.hs+13−13

compare with golang

unifiedsplit

@@ -287,19 +287,19 @@ wikiUri e = "https://github.com/purescript/purescript/wiki/Error-Code-" ++ error

287-- WildcardInferredType - source span not small enough

288-- DuplicateSelectiveImport - would require 2 ranges to remove and 1 insert

289errorSuggestion :: SimpleErrorMessage -> Maybe ErrorSuggestion

290−errorSuggestion err = case err of

290+errorSuggestion err =

291+ case err of

291− UnusedImport{} -> emptySuggestion

292+ UnusedImport{} -> emptySuggestion

292− DuplicateImport{} -> emptySuggestion

293+ DuplicateImport{} -> emptySuggestion

293− UnusedExplicitImport mn _ qual refs -> suggest $ importSuggestion mn refs qual

294+ UnusedExplicitImport mn _ qual refs -> suggest $ importSuggestion mn refs qual

294− UnusedDctorImport mn _ qual refs -> suggest $ importSuggestion mn refs qual

295+ UnusedDctorImport mn _ qual refs -> suggest $ importSuggestion mn refs qual

295− UnusedDctorExplicitImport mn _ _ qual refs -> suggest $ importSuggestion mn refs qual

296+ UnusedDctorExplicitImport mn _ _ qual refs -> suggest $ importSuggestion mn refs qual

296− ImplicitImport mn refs -> suggest $ importSuggestion mn refs Nothing

297+ ImplicitImport mn refs -> suggest $ importSuggestion mn refs Nothing

297− ImplicitQualifiedImport mn asModule refs -> suggest $ importSuggestion mn refs (Just asModule)

298+ ImplicitQualifiedImport mn asModule refs -> suggest $ importSuggestion mn refs (Just asModule)

298− HidingImport mn refs -> suggest $ importSuggestion mn refs Nothing

299+ HidingImport mn refs -> suggest $ importSuggestion mn refs Nothing

299− MissingTypeDeclaration ident ty -> suggest $ showIdent ident ++ " :: " ++ prettyPrintType ty

300+ MissingTypeDeclaration ident ty -> suggest $ showIdent ident ++ " :: " ++ prettyPrintSuggestedType ty

300− WildcardInferredType ty _ -> suggest $ prettyPrintType ty

301+ WildcardInferredType ty _ -> suggest $ prettyPrintSuggestedType ty

301− _ -> Nothing

302+ _ -> Nothing

302−

303 where

304 emptySuggestion = Just $ ErrorSuggestion ""

305 suggest = Just . ErrorSuggestion

src/Language/PureScript/Pretty/Types.hs+42−27

@@ -3,7 +3,9 @@

3--

4module Language.PureScript.Pretty.Types

5 ( typeAsBox

6+ , suggestedTypeAsBox

6 , prettyPrintType

7 , prettyPrintType

8+ , prettyPrintSuggestedType

7 , typeAtomAsBox

9 , typeAtomAsBox

8 , prettyPrintTypeAtom

10 , prettyPrintTypeAtom

9 , prettyPrintRowWith

11 , prettyPrintRowWith

@@ -27,23 +29,6 @@ import Language.PureScript.Types

28import Text.PrettyPrint.Boxes hiding ((<+>))

30import Text.PrettyPrint.Boxes hiding ((<+>))

30−typeLiterals :: Pattern () Type Box

31−typeLiterals = mkPattern match

32− where

33− match TypeWildcard{} = Just $ text "_"

34− match (TypeVar var) = Just $ text var

35− match (TypeLevelString s) = Just . text $ show s

36− match (PrettyPrintObject row) = Just $ prettyPrintRowWith '{' '}' row

37− match (TypeConstructor ctor) = Just $ text $ runProperName $ disqualify ctor

38− match (TUnknown u) = Just $ text $ 't' : show u

39− match (Skolem name s _ _) = Just $ text $ name ++ show s

40− match REmpty = Just $ text "()"

41− match row@RCons{} = Just $ prettyPrintRowWith '(' ')' row

42− match (BinaryNoParensType op l r) =

43− Just $ typeAsBox l <> text " " <> typeAsBox op <> text " " <> typeAsBox r

44− match (TypeOp op) = Just $ text $ showQualified runOpName op

45− match _ = Nothing

46−

47constraintsAsBox :: [Constraint] -> Box -> Box

32constraintsAsBox :: [Constraint] -> Box -> Box

48constraintsAsBox [con] ty = text "(" <> constraintAsBox con `before` (text ") => " <> ty)

33constraintsAsBox [con] ty = text "(" <> constraintAsBox con `before` (text ") => " <> ty)

49constraintsAsBox xs ty = vcat left (zipWith (\i con -> text (if i == 0 then "( " else ", ") <> constraintAsBox con) [0 :: Int ..] xs) `before` (text ") => " <> ty)

34constraintsAsBox xs ty = vcat left (zipWith (\i con -> text (if i == 0 then "( " else ", ") <> constraintAsBox con) [0 :: Int ..] xs) `before` (text ") => " <> ty)

@@ -120,12 +105,32 @@ explicitParens = mkPattern match

120 match (ParensInType ty) = Just ((), ty)

105 match (ParensInType ty) = Just ((), ty)

121 match _ = Nothing

106 match _ = Nothing

122

107

123−matchTypeAtom :: Pattern () Type Box

108+matchTypeAtom :: Bool -> Pattern () Type Box

109+matchTypeAtom suggesting =

124−matchTypeAtom = typeLiterals <+> fmap ((`before` (text ")")) . (text "(" <>)) matchType

110+ typeLiterals <+> fmap ((`before` (text ")")) . (text "(" <>)) (matchType suggesting)

125−

126−matchType :: Pattern () Type Box

127−matchType = buildPrettyPrinter operators matchTypeAtom

128 where

111 where

112+ typeLiterals :: Pattern () Type Box

113+ typeLiterals = mkPattern match where

114+ match TypeWildcard{} = Just $ text "_"

115+ match (TypeVar var) = Just $ text var

116+ match (TypeLevelString s) = Just . text $ show s

117+ match (PrettyPrintObject row) = Just $ prettyPrintRowWith '{' '}' row

118+ match (TypeConstructor ctor) = Just $ text $ runProperName $ disqualify ctor

119+ match (TUnknown u)

120+ | suggesting = Just $ text "_"

121+ | otherwise = Just $ text $ 't' : show u

122+ match (Skolem name s _ _)

123+ | suggesting = Just $ text name

124+ | otherwise = Just $ text $ name ++ show s

125+ match REmpty = Just $ text "()"

126+ match row@RCons{} = Just $ prettyPrintRowWith '(' ')' row

127+ match (BinaryNoParensType op l r) =

128+ Just $ typeAsBox l <> text " " <> typeAsBox op <> text " " <> typeAsBox r

129+ match (TypeOp op) = Just $ text $ showQualified runOpName op

130+ match _ = Nothing

131+

132+matchType :: Bool -> Pattern () Type Box

133+matchType = buildPrettyPrinter operators . matchTypeAtom where

129 operators :: OperatorTable () Type Box

134 operators :: OperatorTable () Type Box

130 operators =

135 operators =

131 OperatorTable [ [ AssocL typeApp $ \f x -> keepSingleLinesOr (moveRight 2) f x ]

136 OperatorTable [ [ AssocL typeApp $ \f x -> keepSingleLinesOr (moveRight 2) f x ]

@@ -152,7 +157,7 @@ forall_ = mkPattern match

152typeAtomAsBox :: Type -> Box

157typeAtomAsBox :: Type -> Box

153typeAtomAsBox

158typeAtomAsBox

154 = fromMaybe (internalError "Incomplete pattern")

159 = fromMaybe (internalError "Incomplete pattern")

155− . PA.pattern matchTypeAtom ()

160+ . PA.pattern (matchTypeAtom False) ()

156 . insertPlaceholders

161 . insertPlaceholders

157

162

158-- | Generate a pretty-printed string representing a Type, as it should appear inside parentheses

163-- | Generate a pretty-printed string representing a Type, as it should appear inside parentheses

@@ -160,11 +165,21 @@ prettyPrintTypeAtom :: Type -> String

160prettyPrintTypeAtom = render . typeAtomAsBox

165prettyPrintTypeAtom = render . typeAtomAsBox

161

166

162typeAsBox :: Type -> Box

167typeAsBox :: Type -> Box

163−typeAsBox

168+typeAsBox = typeAsBoxImpl False

169+

170+suggestedTypeAsBox :: Type -> Box

171+suggestedTypeAsBox = typeAsBoxImpl True

172+

173+typeAsBoxImpl :: Bool -> Type -> Box

174+typeAsBoxImpl suggesting

164 = fromMaybe (internalError "Incomplete pattern")

175 = fromMaybe (internalError "Incomplete pattern")

165− . PA.pattern matchType ()

176+ . PA.pattern (matchType suggesting) ()

166 . insertPlaceholders

177 . insertPlaceholders

167

178

168−-- | Generate a pretty-printed string representing a Type

179+-- | Generate a pretty-printed string representing a 'Type'

169prettyPrintType :: Type -> String

180prettyPrintType :: Type -> String

170−prettyPrintType = render . typeAsBox

181+prettyPrintType = render . typeAsBoxImpl False

182+

183+-- | Generate a pretty-printed string representing a suggested 'Type'

184+prettyPrintSuggestedType :: Type -> String

185+prettyPrintSuggestedType = render . typeAsBoxImpl True