@@ -10,6 +10,7 @@ import Prelude.Compat
1010import Control.Arrow (ArrowPlus(..))
1111import Control.PatternArrows as PA
1212
13+import Data.Monoid ((<>))
1314import Data.Maybe (fromMaybe)
1415import qualified Data.Text as T
1516import Data.Text (Text)
@@ -19,11 +20,15 @@ import Language.PureScript.Kinds
1920import Language.PureScript.Names
2021import Language.PureScript.Pretty.Common
2122
22−typeLiterals :: Pattern () Kind String
23+typeLiterals :: Pattern () Kind Text
2324typeLiterals = mkPattern match
2425 where
25− match (KUnknown u) = Just $ 'u' : show u
26− match (NamedKind name) = Just $ T.unpack (showQualified runProperName name)
26+ match (KUnknown u) =
27+ Just $ T.cons 'k' (T.pack (show u))
28+ match (NamedKind name) =
29+ Just $ if isQualifiedWith (moduleNameFromString "Prim") name
30+ then runProperName (disqualify name)
31+ else showQualified runProperName name
2732 match _ = Nothing
2833
2934matchRow :: Pattern () Kind ((), Kind)
@@ -41,15 +46,13 @@ funKind = mkPattern match
4146-- | Generate a pretty-printed string representing a Kind
4247prettyPrintKind :: Kind -> Text
4348prettyPrintKind
44− -- TODO(Christoph): get rid of T.pack
45− = T.pack
46− . fromMaybe (internalError "Incomplete pattern")
49+ = fromMaybe (internalError "Incomplete pattern")
4750 . PA.pattern matchKind ()
4851 where
49− matchKind :: Pattern () Kind String
50− matchKind = buildPrettyPrinter operators (typeLiterals <+> fmap parens matchKind)
52+ matchKind :: Pattern () Kind Text
53+ matchKind = buildPrettyPrinter operators (typeLiterals <+> fmap parensT matchKind)
5154
52− operators :: OperatorTable () Kind String
55+ operators :: OperatorTable () Kind Text
5356 operators =
54− OperatorTable [ [ Wrap matchRow $ \_ k -> "# " ++ k]
55− , [ AssocR funKind $ \arg ret -> arg ++ " -> " ++ ret ] ]
57+ OperatorTable [ [ Wrap matchRow $ \_ k -> "# " <> k]
58+ , [ AssocR funKind $ \arg ret -> arg <> " -> " <> ret ] ]