1b818c0 · ormolu · git.iko.soy

git.iko.soy/ormolu

Correct indentation on string gaps

Haskell strings can have "gaps", where any amount of whitespace between two backslashes are ignored. This allows writing multi-line strings. As an example, all strings below are the same: ``` "foobar" "foo\ \bar" "foo\ \bar" ``` When parsing a string literal, lexer usually produces two fields, one of them is the actual string user wrote as a 'SourceText', the other one is the sanitized version where gaps and other special characters removed. While printing the string, GHC's Outputable instance uses the 'SourceText' field, however since that text contains gaps as-is, we can not change the original indentation. In order to fix this, this commit splits the strings by the gaps and print each line separately applying the layout rules. Also, it applies the same logic to type-level strings.

commit1b818c006486ccafbb917b6095ac4e0c096c79b8 authorUtku Demir <me@utdemir.com> dateFri 13 Sep 2019, 15:48 (7 years ago) parentc9c3876

7 files changed+93−3

compare with master

unifiedsplit

data/examples/declaration/type/lits-out.hs+6 data/examples/declaration/type/lits.hs+4 data/examples/declaration/value/function/strings-out.hs+10 data/examples/declaration/value/function/strings.hs+7 src/Ormolu/Printer/Meat/Declaration/Value.hs+57−1 src/Ormolu/Printer/Meat/Declaration/Value.hs-boot+3 src/Ormolu/Printer/Meat/Type.hs+6−2

data/examples/declaration/type/lits-out.hsnew file+6

@@ -0,0 +1,6 @@

1+type A = "foo"

3+type B

4+ = "foo\

5+ \bar"

6+ -> ()

data/examples/declaration/type/lits.hsnew file+4

@@ -0,0 +1,4 @@

1+type A = "foo"

3+type B = "foo\

4+ \bar" -> ()

data/examples/declaration/value/function/strings-out.hsnew file+10

@@ -0,0 +1,10 @@

1+{-# LANGUAGE MagicHash #-}

3+foo = "foobar"

5+bar = "foo\&barbaz"

7+baz =

8+ "foo\

9+ \bar\

10+ \baz"

data/examples/declaration/value/function/strings.hsnew file+7

@@ -0,0 +1,7 @@

1+{-# LANGUAGE MagicHash #-}

3+foo = "foobar"

4+bar = "foo\&bar\ \baz"

5+baz = "foo\

6+ \bar\

7+ \baz"

src/Ormolu/Printer/Meat/Declaration/Value.hs+57−1

@@ -7,18 +7,21 @@ module Ormolu.Printer.Meat.Declaration.Value

77 , p_pat

88 , p_hsExpr

99 , p_hsSplice

10+ , p_stringLit

1011 )

1112where

1213

1314import Bag (bagToList)

1415import BasicTypes

1516import Control.Monad

17+import Ctype (is_space)

1618import Data.Bool (bool)

1719import Data.Char (isPunctuation, isSymbol)

1820import Data.Data hiding (Infix, Prefix)

1921import Data.List (intersperse, sortOn)

2022import Data.List.NonEmpty (NonEmpty ((:|)))

2123import Data.Text (Text)

24+import qualified Data.Text as Text

2225import GHC

2326import Ormolu.Printer.Combinators

2427import Ormolu.Printer.Meat.Common

@@ -489,7 +492,11 @@ p_hsExpr = \case

489492 txt "?"

490493 atom name

491494 HsOverLit NoExt v -> atom (ol_val v)

492− HsLit NoExt lit -> atom lit

495+ HsLit NoExt lit ->

496+ case lit of

497+ HsString (SourceText s) _ -> p_stringLit s

498+ HsStringPrim (SourceText s) _ -> p_stringLit s

499+ r -> atom r

493500 HsLam NoExt mgroup ->

494501 p_matchGroup Lambda mgroup

495502 HsLamCase NoExt mgroup -> do

@@ -938,6 +945,55 @@ p_hsBracket = \case

938945 breakpoint'

939946 txt "|]"

940947

948+-- Print the source text of a string literal while indenting

949+-- gaps correctly.

950+

951+p_stringLit :: String -> R ()

952+p_stringLit src =

953+ let s = splitGaps src

954+ singleLine =

955+ txt $ Text.pack (mconcat s)

956+ multiLine =

957+ sitcc $ sep breakpoint (txt . Text.pack) (backslashes s)

958+ in vlayout singleLine multiLine

959+ where

960+ -- Split a string on gaps (backslash delimited whitespaces)

961+ --

962+ -- > splitGaps "bar\\ \\fo\\&o" == ["bar", "fo\\&o"]

963+ splitGaps :: String -> [String]

964+ splitGaps "" = []

965+ splitGaps s =

966+ let -- A backslash and a whitespace starts a "gap"

967+ p (Just '\\', _, _) = True

968+ p (_, '\\', Just c) | ghcSpace c = False

969+ p _ = True

970+ in case span p (zipPrevNext s) of

971+ (l, r) ->

972+ let -- drop the initial '\', any amount of 'ghcSpace', and another '\'

973+ r' = drop 1 . dropWhile ghcSpace . drop 1 $ map orig r

974+ in map orig l : splitGaps r'

975+

976+ -- GHC's definition of whitespaces in strings

977+ -- See: https://gitlab.haskell.org/ghc/ghc/blob/86753475/compiler/parser/Lexer.x#L1653

978+ ghcSpace :: Char -> Bool

979+ ghcSpace c = c <= '\x7f' && is_space c

980+

981+ -- Add backslashes to the inner side of the strings

982+ --

983+ -- > backslashes ["a", "b", "c"] == ["a\\", "\\b\\", "\\c"]

984+ backslashes :: [String] -> [String]

985+ backslashes (x:y:xs) = (x ++ "\\") : backslashes (('\\' : y) : xs)

986+ backslashes xs = xs

987+

988+ -- Attaches previous and next items to each list element

989+ zipPrevNext :: [a] -> [(Maybe a, a, Maybe a)]

990+ zipPrevNext xs =

991+ let z = zip (zip (Nothing : map Just xs) xs)

992+ (map Just (tail xs) ++ repeat Nothing)

993+ in map (\((p, x), n) -> (p, x, n)) z

994+

995+ orig (_, x, _) = x

996+

941997----------------------------------------------------------------------------

942998-- Helpers

943999

src/Ormolu/Printer/Meat/Declaration/Value.hs-boot+3

@@ -3,6 +3,7 @@ module Ormolu.Printer.Meat.Declaration.Value

33 , p_pat

44 , p_hsExpr

55 , p_hsSplice

6+ , p_stringLit

67 )

78where

@@ -16,3 +17,5 @@ p_pat :: Pat GhcPs -> R ()

1617p_hsExpr :: HsExpr GhcPs -> R ()

1718

1819p_hsSplice :: HsSplice GhcPs -> R ()

20+

21+p_stringLit :: String -> R ()

src/Ormolu/Printer/Meat/Type.hs+6−2

@@ -14,11 +14,12 @@ module Ormolu.Printer.Meat.Type

1414where

1515

1616import GHC

17+import BasicTypes

1718import Ormolu.Printer.Combinators

1819import Ormolu.Printer.Meat.Common

1920import Ormolu.Printer.Operators

2021import Ormolu.Utils

21−import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration.Value (p_hsSplice)

22+import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration.Value (p_hsSplice, p_stringLit)

2223

2324p_hsType :: HsType GhcPs -> R ()

2425p_hsType = \case

@@ -131,7 +132,10 @@ p_hsType = \case

131132 ((L _ t):_) | isPromoted t -> space

132133 _ -> return ()

133134 sep (comma >> breakpoint) (located' p_hsType) xs

134− HsTyLit NoExt t -> atom t

135+ HsTyLit NoExt t ->

136+ case t of

137+ HsStrTy (SourceText s) _ -> p_stringLit s

138+ a -> atom a

135139 HsWildCardTy NoExt -> txt "_"

136140 XHsType (NHsCoreTy t) -> atom t

137141 where