[Git][ghc/ghc][wip/multiline-strings] 6 commits: Add test cases for MultilineStrings
Brandon Chinn (@brandonchinn178)
gitlab at gitlab.haskell.org
Sun Feb 4 05:30:20 UTC 2024
Brandon Chinn pushed to branch wip/multiline-strings at Glasgow Haskell Compiler / GHC
Commits:
97b5f563 by Brandon Chinn at 2024-02-03T20:48:19-08:00
Add test cases for MultilineStrings
- - - - -
f858fbb7 by Brandon Chinn at 2024-02-03T20:48:19-08:00
Break out checking if string is primitive from lex_string
- - - - -
069511c6 by Brandon Chinn at 2024-02-03T20:48:19-08:00
Break out helper to consume string delimiter
- - - - -
df8d1b17 by Brandon Chinn at 2024-02-03T20:48:19-08:00
Implement MultilineStrings
- - - - -
b5ba93c5 by Brandon Chinn at 2024-02-03T20:48:19-08:00
Add docs for MultilineStrings
- - - - -
43b4c7bc by Brandon Chinn at 2024-02-03T20:48:19-08:00
[ci skip] wip
- - - - -
13 changed files:
- compiler/GHC/Hs/Lit.hs
- compiler/GHC/Hs/Syn/Type.hs
- compiler/GHC/HsToCore/Match/Literal.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/Lexer.x
- compiler/Language/Haskell/Syntax/Extension.hs
- compiler/Language/Haskell/Syntax/Lit.hs
- + docs/users_guide/exts/multiline_strings.rst
- + testsuite/tests/parser/should_run/MultilineStrings.hs
- + testsuite/tests/parser/should_run/MultilineStrings.stdout
- + testsuite/tests/parser/should_run/MultilineStringsOverloaded.hs
- + testsuite/tests/parser/should_run/MultilineStringsOverloaded.stdout
- testsuite/tests/parser/should_run/all.T
Changes:
=====================================
compiler/GHC/Hs/Lit.hs
=====================================
@@ -1,6 +1,7 @@
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-} -- Wrinkle in Note [Trees That Grow]
-- in module Language.Haskell.Syntax.Extension
@@ -25,8 +26,12 @@ import GHC.Prelude
import {-# SOURCE #-} GHC.Hs.Expr( pprExpr )
+import qualified Data.Foldable1 as Foldable1
+import Data.List (intercalate)
+import qualified Data.List.NonEmpty as NonEmpty
import GHC.Types.Basic (PprPrec(..), topPrec )
import GHC.Core.Ppr ( {- instance OutputableBndr TyVar -} )
+import GHC.Data.FastString
import GHC.Types.SourceText
import GHC.Core.Type
import GHC.Utils.Outputable
@@ -34,6 +39,7 @@ import GHC.Hs.Extension
import Language.Haskell.Syntax.Expr ( HsExpr )
import Language.Haskell.Syntax.Extension
import Language.Haskell.Syntax.Lit
+import Debug.Trace
{-
************************************************************************
@@ -46,6 +52,7 @@ import Language.Haskell.Syntax.Lit
type instance XHsChar (GhcPass _) = SourceText
type instance XHsCharPrim (GhcPass _) = SourceText
type instance XHsString (GhcPass _) = SourceText
+type instance XHsMultilineString (GhcPass _) = SourceText
type instance XHsStringPrim (GhcPass _) = SourceText
type instance XHsInt (GhcPass _) = NoExtField
type instance XHsIntPrim (GhcPass _) = SourceText
@@ -132,6 +139,7 @@ hsLitNeedsParens p = go
go (HsChar {}) = False
go (HsCharPrim {}) = False
go (HsString {}) = False
+ go (HsMultilineString {}) = False
go (HsStringPrim {}) = False
go (HsInt _ x) = p > topPrec && il_neg x
go (HsInteger _ x _) = p > topPrec && x < 0
@@ -155,6 +163,7 @@ convertLit :: HsLit (GhcPass p1) -> HsLit (GhcPass p2)
convertLit (HsChar a x) = HsChar a x
convertLit (HsCharPrim a x) = HsCharPrim a x
convertLit (HsString a x) = HsString a x
+convertLit (HsMultilineString a x) = HsMultilineString a x
convertLit (HsStringPrim a x) = HsStringPrim a x
convertLit (HsInt a x) = HsInt a x
convertLit (HsIntPrim a x) = HsIntPrim a x
@@ -192,6 +201,7 @@ instance Outputable (HsLit (GhcPass p)) where
ppr (HsChar st c) = pprWithSourceText st (pprHsChar c)
ppr (HsCharPrim st c) = pprWithSourceText st (pprPrimChar c)
ppr (HsString st s) = pprWithSourceText st (pprHsString s)
+ ppr (HsMultilineString st s) = pprWithSourceText st (pprHsString $ processMultilineStringLiteral s)
ppr (HsStringPrim st s) = pprWithSourceText st (pprHsBytes s)
ppr (HsInt _ i)
= pprWithSourceText (il_text i) (integer (il_value i))
@@ -231,6 +241,7 @@ pmPprHsLit :: HsLit (GhcPass x) -> SDoc
pmPprHsLit (HsChar _ c) = pprHsChar c
pmPprHsLit (HsCharPrim _ c) = pprHsChar c
pmPprHsLit (HsString st s) = pprWithSourceText st (pprHsString s)
+pmPprHsLit (HsMultilineString st s) = pprWithSourceText st (pprHsString $ processMultilineStringLiteral st s)
pmPprHsLit (HsStringPrim _ s) = pprHsBytes s
pmPprHsLit (HsInt _ i) = integer (il_value i)
pmPprHsLit (HsIntPrim _ i) = integer i
@@ -248,3 +259,100 @@ pmPprHsLit (HsRat _ f _) = ppr f
pmPprHsLit (HsFloatPrim _ f) = ppr f
pmPprHsLit (HsDoublePrim _ d) = ppr d
+{-
+Note [Multiline string literals]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+Multiline string literals were added following the acceptance of the
+proposal: https://github.com/ghc-proposals/ghc-proposals/pull/569
+
+Multiline string literals are syntax sugar for normal string literals,
+with an extra post processing step on the SourceText. We do this on
+the SourceText instead of the parsed output because the lexer resolves
+escaped characters, but we need the actual escaped characters here.
+
+The string is post-process with the following steps:
+1. Collapse string gaps
+2. Split the string by newlines
+3. Convert leading tabs into spaces
+ * In each line, any tabs preceding non-whitespace characters are replaced with spaces up to the next tab stop
+4. Remove common whitespace prefix in every line
+ * See below
+5. Join the string back with `\n` delimiters
+6. If the first character of the string is a newline, remove it
+7. Interpret escaped characters
+
+The common whitespace prefix can be informally defined as "The longest
+prefix of whitespace shared by all lines in the string, excluding the
+first line and any whitespace-only lines".
+
+It's more precisely defined with the following algorithm:
+
+1. Take a list representing the lines in the string
+2. Ignore the following elements in the list:
+ * The first line (we want to ignore everything before the first newline)
+ * Empty lines
+ * Lines with only whitespace characters
+3. Calculate the longest prefix of whitespace shared by all lines in the remaining list
+-}
+
+-- | See Note [Multiline string literals]
+processMultilineStringLiteral :: SourceText -> FastString -> FastString
+processMultilineStringLiteral = \case
+ SourceText s | Just s' <- fromSourceText s -> \_ -> mkFastString $ process s'
+ -- if we don't get a valid SourceText, be safe and don't post-process
+ _ -> id
+ where
+ (.>) :: (a -> b) -> (b -> c) -> (a -> c)
+ (.>) = flip (.)
+
+ fromSourceText s =
+ let stripSuffix x = fmap reverse . stripPrefix x . reverse
+ in stripSuffix "\"\"\"" =<< stripPrefix "\"\"\"" (unpackFS s)
+
+ process =
+ collapseStringGaps
+ .> splitLines
+ .> convertLeadingTabs
+ .> rmCommonWhitespacePrefix
+ .> joinLines
+ .> rmFirstNewline
+
+ -- avoid `lines` because it treats a trailing newline the same as no trailing newline
+ splitLines =
+ foldr
+ ( curry $ \case
+ ('\n', ls) -> "" : ls
+ (c, l : ls) -> (c:l) : ls
+ (c, []) -> [c] : [] -- should not happen
+ )
+ [""]
+
+ convertLeadingTabs =
+ let convertLine col = \case
+ [] -> ""
+ ' ' : cs -> ' ' : convertLine (col + 1) cs
+ '\t' : cs ->
+ let fill = 8 - (col `mod` 8)
+ in replicate fill ' ' ++ convertLine (col + fill) cs
+ c : cs -> c : cs
+ in map (convertLine 0)
+
+ rmCommonWhitespacePrefix strLines =
+ let
+ excludeLines =
+ drop 1 -- ignore first line
+ .> filter (not . all (== ' ')) -- ignore lines that are all whitespace
+ commonWSPrefix =
+ case NonEmpty.nonEmpty (excludeLines strLines) of
+ Nothing -> 0
+ Just strLines' -> Foldable1.minimum $ NonEmpty.map (length . takeWhile (== ' ')) strLines'
+ in
+ map (drop commonWSPrefix) strLines
+ -- map (drop commonWSPrefix) . (\s -> traceShow ("rmCommonWhitespacePrefix", commonWSPrefix, excludeLines strLines, s) s) $ strLines
+
+ joinLines = intercalate "\n"
+
+ rmFirstNewline = \case
+ '\n' : s -> s
+ s -> s
=====================================
compiler/GHC/Hs/Syn/Type.hs
=====================================
@@ -74,6 +74,7 @@ hsLitType :: HsLit (GhcPass p) -> Type
hsLitType (HsChar _ _) = charTy
hsLitType (HsCharPrim _ _) = charPrimTy
hsLitType (HsString _ _) = stringTy
+hsLitType (HsMultilineString _ _) = stringTy
hsLitType (HsStringPrim _ _) = addrPrimTy
hsLitType (HsInt _ _) = intTy
hsLitType (HsIntPrim _ _) = intPrimTy
=====================================
compiler/GHC/HsToCore/Match/Literal.hs
=====================================
@@ -73,6 +73,7 @@ import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NEL
import Data.Word
import GHC.Real ( Ratio(..), numerator, denominator )
+import Debug.Trace
{-
************************************************************************
@@ -121,6 +122,7 @@ dsLit l = do
HsDoublePrim _ fl -> return (Lit (LitDouble (rationalFromFractionalLit fl)))
HsChar _ c -> return (mkCharExpr c)
HsString _ str -> mkStringExprFS str
+ HsMultilineString st str -> mkStringExprFS $ processMultilineStringLiteral st str
HsInteger _ i _ -> return (mkIntegerExpr platform i)
HsInt _ i -> return (mkIntExpr platform (il_value i))
HsRat _ fl ty -> dsFractionalLitToRational fl ty
@@ -474,6 +476,7 @@ getSimpleIntegralLit (HsInteger _ i ty) = Just (i, ty)
getSimpleIntegralLit HsChar{} = Nothing
getSimpleIntegralLit HsCharPrim{} = Nothing
getSimpleIntegralLit HsString{} = Nothing
+getSimpleIntegralLit HsMultilineString{} = Nothing
getSimpleIntegralLit HsStringPrim{} = Nothing
getSimpleIntegralLit HsRat{} = Nothing
getSimpleIntegralLit HsFloatPrim{} = Nothing
=====================================
compiler/GHC/Parser.y
=====================================
@@ -697,6 +697,7 @@ are the most common patterns, rewritten as regular expressions for clarity:
CHAR { L _ (ITchar _ _) }
STRING { L _ (ITstring _ _) }
+ MULTILINESTRING { L _ (ITmultilinestring _ _) }
INTEGER { L _ (ITinteger _) }
RATIONAL { L _ (ITrational _) }
@@ -3913,6 +3914,8 @@ literal :: { Located (HsLit GhcPs) }
: CHAR { sL1 $1 $ HsChar (getCHARs $1) $ getCHAR $1 }
| STRING { sL1 $1 $ HsString (getSTRINGs $1)
$ getSTRING $1 }
+ | MULTILINESTRING { sL1 $1 $ HsMultilineString (getMULTILINESTRINGs $1)
+ $ getMULTILINESTRING $1 }
| PRIMINTEGER { sL1 $1 $ HsIntPrim (getPRIMINTEGERs $1)
$ getPRIMINTEGER $1 }
| PRIMWORD { sL1 $1 $ HsWordPrim (getPRIMWORDs $1)
@@ -4018,6 +4021,7 @@ getIPDUPVARID (L _ (ITdupipvarid x)) = x
getLABELVARID (L _ (ITlabelvarid _ x)) = x
getCHAR (L _ (ITchar _ x)) = x
getSTRING (L _ (ITstring _ x)) = x
+getMULTILINESTRING (L _ (ITmultilinestring _ x)) = x
getINTEGER (L _ (ITinteger x)) = x
getRATIONAL (L _ (ITrational x)) = x
getPRIMCHAR (L _ (ITprimchar _ x)) = x
@@ -4043,6 +4047,7 @@ getVOCURLY (L (RealSrcSpan l _) ITvocurly) = srcSpanStartCol l
getINTEGERs (L _ (ITinteger (IL src _ _))) = src
getCHARs (L _ (ITchar src _)) = src
getSTRINGs (L _ (ITstring src _)) = src
+getMULTILINESTRINGs (L _ (ITmultilinestring src _)) = src
getPRIMCHARs (L _ (ITprimchar src _)) = src
getPRIMSTRINGs (L _ (ITprimstring src _)) = src
getPRIMINTEGERs (L _ (ITprimint src _)) = src
=====================================
compiler/GHC/Parser/Lexer.x
=====================================
@@ -662,7 +662,8 @@ $unigraphic / { isSmartQuote } { smart_quote_error }
-- to convert it to a String.
<0> {
\' { lex_char_tok }
- \" { lex_string_tok }
+ \"\"\" / { ifExtension MultilineStringsBit} { lex_string_tok StringTypeMulti }
+ \" { lex_string_tok StringTypeSingle }
}
-- Note [Whitespace-sensitive operator parsing]
@@ -948,6 +949,7 @@ data Token
| ITchar SourceText Char -- Note [Literal source text] in "GHC.Types.SourceText"
| ITstring SourceText FastString -- Note [Literal source text] in "GHC.Types.SourceText"
+ | ITmultilinestring SourceText FastString -- Note [Literal source text] in "GHC.Types.SourceText"
| ITinteger IntegralLit -- Note [Literal source text] in "GHC.Types.SourceText"
| ITrational FractionalLit
@@ -2160,22 +2162,32 @@ lex_string_prag_comment mkTok span _buf _len _buf2
-- This stuff is horrible. I hates it.
-lex_string_tok :: Action
-lex_string_tok span buf _len _buf2 = do
- lexed <- lex_string
+data LexStringType = StringTypeSingle | StringTypeMulti deriving (Eq)
+
+lex_string_tok :: LexStringType -> Action
+lex_string_tok strType span buf _len _buf2 = do
+ s <- lex_string strType
+
(AI end bufEnd) <- getInput
- let
- tok = case lexed of
- LexedPrimString s -> ITprimstring (SourceText src) (unsafeMkByteString s)
- LexedRegularString s -> ITstring (SourceText src) (mkFastString s)
- src = lexemeToFastString buf (cur bufEnd - cur buf)
+ let src = lexemeToFastString buf (cur bufEnd - cur buf)
+
+ tok <- case strType of
+ StringTypeSingle -> do
+ isPrim <- lex_string_is_prim s
+ return $
+ if isPrim
+ then ITprimstring (SourceText src) (unsafeMkByteString s)
+ else ITstring (SourceText src) (mkFastString s)
+ StringTypeMulti ->
+ return $ ITmultilinestring (SourceText src) (mkFastString s)
+
return $ L (mkPsSpan (psSpanStart span) end) tok
lex_quoted_label :: Action
lex_quoted_label span buf _len _buf2 = do
start <- getInput
- s <- lex_string_helper "" start
+ s <- lex_string_helper StringTypeSingle "" start
(AI end bufEnd) <- getInput
let
token = ITlabelvarid (SourceText src) (mkFastString s)
@@ -2185,12 +2197,12 @@ lex_quoted_label span buf _len _buf2 = do
return $ L (mkPsSpan start end) token
-data LexedString = LexedRegularString String | LexedPrimString String
+lex_string :: LexStringType -> P String
+lex_string strType = getInput >>= lex_string_helper strType ""
-lex_string :: P LexedString
-lex_string = do
- start <- getInput
- s <- lex_string_helper "" start
+
+lex_string_is_prim :: String -> P Bool
+lex_string_is_prim s = do
magicHash <- getBit MagicHashBit
if magicHash
then do
@@ -2203,35 +2215,34 @@ lex_string = do
let msg = PsErrPrimStringInvalidChar
let err = mkPlainErrorMsgEnvelope (mkSrcSpanPs (last_loc pState)) msg
addError err
- return $ LexedPrimString s
+ return True
_other ->
- return $ LexedRegularString s
- else
- return $ LexedRegularString s
+ return False
+ else return False
-lex_string_helper :: String -> AlexInput -> P String
-lex_string_helper s start = do
+lex_string_helper :: LexStringType -> String -> AlexInput -> P String
+lex_string_helper strType s start = do
i <- getInput
- case alexGetChar' i of
+ getNextCharInStr i >>= \case
Nothing -> lit_error i
- Just ('"',i) -> do
- setInput i
- return (reverse s)
+ Just Nothing -> return (reverse s)
- Just ('\\',i)
+ Just (Just ('\\',i))
| Just ('&',i) <- next -> do
- setInput i; lex_string_helper s start
+ setInput i; lex_string_helper strType s start
| Just (c,i) <- next, c <= '\x7f' && is_space c -> do
-- is_space only works for <= '\x7f' (#3751, #5425)
- setInput i; lex_stringgap s start
+ setInput i; lex_stringgap strType s start
where next = alexGetChar' i
- Just (c, i1) -> do
+ Just (Just (c, i1)) -> do
case c of
- '\\' -> do setInput i1; c' <- lex_escape; lex_string_helper (c':s) start
- c | isAny c -> do setInput i1; lex_string_helper (c:s) start
+ '\\' -> do setInput i1; c' <- lex_escape; lex_string_helper strType (c':s) start
+ c | isAny c || (strType == StringTypeMulti && c `elem` ['\n', '\t']) -> do
+ setInput i1
+ lex_string_helper strType (c:s) start
_other | any isDoubleSmartQuote s -> do
-- if the built-up string s contains a smart double quote character, it was
-- likely the reason why the string literal was not lexed correctly
@@ -2243,15 +2254,38 @@ lex_string_helper s start = do
Just (c, _) -> do add_nonfatal_smart_quote_error c loc; lit_error i
Nothing -> lit_error i -- should never get here
_other -> lit_error i
+ where
+ -- Nothing = EOF
+ -- Just Nothing = found + consumed string delimiter
+ -- Just (Just (c, i)) = found next character in string
+ getNextCharInStr i =
+ case alexGetChar' i of
+ Nothing ->
+ return Nothing
+ Just ('"', i') ->
+ case strType of
+ StringTypeSingle -> do
+ setInput i'
+ return $ Just Nothing
+ StringTypeMulti
+ | Just ('"', i'') <- alexGetChar' i'
+ , Just ('"', i'') <- alexGetChar' i''
+ -> do
+ setInput i''
+ return $ Just Nothing
+ | otherwise ->
+ return $ Just (Just ('"', i'))
+ Just x ->
+ return $ Just (Just x)
-lex_stringgap :: String -> AlexInput -> P String
-lex_stringgap s start = do
+lex_stringgap :: LexStringType -> String -> AlexInput -> P String
+lex_stringgap strType s start = do
i <- getInput
c <- getCharOrFail i
case c of
- '\\' -> lex_string_helper s start
- c | c <= '\x7f' && is_space c -> lex_stringgap s start
+ '\\' -> lex_string_helper strType s start
+ c | c <= '\x7f' && is_space c -> lex_stringgap strType s start
-- is_space only works for <= '\x7f' (#3751, #5425)
_other -> lit_error i
@@ -3038,6 +3072,7 @@ data ExtBits
| OverloadedRecordDotBit
| OverloadedRecordUpdateBit
| ExtendedLiteralsBit
+ | MultilineStringsBit
-- Flags that are updated once parsing starts
| InRulePragBit
@@ -3118,6 +3153,7 @@ mkParserOpts extensionFlags diag_opts supported
.|. OverloadedRecordDotBit `xoptBit` LangExt.OverloadedRecordDot
.|. OverloadedRecordUpdateBit `xoptBit` LangExt.OverloadedRecordUpdate -- Enable testing via 'getBit OverloadedRecordUpdateBit' in the parser (RecordDotSyntax parsing uses that information).
.|. ExtendedLiteralsBit `xoptBit` LangExt.ExtendedLiterals
+ .|. MultilineStringsBit `xoptBit` LangExt.MultilineStrings
optBits =
HaddockBit `setBitIf` isHaddock
.|. RawTokenStreamBit `setBitIf` rawTokStream
=====================================
compiler/Language/Haskell/Syntax/Extension.hs
=====================================
@@ -565,6 +565,7 @@ type family XXApplicativeArg x
type family XHsChar x
type family XHsCharPrim x
type family XHsString x
+type family XHsMultilineString x
type family XHsStringPrim x
type family XHsInt x
type family XHsIntPrim x
=====================================
compiler/Language/Haskell/Syntax/Lit.hs
=====================================
@@ -54,6 +54,8 @@ data HsLit x
-- ^ Unboxed character
| HsString (XHsString x) {- SourceText -} FastString
-- ^ String
+ | HsMultilineString (XHsMultilineString x) {- SourceText -} FastString
+ -- ^ Multiline String literal
| HsStringPrim (XHsStringPrim x) {- SourceText -} !ByteString
-- ^ Packed bytes
| HsInt (XHsInt x) IntegralLit
=====================================
docs/users_guide/exts/multiline_strings.rst
=====================================
@@ -0,0 +1,17 @@
+.. _multiline-strings:
+
+Multiline string literals
+-------------------------
+
+.. extension:: MultilineStrings
+ :shortdesc: Enable multiline string literals.
+
+ :since: 9.10.1
+
+ Enable multiline string literals.
+
+With this extension, GHC now recognizes multiline string literals with ``"""`` delimiters. Indentation is automatically stripped, and gets desugared to normal string literals, so it works as expected for ``OverloadedStrings`` and any other functionality.
+
+TODO: explain removing common whitespace prefix
+TODO: add full spec
+TODO: add examples
=====================================
testsuite/tests/parser/should_run/MultilineStrings.hs
=====================================
@@ -0,0 +1,202 @@
+{-# LANGUAGE MultilineStrings #-}
+{-# OPTIONS_GHC -Wno-tabs #-}
+
+import Text.Printf (printf)
+
+{-
+Test the MultilineStrings proposal
+https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0569-multiline-strings.rst
+-}
+
+main :: IO ()
+main = do
+ putStrLn "-- 1"
+ prints example_1
+ putStrLn "\n-- 2"
+ prints example_2a
+ prints example_2b
+ prints example_2c
+ putStrLn "\n-- 3"
+ prints example_3
+ putStrLn "\n-- 4"
+ prints example_4
+ putStrLn "\n-- 5"
+ prints example_5
+ putStrLn "\n-- 6"
+ prints example_6a
+ prints example_6b
+ putStrLn "\n-- 7"
+ prints example_7a
+ prints example_7b_1
+ prints example_7b_2
+ putStrLn "\n-- 8"
+ prints example_8
+ putStrLn "\n-- 9"
+ prints example_9
+ putStrLn "\n-- 10"
+ prints example_10a
+ prints example_10b
+ putStrLn "\n-- 11"
+ prints example_11
+
+ putStrLn "\n-- extra"
+ prints """"""
+ prints
+ """
+ """
+ prints
+ """
+ \n
+ """
+ prints
+ """
+ \\n
+ """
+ where
+ prints :: String -> IO ()
+ prints = print
+
+example_1 =
+ """
+ abc
+
+ def
+
+ ghi
+ \njkl
+ """
+
+example_2a =
+ """Line 1
+ Line 2
+ Line 3
+ """
+
+example_2b =
+ """\
+ \Line 1
+ Line 2
+ Line 3
+ """
+
+example_2c = """hello world"""
+
+example_3 =
+ """
+ a b\
+ \ c d e
+ f g
+ """
+
+example_4 =
+ """
+ a
+ b
+ c
+ """
+
+example_5 =
+ """
+
+ a
+ b
+ c
+ """
+
+example_6a =
+ """
+ a
+ b
+ c"""
+
+example_6b =
+ """
+ a
+ b
+ c\
+ \"""
+
+example_7a =
+ """
+ a
+ b
+ c
+ """
+
+example_7b_1 =
+ """
+ \& a
+ b
+ c
+ """
+
+example_7b_2 =
+ """
+ \& a
+ \& b
+ \& c
+ """
+
+example_8 =
+ """
+ This is a literal multiline string:
+ \"\"\"
+ Hello
+ world!
+ \"""
+ """
+
+example_9 =
+ """
+ name\tage
+ Alice\t20
+ Bob\t30
+ \t40
+ """
+
+example_10a =
+ """
+ \\v -> case v of
+ Aeson.Null -> pure PrintStyleInherit
+ Aeson.String "" -> pure PrintStyleInherit
+ _ -> PrintStyleOverride <$> Aeson.parseJSON v
+ """
+
+example_10b =
+ """
+ \\s -> case s of
+ "" -> pure PrintStyleInherit
+ _ -> PrintStyleOverride <$> parsePrinterOptType s
+ """
+
+example_11 =
+ printf
+ """
+ instance Aeson.FromJSON %s where
+ parseJSON =
+ Aeson.withText "%s" $ \\s ->
+ either Aeson.parseFail pure $
+ parsePrinterOptType (Text.unpack s)
+
+ instance PrinterOptsFieldType %s where
+ parsePrinterOptType s =
+ case s of
+ %s
+ _ ->
+ Left . unlines $
+ [ "unknown value: " <> show s
+ , "Valid values are: %s"
+ ]
+ """
+ fieldTypeName
+ fieldTypeName
+ fieldTypeName
+ ( unlines
+ [ printf " \"%s\" -> Right %s" val con
+ | (con, val) <- enumOptions
+ ]
+ )
+ (unwords $ map snd enumOptions)
+ where
+ fieldTypeName = "MyEnum"
+ enumOptions = [("Foo", "foo"), ("BarBaz", "bar-baz")]
=====================================
testsuite/tests/parser/should_run/MultilineStrings.stdout
=====================================
@@ -0,0 +1,44 @@
+-- 1
+" abc\n\n def\n\nghi\n \njkl\n"
+
+-- 2
+"Line 1\n Line 2\nLine 3"
+"Line 1\n Line 2\nLine 3"
+"hello world"
+
+-- 3
+"a b c d e\nf g\n"
+
+-- 4
+"a\nb\nc\n"
+
+-- 5
+"\na\nb\nc\n"
+
+-- 6
+"a\nb\nc"
+"a\nb\nc"
+
+-- 7
+"a\nb\nc\n"
+" a\n b\n c\n"
+" a\n b\n c\n"
+
+-- 8
+"This is a literal multiline string:\n\"\"\"\nHello\n world!\n\"\"\"\n"
+
+-- 9
+" name\tage\n Alice\t20\n Bob\t30\n\t40\n"
+
+-- 10
+"\\v -> case v of\n Aeson.Null -> pure PrintStyleInherit\n Aeson.String \"\" -> pure PrintStyleInherit\n _ -> PrintStyleOverride <$> Aeson.parseJSON v\n"
+"\\s -> case s of\n \"\" -> pure PrintStyleInherit\n _ -> PrintStyleOverride <$> parsePrinterOptType s\n"
+
+-- 11
+"instance Aeson.FromJSON MyEnum where\n parseJSON =\n Aeson.withText \"MyEnum\" $ \\s ->\n either Aeson.parseFail pure $\n parsePrinterOptType (Text.unpack s)\n\ninstance PrinterOptsFieldType MyEnum where\n parsePrinterOptType s =\n case s of\n \"foo\" -> Right Foo\n \"bar-baz\" -> Right BarBaz\n ->\n Left . unlines $\n [ \"unknown value: \" <> show s\n , \"Valid values are: foo bar-baz\"\n ]\n"
+
+-- extra
+""
+"\n"
+"\n\n"
+"\\n\n"
\ No newline at end of file
=====================================
testsuite/tests/parser/should_run/MultilineStringsOverloaded.hs
=====================================
@@ -0,0 +1,22 @@
+{-# LANGUAGE MultilineStrings #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+import Data.String (IsString (..))
+import Data.Text (Text)
+
+newtype Lines s = Lines [s]
+ deriving (Show)
+
+instance IsString s => IsString (Lines s) where
+ fromString = Lines . map fromString . lines
+
+lines0 :: Lines Text
+lines0 =
+ """
+ this is
+ a test
+ with multiple lines
+ """
+
+main :: IO ()
+main = print lines0
=====================================
testsuite/tests/parser/should_run/MultilineStringsOverloaded.stdout
=====================================
@@ -0,0 +1 @@
+Lines ["this is", "a test", "with multiple lines"]
=====================================
testsuite/tests/parser/should_run/all.T
=====================================
@@ -20,3 +20,5 @@ test('RecordDotSyntax2', normal, compile_and_run, [''])
test('RecordDotSyntax3', [extra_files(['RecordDotSyntaxA.hs'])], multimod_compile_and_run, ['RecordDotSyntax3', ''])
test('RecordDotSyntax4', [extra_files(['RecordDotSyntaxA.hs'])], multimod_compile_and_run, ['RecordDotSyntax4', ''])
test('RecordDotSyntax5', normal, compile_and_run, [''])
+test('MultilineStrings', normal, compile_and_run, [''])
+test('MultilineStringsOverloaded', normal, compile_and_run, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/df5f7dcedd0fc3a402f45fe5e0cbfdf2c17051fc...43b4c7bc07e1d97a7f970c7acecde5fce38c37e7
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/df5f7dcedd0fc3a402f45fe5e0cbfdf2c17051fc...43b4c7bc07e1d97a7f970c7acecde5fce38c37e7
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240204/95bf1271/attachment-0001.html>
More information about the ghc-commits
mailing list