git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
UTF-16 surrogate pair and lone surrogate support in type level strings
3941bd1Michael Ficarra
src/Language/PureScript/Errors.hs+12−8
@@ -20,6 +20,7 @@ import Data.Functor.Identity (Identity(..))
20import Data.List (transpose, nub, nubBy, sortBy, partition)
20import Data.List (transpose, nub, nubBy, sortBy, partition)
21import Data.Maybe (maybeToList, fromMaybe, mapMaybe)
21import Data.Maybe (maybeToList, fromMaybe, mapMaybe)
22import Data.Ord (comparing)
22import Data.Ord (comparing)
23+import Data.String (fromString)
23import qualified Data.Map as M
24import qualified Data.Map as M
24import qualified Data.Text as T
25import qualified Data.Text as T
25import Data.Text (Text)
26import Data.Text (Text)
@@ -31,8 +32,8 @@ import Language.PureScript.Environment
31import Language.PureScript.Label (Label(..))
32import Language.PureScript.Label (Label(..))
32import Language.PureScript.Names
33import Language.PureScript.Names
33import Language.PureScript.Pretty
34import Language.PureScript.Pretty
34−import Language.PureScript.Pretty.Common (before, endWith)
35+import Language.PureScript.Pretty.Common (endWith)
35−import Language.PureScript.PSString (decodeString)
36+import Language.PureScript.PSString (PSString, decodeStringEither)
36import Language.PureScript.Traversals
37import Language.PureScript.Traversals
37import Language.PureScript.Types
38import Language.PureScript.Types
38import qualified Language.PureScript.Publish.BoxesHelpers as BoxHelpers
39import qualified Language.PureScript.Publish.BoxesHelpers as BoxHelpers
@@ -1265,12 +1266,15 @@ renderBox = unlines
1265 whiteSpace = all isSpace
1266 whiteSpace = all isSpace
1266
1267
1267toTypelevelString :: Type -> Maybe Box.Box
1268toTypelevelString :: Type -> Maybe Box.Box
1268−toTypelevelString (TypeLevelString s) = (Box.text . T.unpack) <$> decodeString s
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
1269−toTypelevelString (TypeApp (TypeConstructor f) x)
1273+ toTypelevelString' (TypeApp (TypeConstructor f) x)
1270− | f == primName "TypeString" = Just $ typeAsBox x
1274+ | f == primName "TypeString" = Just $ fromString $ prettyPrintType x
1271−toTypelevelString (TypeApp (TypeApp (TypeConstructor f) x) ret)
1275+ toTypelevelString' (TypeApp (TypeApp (TypeConstructor f) x) ret)
1272− | f == primName "TypeConcat" = before <$> (toTypelevelString x) <*> (toTypelevelString ret)
1276+ | f == primName "TypeConcat" = toTypelevelString' x <> toTypelevelString' ret
1273−toTypelevelString _ = Nothing
1277+ toTypelevelString' _ = Nothing
1274
1278
1275-- | Rethrow an error with a more detailed error message in the case of failure
1279-- | Rethrow an error with a more detailed error message in the case of failure
1276rethrow :: (MonadError e m) => (e -> e) -> m a -> m a
1280rethrow :: (MonadError e m) => (e -> e) -> m a -> m a