6dca01f · rowtype-yoga/purescript-native

src/Language/PureScript/Parser/Lexer.hs+23−1

compare with golang

unifiedsplit

@@ -69,12 +69,13 @@ module Language.PureScript.Parser.Lexer

69 , reservedPsNames

70 , reservedTypeNames

71 , isSymbolChar

72+ , isUnquotedKey

72 )

73 )

73 where

74 where

74

75

75import Prelude hiding (lex)

76import Prelude hiding (lex)

76

77

77−import Data.Char (isSpace, isAscii, isSymbol)

78+import Data.Char (isSpace, isAscii, isSymbol, isAlphaNum)

78

79

79import Control.Monad (void, guard)

80import Control.Monad (void, guard)

80import Data.Functor.Identity

81import Data.Functor.Identity

@@ -534,3 +535,24 @@ reservedTypeNames = [ "forall", "where" ]

534--

535--

535isSymbolChar :: Char -> Bool

536isSymbolChar :: Char -> Bool

536isSymbolChar c = (c `elem` ":!#$%&*+./<=>?@\\^|-~") || (not (isAscii c) && isSymbol c)

537isSymbolChar c = (c `elem` ":!#$%&*+./<=>?@\\^|-~") || (not (isAscii c) && isSymbol c)

538+

539+

540+-- |

541+-- The characters allowed in the head of an unquoted record key

542+--

543+isUnquotedKeyHeadChar :: Char -> Bool

544+isUnquotedKeyHeadChar c = (c == '_') || isAlphaNum c

545+

546+-- |

547+-- The characters allowed in the tail of an unquoted record key

548+--

549+isUnquotedKeyTailChar :: Char -> Bool

550+isUnquotedKeyTailChar c = (c `elem` "_'") || isAlphaNum c

551+

552+-- |

553+-- Strings allowed to be left unquoted in a record key

554+--

555+isUnquotedKey :: String -> Bool

556+isUnquotedKey [] = False

557+isUnquotedKey (hd : tl) = isUnquotedKeyHeadChar hd &&

558+ all isUnquotedKeyTailChar tl

src/Language/PureScript/Pretty/Common.hs+3−3

@@ -23,7 +23,7 @@ import Prelude.Compat

23import Control.Monad.State (StateT, modify, get)

24import Data.List (elemIndices, intersperse)

25

26−import Language.PureScript.Parser.Lexer (reservedPsNames, isSymbolChar)

26+import Language.PureScript.Parser.Lexer (reservedPsNames, isUnquotedKey)

27import Language.PureScript.AST (SourcePos(..), SourceSpan(..))

28

29import Text.PrettyPrint.Boxes

@@ -155,8 +155,8 @@ prettyPrintMany f xs = do

155--

156prettyPrintObjectKey :: String -> String

157prettyPrintObjectKey s | s `elem` reservedPsNames = show s

158− | any isSymbolChar s = show s

158+ | isUnquotedKey s = s

159− | otherwise = s

159+ | otherwise = show s

160

161-- | Place a box before another, vertically when the first box takes up multiple lines.

162before :: Box -> Box -> Box

src/Language/PureScript/Pretty/Values.hs+1−1

@@ -41,7 +41,7 @@ prettyPrintValue d (IfThenElse cond th el) =

41 // moveRight 2 (vcat left [ text "then " <> prettyPrintValueAtom (d - 1) th

42 , text "else " <> prettyPrintValueAtom (d - 1) el

43 ])

44−prettyPrintValue d (Accessor prop val) = prettyPrintValueAtom (d - 1) val <> text ("." ++ show prop)

44+prettyPrintValue d (Accessor prop val) = prettyPrintValueAtom (d - 1) val <> text ("." ++ prettyPrintObjectKey prop)

45prettyPrintValue d (ObjectUpdate o ps) = prettyPrintValueAtom (d - 1) o <> text " " <> list '{' '}' (\(key, val) -> text (key ++ " = ") <> prettyPrintValue (d - 1) val) ps

46prettyPrintValue d (App val arg) = prettyPrintValueAtom (d - 1) val `beforeWithSpace` prettyPrintValueAtom (d - 1) arg

47prettyPrintValue d (Abs (Left arg) val) = text ('\\' : showIdent arg ++ " -> ") // moveRight 2 (prettyPrintValue (d - 1) val)