39592b2 · ormolu · git.iko.soy

git.iko.soy/ormolu

Implement correct handling of shebangs

Also: rename and document some functions we took from ‘ghc-exact-print’.

commit39592b2e881e367e3bdf030c4bd03a797929e679 authormrkkrp <mark.karpov@tweag.io> dateThu 21 Nov 2019, 17:35 (7 years ago) parent524f876

10 files changed+78−27

compare with master

unifiedsplit

CHANGELOG.md+3 data/examples/module-header/shebang-out.hs+1 data/examples/module-header/shebang-with-pragmas-out.hs+5 data/examples/module-header/shebang-with-pragmas.hs+5 data/examples/module-header/shebang.hs+1 src/Ormolu/Parser.hs+33−13 src/Ormolu/Parser/CommentStream.hs+10−10 src/Ormolu/Parser/Result.hs+3−1 src/Ormolu/Printer.hs+1−1 src/Ormolu/Printer/Meat/Module.hs+16−2

CHANGELOG.md+3

@@ -32,6 +32,9 @@

3232 [440](https://github.com/tweag/ormolu/issues/440) and

3333 [448](https://github.com/tweag/ormolu/issues/448).

3434

35+* Implemented correct handling of shebangs. [Issue

36+ 377](https://github.com/tweag/ormolu/issues/377).

37+

3538## Ormolu 0.0.1.0

3639

3740* Initial release.

data/examples/module-header/shebang-out.hs+1

@@ -1,4 +1,5 @@

11#! /usr/bin/env runhaskell

23import Prelude

45main :: IO ()

data/examples/module-header/shebang-with-pragmas-out.hsnew file+5

@@ -0,0 +1,5 @@

1+#!/usr/bin/env stack

3+{-# LANGUAGE OverloadedStrings #-}

5+main = pure ()

data/examples/module-header/shebang-with-pragmas.hsnew file+5

@@ -0,0 +1,5 @@

1+#!/usr/bin/env stack

3+{-# LANGUAGE OverloadedStrings #-}

5+main = pure ()

data/examples/module-header/shebang.hs+1

@@ -1,4 +1,5 @@

11#! /usr/bin/env runhaskell

23import Prelude

45main :: IO ()

src/Ormolu/Parser.hs+33−13

@@ -49,7 +49,7 @@ parseModule ::

4949 Either (SrcSpan, String) ParseResult

5050 )

5151parseModule Config {..} path input' = liftIO $ do

52− let (input, extraComments) = stripLinePragmas path input'

52+ let (input, extraComments) = extractCommentsFromLines path input'

5353 -- NOTE It's important that 'setDefaultExts' is done before

5454 -- 'parsePragmasIntoDynFlags', because otherwise we might enable an

5555 -- extension that was explicitly disabled in the file.

@@ -73,12 +73,13 @@ parseModule Config {..} path input' = liftIO $ do

7373 GHC.PFailed _ ss m ->

7474 Left (ss, GHC.showSDoc dynFlags m)

7575 GHC.POk pstate pmod ->

76− let (comments, exts) = mkCommentStream extraComments pstate

76+ let (comments, exts, shebangs) = mkCommentStream extraComments pstate

7777 in Right ParseResult

7878 { prParsedSource = pmod,

7979 prAnns = mkAnns pstate,

8080 prCommentStream = comments,

81− prExtensions = exts

81+ prExtensions = exts,

82+ prShebangs = shebangs

8283 }

8384 return (warnings, r)

8485

@@ -127,18 +128,31 @@ runParser parser flags filename input = GHC.unP parser parseState

127128 buffer = GHC.stringToStringBuffer input

128129 parseState = GHC.mkPState flags buffer location

129130

130−-- | Remove GHC style line pragams (@{-# LINE .. #-}@) and convert them into

131−-- comments.

132−stripLinePragmas :: FilePath -> String -> (String, [Located String])

133−stripLinePragmas path = unlines' . unzip . findLines path . lines

131+-- | Transform given lines possibly returning comments extracted from them.

132+-- This handles LINE pragmas and shebangs.

133+extractCommentsFromLines ::

134+ -- | File name, just to use in the spans

135+ FilePath ->

136+ -- | List of lines from that file

137+ String ->

138+ -- | Adjusted lines together with comments extracted from them

139+ (String, [Located String])

140+extractCommentsFromLines path =

141+ unlines' . unzip . zipWith (extractCommentFromLine path) [1 ..] . lines

134142 where

135143 unlines' (a, b) = (unlines a, catMaybes b)

136144

137−findLines :: FilePath -> [String] -> [(String, Maybe (Located String))]

138−findLines path = zipWith (checkLine path) [1 ..]

139−

140−checkLine :: FilePath -> Int -> String -> (String, Maybe (Located String))

141−checkLine path line s

145+-- | Transform a given line possibly returning a comment extracted from it.

146+extractCommentFromLine ::

147+ -- | File name, just to use in the spans

148+ FilePath ->

149+ -- | Line number of this line

150+ Int ->

151+ -- | The actual line

152+ String ->

153+ -- | Adjusted line and possibly a comment extracted from it

154+ (String, Maybe (Located String))

155+extractCommentFromLine path line s

142156 | "{-# LINE" `isPrefixOf` s =

143157 let (pragma, res) = getPragma s

144158 size = length pragma

@@ -151,7 +165,13 @@ checkLine path line s

151165 where

152166 mkSrcLoc' = mkSrcLoc (GHC.mkFastString path) line

153167

154−getPragma :: String -> (String, String)

168+-- | Take a line pragma and output its replacement (where line pragma is

169+-- replaced with spaces) and the contents of the pragma itself.

170+getPragma ::

171+ -- | Pragma line to analyze

172+ String ->

173+ -- | Contents of the pragma and its replacement line

174+ (String, String)

155175getPragma [] = error "Ormolu.Parser.getPragma: input must not be empty"

156176getPragma s@(x : xs)

157177 | "#-}" `isPrefixOf` s = ("#-}", " " ++ drop 3 s)

src/Ormolu/Parser/CommentStream.hs+10−10

@@ -36,33 +36,33 @@ newtype CommentStream = CommentStream [RealLocated Comment]

3636newtype Comment = Comment (NonEmpty String)

3737 deriving (Eq, Show, Data)

3838

39−-- | Create 'CommentStream' from 'GHC.PState'. We also create a 'Set' of

40−-- extensions here, which is not sorted in any way. The pragma comment are

41−-- removed from the 'CommentStream'.

39+-- | Create 'CommentStream' from 'GHC.PState'. The pragmas and shebangs are

40+-- removed from the 'CommentStream'. Shebangs are only extracted from the

41+-- comments that come from the first argument.

4242mkCommentStream ::

4343 -- | Extra comments to include

4444 [Located String] ->

4545 -- | Parser state to use for comment extraction

4646 GHC.PState ->

47− -- | Comment stream and a set of extracted pragmas

48− (CommentStream, [Pragma])

47+ -- | Comment stream, a set of extracted pragmas, and extracted shebangs

48+ (CommentStream, [Pragma], [Located String])

4949mkCommentStream extraComments pstate =

5050 ( CommentStream $

51− -- NOTE It's easier to normalize pragmas right when we construct comment

52− -- streams. Because this way we need to do it only once and when we

53− -- perform checking later they'll automatically match.

5451 mkComment <$> sortOn (realSrcSpanStart . getRealSrcSpan) comments,

55− pragmas

52+ pragmas,

53+ shebangs

5654 )

5755 where

5856 (comments, pragmas) = partitionEithers (partitionComments <$> rawComments)

5957 rawComments =

6058 mapMaybe toRealSpan $

61− extraComments

59+ otherExtraComments

6260 ++ mapMaybe (liftMaybe . fmap unAnnotationComment) (GHC.comment_q pstate)

6361 ++ concatMap

6462 (mapMaybe (liftMaybe . fmap unAnnotationComment) . snd)

6563 (GHC.annotations_comments pstate)

64+ (shebangs, otherExtraComments) = span isShebang extraComments

65+ isShebang (L _ str) = "#!" `isPrefixOf` str

6666

6767-- | Test whether a 'Comment' looks like a Haddock following a definition,

6868-- i.e. something starting with @-- ^@.

src/Ormolu/Parser/Result.hs+3−1

@@ -22,7 +22,9 @@ data ParseResult

2222 -- | Comment stream

2323 prCommentStream :: CommentStream,

2424 -- | Extensions enabled in that module

25− prExtensions :: [Pragma]

25+ prExtensions :: [Pragma],

26+ -- | Shebangs found in the input

27+ prShebangs :: [Located String]

2628 }

2729

2830-- | Pretty-print a 'ParseResult'.

src/Ormolu/Printer.hs+1−1

@@ -20,7 +20,7 @@ printModule ::

2020 Text

2121printModule ParseResult {..} =

2222 runR

23− (p_hsModule prExtensions prParsedSource)

23+ (p_hsModule prShebangs prExtensions prParsedSource)

2424 (mkSpanStream prParsedSource)

2525 prCommentStream

2626 prAnns

src/Ormolu/Printer/Meat/Module.hs+16−2

@@ -8,6 +8,7 @@ module Ormolu.Printer.Meat.Module

88where

1010import Control.Monad

11+import qualified Data.Text as T

1112import GHC

1213import Ormolu.Imports

1314import Ormolu.Parser.Pragma

@@ -19,8 +20,16 @@ import Ormolu.Printer.Meat.Declaration.Warning

1920import Ormolu.Printer.Meat.ImportExport

2021import Ormolu.Printer.Meat.Pragma

2122

22−p_hsModule :: [Pragma] -> ParsedSource -> R ()

23−p_hsModule pragmas (L moduleSpan HsModule {..}) = do

23+-- | Render a module.

24+p_hsModule ::

25+ -- | Shebangs

26+ [Located String] ->

27+ -- | Pragmas

28+ [Pragma] ->

29+ -- | AST to print

30+ ParsedSource ->

31+ R ()

32+p_hsModule shebangs pragmas (L moduleSpan HsModule {..}) = do

2433 -- NOTE If span of exports in multiline, the whole thing is multiline.

2534 -- This is especially important because span of module itself always seems

2635 -- to have length zero, so it's not reliable for layout selection.

@@ -28,6 +37,11 @@ p_hsModule pragmas (L moduleSpan HsModule {..}) = do

2837 deprecSpan = maybe [] (\(L s _) -> [s]) hsmodDeprecMessage

2938 spans' = exportSpans ++ deprecSpan ++ [moduleSpan]

3039 switchLayout spans' $ do

40+ forM_ shebangs $ \x ->

41+ located x $ \shebang -> do

42+ txt (T.pack shebang)

43+ newline

44+ newline

3145 p_pragmas pragmas

3246 newline

3347 case hsmodName of