6dca01f · rowtype-yoga/purescript-native

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

Fix some pretty printing issues

commit6dca01fcfb8c94af43b4805ebd9c51d2767e606a authorLiam Goodacre <goodacre.liam@gmail.com> dateWed 20 Apr 2016, 00:21 (11 years ago) parenta3f940b

3 files changed+27−5

compare with golang

unifiedsplit

src/Language/PureScript/Parser/Lexer.hs+23−1 src/Language/PureScript/Pretty/Common.hs+3−3 src/Language/PureScript/Pretty/Values.hs+1−1

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

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

6969 , reservedPsNames

7070 , reservedTypeNames

7171 , isSymbolChar

72+ , isUnquotedKey

7273 )

7374 where

7475

7576import Prelude hiding (lex)

7677

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

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

7879

7980import Control.Monad (void, guard)

8081import Data.Functor.Identity

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

534535--

535536isSymbolChar :: Char -> Bool

536537isSymbolChar 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

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

2424import Data.List (elemIndices, intersperse)

2525

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

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

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

2828

2929import Text.PrettyPrint.Boxes

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

155155--

156156prettyPrintObjectKey :: String -> String

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

158− | any isSymbolChar s = show s

159− | otherwise = s

158+ | isUnquotedKey s = s

159+ | otherwise = show s

160160

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

162162before :: Box -> Box -> Box

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

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

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

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

4343 ])

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)

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

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

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