diff --git a/src/Axel/AST.hs b/src/Axel/AST.hs index 64863b1..2dcc12d 100644 --- a/src/Axel/AST.hs +++ b/src/Axel/AST.hs @@ -10,8 +10,7 @@ import Axel.Haskell.Language (isOperator) import Axel.Haskell.Macros (hygenisizeMacroName) import qualified Axel.Parse.AST as Parse import Axel.Sourcemap - ( Bracket(CurlyBraces, DoubleQuotes, Parentheses, SingleQuotes, - SquareBrackets) + ( Bracket(CurlyBraces, Parentheses, SquareBrackets) , Delimiter(Commas, Newlines, Pipes, Spaces) ) import qualified Axel.Sourcemap as SM @@ -23,7 +22,6 @@ import qualified Axel.Sourcemap as SM , surround ) import qualified Axel.Utils.Display as Display (delimit, renderPragma, surround) -import Axel.Utils.Text (handleCharEscapes) import Axel.Utils.Tuple (annotate, unannotated) import Control.Lens.Combinators (_head, _last) @@ -452,13 +450,10 @@ instance ToHaskell (FunctionApplication (Maybe SM.Expression)) where instance ToHaskell (Literal (Maybe SM.Expression)) where toHaskell :: Literal (Maybe SM.Expression) -> SM.Output - toHaskell literal@(LChar _ x) = - mkHaskell literal $ - Display.surround SingleQuotes (handleCharEscapes (T.singleton x)) + toHaskell literal@(LChar _ x) = mkHaskell literal $ showText x toHaskell literal@(LFloat _ x) = mkHaskell literal $ showText x toHaskell literal@(LInt _ x) = mkHaskell literal $ showText x - toHaskell literal@(LString _ x) = - mkHaskell literal $ Display.surround DoubleQuotes (handleCharEscapes x) + toHaskell literal@(LString _ x) = mkHaskell literal $ showText x instance ToHaskell (TypeSignature (Maybe SM.Expression)) where toHaskell :: TypeSignature (Maybe SM.Expression) -> SM.Output diff --git a/src/Axel/Parse/AST.hs b/src/Axel/Parse/AST.hs index de4c2ef..7940b31 100644 --- a/src/Axel/Parse/AST.hs +++ b/src/Axel/Parse/AST.hs @@ -11,7 +11,6 @@ import Axel.Utils.Recursion , ZipperRecursive(zipperBottomUpTraverse, zipperTopDownTraverse) , bottomUpFmap ) -import Axel.Utils.Text (handleCharEscapes) import Axel.Utils.Zipper (unsafeDown, unsafeUp) import Control.Lens ((<|)) @@ -125,7 +124,7 @@ toAxel :: Expression ann -> Text toAxel (LiteralChar _ x) = "#\\" <> T.singleton x toAxel (LiteralFloat _ x) = showText x toAxel (LiteralInt _ x) = showText x -toAxel (LiteralString _ xs) = "\"" <> handleCharEscapes (T.pack xs) <> "\"" +toAxel (LiteralString _ xs) = showText xs toAxel (SExpression _ (Symbol _ "applyInfix":xs)) = "{" <> T.unwords (map toAxel xs) <> "}" toAxel (SExpression _ (Symbol _ "list":xs)) = diff --git a/src/Axel/Pretty.hs b/src/Axel/Pretty.hs index c73ed14..8936b77 100644 --- a/src/Axel/Pretty.hs +++ b/src/Axel/Pretty.hs @@ -7,7 +7,6 @@ import Axel.Parse.AST import qualified Axel.Sourcemap as SM import Axel.Utils.Foldable (mapWithPrev) import Axel.Utils.Recursion (bottomUpFmap) -import Axel.Utils.Text (handleCharEscapes) import Control.Lens (ala, under) @@ -79,7 +78,7 @@ toAxelPretty (LiteralChar _ x) = "#\\" <> P.pretty x toAxelPretty (LiteralFloat _ x) = P.pretty x toAxelPretty (LiteralInt _ x) = P.pretty x toAxelPretty (LiteralString _ x) = - P.dquotes $ P.pretty (under unpacked handleCharEscapes x) + P.dquotes $ P.pretty (under unpacked showText x) toAxelPretty (SExpression _ (Symbol _ "applyInfix":xs)) = P.braces $ sexp True (map toAxelPretty xs) toAxelPretty (SExpression _ (Symbol _ "list":xs)) = diff --git a/src/Axel/Utils/Text.hs b/src/Axel/Utils/Text.hs index b066bcc..9c5d541 100644 --- a/src/Axel/Utils/Text.hs +++ b/src/Axel/Utils/Text.hs @@ -29,13 +29,6 @@ s = (error "Cannot use s as a type") (error "Cannot use s as a dec") -handleCharEscapes :: Text -> Text -handleCharEscapes = - T.concatMap $ \case - '\\' -> "\\\\" - '\n' -> "\\n" - c -> T.singleton c - -- TODO This renders very poorly in e.g. Fira Code Mono. bold :: Text -> Text bold = T.map boldCharacter diff --git a/test/Axel/Test/ParseSpec.hs b/test/Axel/Test/ParseSpec.hs index 8cbedab..9a8037a 100644 --- a/test/Axel/Test/ParseSpec.hs +++ b/test/Axel/Test/ParseSpec.hs @@ -43,6 +43,24 @@ spec_Parse = do it "can parse a string literal" $ do let result = LiteralString () "a \x1000 \"b" parseSingle "\"a \x1000 \\\"b\"" `shouldBe` result + it + "can parse string literals with escaped double quotes at the boundaries (regression: #79)" $ do + let result = LiteralString () "a \x1000 \"" + parseSingle "\"a \x1000 \\\"\"" `shouldBe` result + let result = LiteralString () "a \x1000 \"\"" + parseSingle "\"a \x1000 \\\"\\\"\"" `shouldBe` result + let result = LiteralString () "\"" + parseSingle "\"\\\"\"" `shouldBe` result + let result = LiteralString () "\"\"" + parseSingle "\"\\\"\\\"\"" `shouldBe` result + let result = LiteralString () "\"\" foo" + parseSingle "\"\\\"\\\" foo\"" `shouldBe` result + let result = LiteralString () "\"\"\"" + parseSingle "\"\\\"\\\"\\\"\"" `shouldBe` result + it + "can parse a string literal with a double quote at the end (regression: #79)" $ do + let result = LiteralString () "a \x1000 \"" + parseSingle "\"a \x1000 \\\"\"" `shouldBe` result it "can parse a quasiquoted expression" $ do let result = SExpression diff --git a/test/Axel/Test/Transpilation/regression/Issue79.axel_golden b/test/Axel/Test/Transpilation/regression/Issue79.axel_golden new file mode 100644 index 0000000..31abf67 --- /dev/null +++ b/test/Axel/Test/Transpilation/regression/Issue79.axel_golden @@ -0,0 +1,5 @@ +(module Main) + +(= example "This should be a quotation mark: \"") + +(= main (print example)) diff --git a/test/Axel/Test/Transpilation/regression/Issue79.hs_golden b/test/Axel/Test/Transpilation/regression/Issue79.hs_golden new file mode 100644 index 0000000..6f87537 --- /dev/null +++ b/test/Axel/Test/Transpilation/regression/Issue79.hs_golden @@ -0,0 +1,6 @@ +module Main where +import Axel +import qualified Prelude as GHCPrelude +import qualified Axel.Parse.AST as AST +example = "This should be a quotation mark: \"" +main = (print example) diff --git a/test/Axel/Test/Transpilation/syntax/StringSyntax.hs_golden b/test/Axel/Test/Transpilation/syntax/StringSyntax.hs_golden index 635316b..61457ab 100644 --- a/test/Axel/Test/Transpilation/syntax/StringSyntax.hs_golden +++ b/test/Axel/Test/Transpilation/syntax/StringSyntax.hs_golden @@ -2,4 +2,4 @@ module StringSyntax where import Axel import qualified Prelude as GHCPrelude import qualified Axel.Parse.AST as AST -foo = "some\nstring\n multiline {- this should be in the string -} -- and this" +foo = "some\nstring\n multiline\t{- this should be in the string -} -- and this"