bfb255d · rowtype-yoga/purescript-native

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

on golang help sign in

Merge pull request #2586 from michaelficarra/GH-2568

bfb255dHarry Garrood10 years ago

src/Language/PureScript/Errors.hs+12−7

compare with golang

unifiedsplit

@@ -20,6 +20,7 @@ import Data.Functor.Identity (Identity(..))

20import Data.List (transpose, nub, nubBy, sortBy, partition)

21import Data.Maybe (maybeToList, fromMaybe, mapMaybe)

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,7 +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)

36+import Language.PureScript.PSString (PSString, decodeStringWithReplacement)

35import Language.PureScript.Traversals

37import Language.PureScript.Traversals

36import Language.PureScript.Types

38import Language.PureScript.Types

37import qualified Language.PureScript.Publish.BoxesHelpers as BoxHelpers

39import qualified Language.PureScript.Publish.BoxesHelpers as BoxHelpers

@@ -1264,12 +1266,15 @@ renderBox = unlines

1264 whiteSpace = all isSpace

1266 whiteSpace = all isSpace

1265

1267

1266toTypelevelString :: Type -> Maybe Box.Box

1268toTypelevelString :: Type -> Maybe Box.Box

1267−toTypelevelString (TypeLevelString s) = Just $ Box.text $ T.unpack $ prettyPrintString s

1269+toTypelevelString t = (Box.text . decodeStringWithReplacement) <$> toTypelevelString' t

1270+ where

1271+ toTypelevelString' :: Type -> Maybe PSString

1272+ toTypelevelString' (TypeLevelString s) = Just s

1268−toTypelevelString (TypeApp (TypeConstructor f) x)

1273+ toTypelevelString' (TypeApp (TypeConstructor f) x)

1269− | f == primName "TypeString" = Just $ typeAsBox x

1274+ | f == primName "TypeString" = Just $ fromString $ prettyPrintType x

1270−toTypelevelString (TypeApp (TypeApp (TypeConstructor f) x) ret)

1275+ toTypelevelString' (TypeApp (TypeApp (TypeConstructor f) x) ret)

1271− | f == primName "TypeConcat" = before <$> (toTypelevelString x) <*> (toTypelevelString ret)

1276+ | f == primName "TypeConcat" = toTypelevelString' x <> toTypelevelString' ret

1272−toTypelevelString _ = Nothing

1277+ toTypelevelString' _ = Nothing

1273

1278

1274-- | 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

1275rethrow :: (MonadError e m) => (e -> e) -> m a -> m a

1280rethrow :: (MonadError e m) => (e -> e) -> m a -> m a

src/Language/PureScript/PSString.hs+10

@@ -5,6 +5,7 @@ module Language.PureScript.PSString

5 , toUTF16CodeUnits

6 , decodeString

7 , decodeStringEither

8+ , decodeStringWithReplacement

8 , prettyPrintString

9 , prettyPrintString

9 , prettyPrintStringJS

10 , prettyPrintStringJS

10 , mkString

11 , mkString

@@ -52,15 +53,24 @@ newtype PSString = PSString { toUTF16CodeUnits :: [Word16] }

52instance Show PSString where

53instance Show PSString where

53 show = show . codePoints

54 show = show . codePoints

56+-- |

55-- Decode a PSString to a String, representing any lone surrogates as the

57-- Decode a PSString to a String, representing any lone surrogates as the

56-- reserved code point with that index. Warning: if there are any lone

58-- reserved code point with that index. Warning: if there are any lone

57-- surrogates, converting the result to Text via Data.Text.pack will result in

59-- surrogates, converting the result to Text via Data.Text.pack will result in

58-- loss of information as those lone surrogates will be replaced with U+FFFD

60-- loss of information as those lone surrogates will be replaced with U+FFFD

59-- REPLACEMENT CHARACTER. Because this function requires care to use correctly,

61-- REPLACEMENT CHARACTER. Because this function requires care to use correctly,

60-- we do not export it.

62-- we do not export it.

63+--

61codePoints :: PSString -> String

64codePoints :: PSString -> String

62codePoints = map (either (chr . fromIntegral) id) . decodeStringEither

65codePoints = map (either (chr . fromIntegral) id) . decodeStringEither

67+-- |

68+-- Decode a PSString as UTF-16 text. Lone surrogates will be replaced with

69+-- U+FFFD REPLACEMENT CHARACTER

70+--

71+decodeStringWithReplacement :: PSString -> String

72+decodeStringWithReplacement = map (either (const '\xFFFD') id) . decodeStringEither

73+

64-- |

74-- |

65-- Decode a PSString as UTF-16. Lone surrogates in the input are represented in

75-- Decode a PSString as UTF-16. Lone surrogates in the input are represented in

66-- the output with the Left constructor; characters which were successfully

76-- the output with the Left constructor; characters which were successfully