@@ -3,7 +3,9 @@
33--
44module Language.PureScript.Pretty.Types
55 ( typeAsBox
6+ , suggestedTypeAsBox
67 , prettyPrintType
8+ , prettyPrintSuggestedType
79 , typeAtomAsBox
810 , prettyPrintTypeAtom
911 , prettyPrintRowWith
@@ -27,23 +29,6 @@ import Language.PureScript.Types
2729
2830import Text.PrettyPrint.Boxes hiding ((<+>))
2931
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−
4732constraintsAsBox :: [Constraint] -> Box -> Box
4833constraintsAsBox [con] ty = text "(" <> constraintAsBox con `before` (text ") => " <> ty)
4934constraintsAsBox 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
120105 match (ParensInType ty) = Just ((), ty)
121106 match _ = Nothing
122107
123−matchTypeAtom :: Pattern () Type Box
124−matchTypeAtom = typeLiterals <+> fmap ((`before` (text ")")) . (text "(" <>)) matchType
125−
126−matchType :: Pattern () Type Box
127−matchType = buildPrettyPrinter operators matchTypeAtom
108+matchTypeAtom :: Bool -> Pattern () Type Box
109+matchTypeAtom suggesting =
110+ typeLiterals <+> fmap ((`before` (text ")")) . (text "(" <>)) (matchType suggesting)
128111 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
129134 operators :: OperatorTable () Type Box
130135 operators =
131136 OperatorTable [ [ AssocL typeApp $ \f x -> keepSingleLinesOr (moveRight 2) f x ]
@@ -152,7 +157,7 @@ forall_ = mkPattern match
152157typeAtomAsBox :: Type -> Box
153158typeAtomAsBox
154159 = fromMaybe (internalError "Incomplete pattern")
155− . PA.pattern matchTypeAtom ()
160+ . PA.pattern (matchTypeAtom False) ()
156161 . insertPlaceholders
157162
158163-- | Generate a pretty-printed string representing a Type, as it should appear inside parentheses
@@ -160,11 +165,21 @@ prettyPrintTypeAtom :: Type -> String
160165prettyPrintTypeAtom = render . typeAtomAsBox
161166
162167typeAsBox :: 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
164175 = fromMaybe (internalError "Incomplete pattern")
165− . PA.pattern matchType ()
176+ . PA.pattern (matchType suggesting) ()
166177 . insertPlaceholders
167178
168−-- | Generate a pretty-printed string representing a Type
179+-- | Generate a pretty-printed string representing a 'Type'
169180prettyPrintType :: 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