@@ -20,6 +20,7 @@ import Data.Functor.Identity (Identity(..))
2020import Data.List (transpose, nub, nubBy, sortBy, partition)
2121import Data.Maybe (maybeToList, fromMaybe, mapMaybe)
2222import Data.Ord (comparing)
23+import Data.String (fromString)
2324import qualified Data.Map as M
2425import qualified Data.Text as T
2526import Data.Text (Text)
@@ -31,8 +32,8 @@ import Language.PureScript.Environment
3132import Language.PureScript.Label (Label(..))
3233import Language.PureScript.Names
3334import Language.PureScript.Pretty
34−import Language.PureScript.Pretty.Common (before, endWith)
35−import Language.PureScript.PSString (decodeString)
35+import Language.PureScript.Pretty.Common (endWith)
36+import Language.PureScript.PSString (PSString, decodeStringEither)
3637import Language.PureScript.Traversals
3738import Language.PureScript.Types
3839import qualified Language.PureScript.Publish.BoxesHelpers as BoxHelpers
@@ -1265,12 +1266,15 @@ renderBox = unlines
12651266 whiteSpace = all isSpace
12661267
12671268toTypelevelString :: Type -> Maybe Box.Box
1268−toTypelevelString (TypeLevelString s) = (Box.text . T.unpack) <$> decodeString s
1269−toTypelevelString (TypeApp (TypeConstructor f) x)
1270− | f == primName "TypeString" = Just $ typeAsBox x
1271−toTypelevelString (TypeApp (TypeApp (TypeConstructor f) x) ret)
1272− | f == primName "TypeConcat" = before <$> (toTypelevelString x) <*> (toTypelevelString ret)
1273−toTypelevelString _ = Nothing
1269+toTypelevelString t = (Box.text . map (either (const '\xFFFD') id) . decodeStringEither) <$> toTypelevelString' t
1270+ where
1271+ toTypelevelString' :: Type -> Maybe PSString
1272+ toTypelevelString' (TypeLevelString s) = Just s
1273+ toTypelevelString' (TypeApp (TypeConstructor f) x)
1274+ | f == primName "TypeString" = Just $ fromString $ prettyPrintType x
1275+ toTypelevelString' (TypeApp (TypeApp (TypeConstructor f) x) ret)
1276+ | f == primName "TypeConcat" = toTypelevelString' x <> toTypelevelString' ret
1277+ toTypelevelString' _ = Nothing
12741278
12751279-- | Rethrow an error with a more detailed error message in the case of failure
12761280rethrow :: (MonadError e m) => (e -> e) -> m a -> m a