6e07126 · ormolu · git.iko.soy

git.iko.soy/ormolu

Handle stack headers correctly

More about the feature: https://docs.haskellstack.org/en/stable/GUIDE/#script-interpreter

commit6e07126acae9ad7a82d80cf429ea535cdee840ad authormrkkrp <mark.karpov@tweag.io> dateThu 28 Nov 2019, 11:21 (7 years ago) parent39592b2

11 files changed+71−3

compare with master

unifiedsplit

CHANGELOG.md+3 data/examples/module-header/stack-header-0-out.hs+6 data/examples/module-header/stack-header-0.hs+4 data/examples/module-header/stack-header-1-out.hs+7 data/examples/module-header/stack-header-1.hs+5 data/examples/module-header/stack-header-2-out.hs+12 data/examples/module-header/stack-header-2.hs+12 src/Ormolu/Parser.hs+1−1 src/Ormolu/Parser/CommentStream.hs+6−2 src/Ormolu/Printer/Comments.hs+14 src/Ormolu/Printer/Meat/Module.hs+1

CHANGELOG.md+3

@@ -35,6 +35,9 @@

3535* Implemented correct handling of shebangs. [Issue

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

3737

38+* Implemented correct handling of stack headers. [Issue

39+ 393](https://github.com/tweag/ormolu/issues/393).

40+

3841## Ormolu 0.0.1.0

3942

4043* Initial release.

data/examples/module-header/stack-header-0-out.hsnew file+6

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

1+-- stack runhaskell

3+{-# LANGUAGE OverloadedStrings #-}

5+main = return ()

6+-- stack runhaskell

data/examples/module-header/stack-header-0.hsnew file+4

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

1+-- stack runhaskell

2+{-# LANGUAGE OverloadedStrings #-}

3+main = return ()

4+-- stack runhaskell

data/examples/module-header/stack-header-1-out.hsnew file+7

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

1+#!/usr/bin/env stack

2+-- stack runhaskell

4+{-# LANGUAGE OverloadedStrings #-}

6+main = return ()

7+-- stack runhaskell

data/examples/module-header/stack-header-1.hsnew file+5

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

1+#!/usr/bin/env stack

2+-- stack runhaskell

3+{-# LANGUAGE OverloadedStrings #-}

4+main = return ()

5+-- stack runhaskell

data/examples/module-header/stack-header-2-out.hsnew file+12

@@ -0,0 +1,12 @@

1+#!/usr/bin/env stack

2+{- stack

3+ script

4+ --resolver lts-6.25

5+ --package turtle

6+ --package "stm async"

7+ --package http-client,http-conduit

8+-}

10+{-# LANGUAGE OverloadedStrings #-}

11+

12+main = return ()

data/examples/module-header/stack-header-2.hsnew file+12

@@ -0,0 +1,12 @@

1+#!/usr/bin/env stack

2+{- stack

3+ script

4+ --resolver lts-6.25

5+ --package turtle

6+ --package "stm async"

7+ --package http-client,http-conduit

8+-}

10+{-# LANGUAGE OverloadedStrings #-}

11+

12+main = return ()

src/Ormolu/Parser.hs+1−1

@@ -158,7 +158,7 @@ extractCommentFromLine path line s

158158 size = length pragma

159159 ss = mkSrcSpan (mkSrcLoc' 1) (mkSrcLoc' (size + 1))

160160 in (res, Just $ L ss pragma)

161− | "#!" `isPrefixOf` s =

161+ | isShebang s =

162162 let ss = mkSrcSpan (mkSrcLoc' 1) (mkSrcLoc' (length s))

163163 in ("", Just $ L ss s)

164164 | otherwise = (s, Nothing)

src/Ormolu/Parser/CommentStream.hs+6−2

@@ -7,6 +7,7 @@ module Ormolu.Parser.CommentStream

77 ( CommentStream (..),

88 Comment (..),

99 mkCommentStream,

10+ isShebang,

1011 isPrevHaddock,

1112 isMultilineComment,

1213 showCommentStream,

@@ -61,8 +62,11 @@ mkCommentStream extraComments pstate =

6162 ++ concatMap

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

6364 (GHC.annotations_comments pstate)

64− (shebangs, otherExtraComments) = span isShebang extraComments

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

65+ (shebangs, otherExtraComments) = span (isShebang . unLoc) extraComments

66+

67+-- | Return 'True' if given 'String' is a shebang.

68+isShebang :: String -> Bool

69+isShebang str = "#!" `isPrefixOf` str

6670

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

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

src/Ormolu/Printer/Comments.hs+14

@@ -6,13 +6,17 @@ module Ormolu.Printer.Comments

66 ( spitPrecedingComments,

77 spitFollowingComments,

88 spitRemainingComments,

9+ spitStackHeader,

910 )

1011where

1112

1213import Control.Monad

14+import Data.Char (isSpace)

1315import Data.Coerce (coerce)

1416import Data.Data (Data)

17+import Data.List (isPrefixOf)

1518import qualified Data.List.NonEmpty as NE

19+import Data.List.NonEmpty (NonEmpty (..))

1620import qualified Data.Text as T

1721import Ormolu.Parser.CommentStream

1822import Ormolu.Printer.Internal

@@ -50,6 +54,16 @@ spitFollowingComments ref = do

5054spitRemainingComments :: R ()

5155spitRemainingComments = void $ handleCommentSeries spitRemainingComment

5256

57+-- | If there is a stack header in the comment stream, print it.

58+spitStackHeader :: R ()

59+spitStackHeader = do

60+ let isStackHeader (Comment (x :| _)) =

61+ "stack" `isPrefixOf` dropWhile isSpace (drop 2 x)

62+ mstackHeader <- popComment (isStackHeader . unRealSrcSpan)

63+ forM_ mstackHeader $ \(L spn x) -> do

64+ spitCommentNow spn x

65+ newline

66+

5367----------------------------------------------------------------------------

5468-- Single-comment functions

5569

src/Ormolu/Printer/Meat/Module.hs+1

@@ -41,6 +41,7 @@ p_hsModule shebangs pragmas (L moduleSpan HsModule {..}) = do

4141 located x $ \shebang -> do

4242 txt (T.pack shebang)

4343 newline

44+ spitStackHeader

4445 newline

4546 p_pragmas pragmas

4647 newline