format: retain multiline string formatting

Author: avh4

compiler/src/AST/Source.hs

@@ -61,7 +61,7 @@ type Expr = A.Located Expr_
 
 data Expr_
   = Chr ES.String
-  | Str ES.String
+  | Str ES.String ES.StringFormat
   | Int Int GI.IntFormat
   | Float EF.Float
   | Var VarType Name

compiler/src/Canonicalize/Expression.hs

@@ -50,7 +50,7 @@ canonicalize :: Env.Env -> Src.Expr -> Result FreeLocals [W.Warning] Can.Expr
 canonicalize env (A.At region expression) =
   A.At region
     <$> case expression of
-      Src.Str string ->
+      Src.Str string _ ->
         Result.ok (Can.Str string)
       Src.Chr char ->
         Result.ok (Can.Chr char)

compiler/src/Data/Utf8.hs

@@ -23,6 +23,7 @@ module Data.Utf8
     putVeryLong,
     --
     toChars,
+    toText,
     toBuilder,
     toEscapedBuilder,
     --
@@ -46,6 +47,7 @@ import Data.ByteString.Builder.Internal qualified as B
 import Data.ByteString.Internal qualified as B
 import Data.Char qualified as Char
 import Data.List qualified as List
+import Data.Text qualified as Text
 import Foreign.ForeignPtr (touchForeignPtr)
 import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)
 import Foreign.Ptr (minusPtr, plusPtr)
@@ -330,6 +332,13 @@ word8ToInt# :: Word8# -> Int#
 word8ToInt# word8 =
   int8ToInt# (word8ToInt8# word8)
 
+-- TO TEXT
+
+toText :: Utf8 t -> Text.Text
+toText =
+  -- This could most certainly be optimized for better performance
+  Text.pack . toChars
+
 -- TO BUILDER
 
 toBuilder :: Utf8 t -> B.Builder

compiler/src/Gren/Format.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeApplications #-}
 {-# OPTIONS_GHC -Werror=incomplete-patterns #-}
 {-# OPTIONS_GHC -Wno-error=unused-matches #-}
@@ -21,8 +22,11 @@ import Data.Maybe (catMaybes, maybeToList)
 import Data.Maybe qualified as Maybe
 import Data.Name (Name)
 import Data.Semigroup (sconcat)
+import Data.Text qualified as Text
+import Data.Text.Encoding (encodeUtf8Builder)
 import Data.Utf8 qualified as Utf8
 import Gren.Int qualified as GI
+import Gren.String qualified as GS
 import Parse.Primitives qualified as P
 import Reporting.Annotation qualified as A
 import Text.PrettyPrint.Avh4.Block (Block)
@@ -556,9 +560,12 @@ formatExpr = \case
   Src.Chr char ->
     NoExpressionParens $
       formatString StringStyleChar char
-  Src.Str string ->
+  Src.Str string GS.SingleLineString ->
     NoExpressionParens $
       formatString StringStyleSingleQuoted string
+  Src.Str string GS.MultilineString ->
+    NoExpressionParens $
+      formatString StringStyleTripleQuoted string
   Src.Int int intFormat ->
     NoExpressionParens $ formatInt intFormat int
   Src.Float float ->
@@ -1054,7 +1061,13 @@ formatString style str =
     StringStyleSingleQuoted ->
       stringBox (Block.char7 '"')
     StringStyleTripleQuoted ->
-      stringBox (Block.string7 "\"\"\"")
+      Block.stack $
+        NonEmpty.fromList $
+          mconcat
+            [ [Block.line (Block.string7 "\"\"\"")],
+              fmap (Block.line . Block.lineFromBuilder . encodeUtf8Builder) $ Text.splitOn "\\n" $ (Utf8.toText str),
+              [Block.line (Block.string7 "\"\"\"")]
+            ]
   where
     stringBox :: Block.Line -> Block
     stringBox quotes =

compiler/src/Gren/String.hs

@@ -5,6 +5,7 @@
 
 module Gren.String
   ( String,
+    StringFormat (..),
     toChars,
     fromChars,
     toBuilder,
@@ -31,6 +32,11 @@ type String =
 
 data GREN_STRING
 
+data StringFormat
+  = SingleLineString
+  | MultilineString
+  deriving (Show)
+
 -- HELPERS
 
 toChars :: String -> [Char]

compiler/src/Parse/Expression.hs

@@ -44,8 +44,8 @@ term =
 string :: A.Position -> Parser E.Expr Src.Expr
 string start =
   do
-    str <- String.string E.Start E.String
-    addEnd start (Src.Str str)
+    (str, stringFormat) <- String.string E.Start E.String
+    addEnd start (Src.Str str stringFormat)
 
 character :: A.Position -> Parser E.Expr Src.Expr
 character start =

compiler/src/Parse/Pattern.hs

@@ -73,7 +73,7 @@ termHelp start =
               let width = fromIntegral (Utf8.size float)
                in cerr row (col - width) (E.PFloat width),
       do
-        str <- String.string E.PStart E.PString
+        (str, _) <- String.string E.PStart E.PString
         addEnd start (Src.PStr str),
       do
         chr <- String.character E.PStart E.PChar

compiler/src/Parse/String.hs

@@ -75,7 +75,7 @@ chompChar pos end row col numChars mostRecent =
 
 -- STRINGS
 
-string :: (Row -> Col -> x) -> (E.String -> Row -> Col -> x) -> Parser x ES.String
+string :: (Row -> Col -> x) -> (E.String -> Row -> Col -> x) -> Parser x (ES.String, ES.StringFormat)
 string toExpectation toError =
   P.Parser $ \(P.State src pos end indent row col) cok _ cerr eerr ->
     if isDoubleQuote pos end
@@ -89,12 +89,12 @@ string toExpectation toError =
                         let !pos3 = plusPtr pos 3
                             !col3 = col + 3
                          in multiString pos3 end row col3 pos3 row col
-                      else Ok pos2 row (col + 2) Utf8.empty
+                      else Ok pos2 row (col + 2) ES.SingleLineString Utf8.empty
               else singleString pos1 end row (col + 1) pos1 mempty of
-              Ok newPos newRow newCol utf8 ->
+              Ok newPos newRow newCol stringFormat utf8 ->
                 let !newState =
                       P.State src newPos end indent newRow newCol
-                 in cok utf8 newState
+                 in cok (utf8, stringFormat) newState
               Err r c x ->
                 cerr r c (toError x)
       else eerr row col toExpectation
@@ -104,7 +104,7 @@ isDoubleQuote pos end =
   pos < end && P.unsafeIndex pos == 0x22 {- " -}
 
 data StringResult
-  = Ok (Ptr Word8) Row Col !ES.String
+  = Ok (Ptr Word8) Row Col ES.StringFormat !ES.String
   | Err Row Col E.String
 
 finalize :: Ptr Word8 -> Ptr Word8 -> [ES.Chunk] -> ES.String
@@ -139,7 +139,7 @@ singleString pos end row col initialPos revChunks =
       let !word = P.unsafeIndex pos
        in if word == 0x22 {- " -}
             then
-              Ok (plusPtr pos 1) row (col + 1) $
+              Ok (plusPtr pos 1) row (col + 1) ES.SingleLineString $
                 finalize initialPos pos revChunks
             else
               if word == 0x0A {- \n -}
@@ -213,7 +213,7 @@ multiStringBody leadingWhitespace pos end row col initialPos sr sc revChunks =
       let !word = P.unsafeIndex pos
        in if word == 0x22 {- " -} && isDoubleQuote (plusPtr pos 1) end && isDoubleQuote (plusPtr pos 2) end
             then
-              Ok (plusPtr pos 3) row (col + 3) $
+              Ok (plusPtr pos 3) row (col + 3) ES.MultilineString $
                 finalize initialPos pos $
                   dropMultiStringEndingNewline revChunks
             else

tests/Integration/FormatSpec.hs

@@ -347,6 +347,31 @@ spec = do
                                            ]
 
   describe "expressions" $ do
+    describe "string literals" $ do
+      it "formats strings" $
+        assertFormattedExpression
+          ["a"]
+      it "formats multiline strings with trimmed whitespace" $
+        assertFormattedModuleBody
+          [ "str =",
+            "    \"\"\"",
+            "    # String",
+            "      - indented more",
+            "    \"\"\""
+          ]
+      it "formats multiline strings" $
+        [ "str = \"\"\"",
+          "  1",
+          "    2",
+          "\"\"\""
+        ]
+          `shouldFormatModuleBodyAs` [ "str =",
+                                       "    \"\"\"",
+                                       "    1",
+                                       "      2",
+                                       "    \"\"\""
+                                     ]
+
     describe "int literals" $ do
       it "formats decimal integers" $
         ["234"] `shouldFormatExpressionAs` ["234"]