git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Merge pull request #2586 from michaelficarra/GH-2568

TypeLevelString/TypeConcat should not be quoted

commitbfb255dc29cbd101b80069ce11656943ca3e31a6 authorHarry Garrood <harry@garrood.me> dateFri 20 Jan 2017, 23:37 (10 years ago) parent3f1a50ed1a88d7
2 files changed+22−7
compare with golang
unifiedsplit
src/Language/PureScript/Errors.hs+12−7 src/Language/PureScript/PSString.hs+10
src/Language/PureScript/Errors.hs+12−7
@@ -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,7 +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.Pretty.Common (endWith)
36+import Language.PureScript.PSString (PSString, decodeStringWithReplacement)
3537import Language.PureScript.Traversals
3638import Language.PureScript.Types
3739import qualified Language.PureScript.Publish.BoxesHelpers as BoxHelpers
@@ -1264,12 +1266,15 @@ renderBox = unlines
12641266 whiteSpace = all isSpace
12651267
12661268toTypelevelString :: Type -> Maybe Box.Box
1267−toTypelevelString (TypeLevelString s) = Just $ Box.text $ T.unpack $ prettyPrintString s
1268−toTypelevelString (TypeApp (TypeConstructor f) x)
1269− | f == primName "TypeString" = Just $ typeAsBox x
1270−toTypelevelString (TypeApp (TypeApp (TypeConstructor f) x) ret)
1271− | f == primName "TypeConcat" = before <$> (toTypelevelString x) <*> (toTypelevelString ret)
1272−toTypelevelString _ = Nothing
1269+toTypelevelString t = (Box.text . decodeStringWithReplacement) <$> 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
12731278
12741279-- | Rethrow an error with a more detailed error message in the case of failure
12751280rethrow :: (MonadError e m) => (e -> e) -> m a -> m a
src/Language/PureScript/PSString.hs+10
@@ -5,6 +5,7 @@ module Language.PureScript.PSString
55 , toUTF16CodeUnits
66 , decodeString
77 , decodeStringEither
8+ , decodeStringWithReplacement
89 , prettyPrintString
910 , prettyPrintStringJS
1011 , mkString
@@ -52,15 +53,24 @@ newtype PSString = PSString { toUTF16CodeUnits :: [Word16] }
5253instance Show PSString where
5354 show = show . codePoints
5455
56+-- |
5557-- Decode a PSString to a String, representing any lone surrogates as the
5658-- reserved code point with that index. Warning: if there are any lone
5759-- surrogates, converting the result to Text via Data.Text.pack will result in
5860-- loss of information as those lone surrogates will be replaced with U+FFFD
5961-- REPLACEMENT CHARACTER. Because this function requires care to use correctly,
6062-- we do not export it.
63+--
6164codePoints :: PSString -> String
6265codePoints = map (either (chr . fromIntegral) id) . decodeStringEither
6366
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+
6474-- |
6575-- Decode a PSString as UTF-16. Lone surrogates in the input are represented in
6676-- the output with the Left constructor; characters which were successfully