b6c29bd · ormolu · git.iko.soy

data/examples/other/language-pragma-no-header-out.hs → data/examples/other/pragma-no-header-out.hsrenamed

compare with master

unifiedsplit

The content is the same.

data/examples/other/language-pragma-no-header.hs → data/examples/other/pragma-no-header.hsrenamed

The content is the same.

data/examples/other/language-pragma-out.hs → data/examples/other/pragma-out.hsrenamed+3

@@ -4,6 +4,9 @@

4{-# LANGUAGE LambdaCase #-}

5{-# LANGUAGE OverloadedStrings #-}

6{-# LANGUAGE ViewPatterns #-}

7+{-# OPTIONS_GHC -O2 -H 300 #-}

8+{-# OPTIONS_GHC -Wall -Werror #-}

9+{-# OPTIONS_HADDOCK prune, show-extensions #-}

7

10

8-- | Header comment.

11-- | Header comment.

9module Foo

12module Foo

data/examples/other/language-pragma.hs → data/examples/other/pragma.hsrenamed+3

@@ -3,7 +3,10 @@

3{-# LANGUAGE LambdaCase #-}

4{-#LANGuagE ViewPatterns #-}

5{-# LANGUAGE OverloadedStrings#-}

6+{-# OPTIONS_GHC -Wall -Werror #-}

6{-# language DataKinds, LambdaCase #-}

7{-# language DataKinds, LambdaCase #-}

8+{-# OPTIONS_HADDOCK prune, show-extensions #-}

9+{-# OPTIONS_GHC -O2 -H 300 #-}

7{-# language IncoherentInstances

10{-# language IncoherentInstances

8 , AllowAmbiguousTypes #-}

11 , AllowAmbiguousTypes #-}

9

12

ormolu.cabal+3−3

@@ -56,7 +56,7 @@ library

56 , Ormolu.Parser

57 , Ormolu.Parser.Anns

58 , Ormolu.Parser.CommentStream

59− , Ormolu.Parser.LanguagePragma

59+ , Ormolu.Parser.Pragma

60 , Ormolu.Parser.Result

61 , Ormolu.Printer

62 , Ormolu.Printer.Combinators

@@ -79,7 +79,7 @@ library

79 , Ormolu.Printer.Meat.Declaration.Value

80 , Ormolu.Printer.Meat.Declaration.Warning

81 , Ormolu.Printer.Meat.ImportExport

82− , Ormolu.Printer.Meat.LanguagePragma

82+ , Ormolu.Printer.Meat.Pragma

83 , Ormolu.Printer.Meat.Module

84 , Ormolu.Printer.Meat.Type

85 , Ormolu.Printer.SpanStream

@@ -109,7 +109,7 @@ test-suite tests

109 build-tools: hspec-discover >= 2.0 && < 3.0

110 other-modules:

111 Ormolu.Printer.CombinatorsSpec

112− , Ormolu.Parser.LanguagePragmaSpec

112+ , Ormolu.Parser.PragmaSpec

113 , Ormolu.PrinterSpec

114

115 if flag(dev)

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

@@ -21,12 +21,10 @@ import Data.Either (partitionEithers)

21import Data.List (isPrefixOf, sortOn, dropWhileEnd)

22import Data.List.NonEmpty (NonEmpty (..))

23import Data.Maybe (mapMaybe)

24−import Data.Set (Set)

25−import Ormolu.Parser.LanguagePragma

24+import Ormolu.Parser.Pragma

26import Ormolu.Utils (showOutputable)

25import Ormolu.Utils (showOutputable)

27import SrcLoc

26import SrcLoc

28import qualified Data.List.NonEmpty as NE

27import qualified Data.List.NonEmpty as NE

29−import qualified Data.Set as S

30import qualified GHC

28import qualified GHC

31import qualified Lexer as GHC

29import qualified Lexer as GHC

32

30

@@ -49,7 +47,7 @@ newtype Comment = Comment (NonEmpty String)

49mkCommentStream

47mkCommentStream

50 :: [Located String] -- ^ Extra comments to include

48 :: [Located String] -- ^ Extra comments to include

51 -> GHC.PState -- ^ Parser state to use for comment extraction

49 -> GHC.PState -- ^ Parser state to use for comment extraction

52− -> (CommentStream, Set String)

50+ -> (CommentStream, [Pragma])

53 -- ^ Comment stream and a set of extensions enabled

51 -- ^ Comment stream and a set of extensions enabled

54mkCommentStream extraComments pstate =

52mkCommentStream extraComments pstate =

55 ( CommentStream $

53 ( CommentStream $

@@ -57,10 +55,10 @@ mkCommentStream extraComments pstate =

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

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

58 -- perform checking later they'll automatically match.

56 -- perform checking later they'll automatically match.

59 mkComment <$> sortOn (realSrcSpanStart . getLoc) comments

57 mkComment <$> sortOn (realSrcSpanStart . getLoc) comments

60− , S.unions exts

58+ , pragma

61 )

59 )

62 where

60 where

63− (comments, exts) = partitionEithers (partitionComments <$> rawComments)

61+ (comments, pragma) = partitionEithers (partitionComments <$> rawComments)

64 rawComments = mapMaybe toRealSpan $

62 rawComments = mapMaybe toRealSpan $

65 extraComments ++

63 extraComments ++

66 (fmap unAnnotationComment <$> GHC.comment_q pstate) ++

64 (fmap unAnnotationComment <$> GHC.comment_q pstate) ++

@@ -121,13 +119,13 @@ toRealSpan :: Located a -> Maybe (RealLocated a)

121toRealSpan (L (RealSrcSpan l) a) = Just (L l a)

119toRealSpan (L (RealSrcSpan l) a) = Just (L l a)

122toRealSpan _ = Nothing

120toRealSpan _ = Nothing

123

121

124−-- | If a given comment is a LANGUAGE pragma, return the set of extensions

122+-- | If a given comment is a pragma, return the set of extensions

125-- it enables in 'Right'. Otherwise return the original comment unchanged.

123-- it enables in 'Right'. Otherwise return the original comment unchanged.

126

124

127partitionComments

125partitionComments

128 :: RealLocated String

126 :: RealLocated String

129− -> Either (RealLocated String) (Set String)

127+ -> Either (RealLocated String) Pragma

130partitionComments input =

128partitionComments input =

131− case parseLanguagePragma (unLoc input) of

129+ case parsePragma (unLoc input) of

132 Nothing -> Left input

130 Nothing -> Left input

133− Just exts -> Right exts

131+ Just pr -> Right pr

src/Ormolu/Parser/LanguagePragma.hsdeleted−86

@@ -1,86 +0,0 @@

1−-- | A module for parsing of language pragmas from comments.

2−

3−{-# LANGUAGE LambdaCase #-}

4−{-# LANGUAGE OverloadedStrings #-}

5−

6−module Ormolu.Parser.LanguagePragma

7− ( parseLanguagePragma

8− )

9−where

10−

11−import Control.Monad

12−import Data.Char (toLower)

13−import Data.List (stripPrefix, isSuffixOf)

14−import Data.Set (Set)

15−import FastString (mkFastString, unpackFS)

16−import Module (newSimpleUnitId, ComponentId (..))

17−import SrcLoc

18−import StringBuffer

19−import qualified Data.Set as S

20−import qualified EnumSet as ES

21−import qualified Lexer as L

22−

23−-- | Extract a 'Set' of language extensions from a comment if it's a

24−-- language pragma or return 'Nothing' otherwise.

25−

26−parseLanguagePragma

27− :: String -- ^ Comment to try to parse

28− -> Maybe (Set String)

29−parseLanguagePragma input = do

30− inputNoPrefix <- stripPrefix "{-#" input

31− guard ("#-}" `isSuffixOf` input)

32− let contents = take (length inputNoPrefix - 3) inputNoPrefix

33− toks0 <- tokenize contents

34− toks1 <- dropLanguage toks0

35− S.fromList <$> parseExtensions toks1

36−

37−-- | Assuming the input consists of a series of tokens from a language

38−-- pragma, return the set of enabled extensions.

39−

40−parseExtensions :: [L.Token] -> Maybe [String]

41−parseExtensions = \case

42− (L.ITconid ext : []) -> return [unpackFS ext]

43− (L.ITconid ext : L.ITcomma : xs) -> (unpackFS ext :) <$> parseExtensions xs

44− _ -> Nothing

45−

46−-- | Drop LANGUAGE pragma text from the token stream.

47−

48−dropLanguage :: [L.Token] -> Maybe [L.Token]

49−dropLanguage = \case

50− (L.ITconid lang : xs) -> go lang xs

51− (L.ITvarid lang : xs) -> go lang xs

52− _ -> Nothing

53− where

54− go lang xs =

55− if (toLower <$> unpackFS lang) == "language"

56− then Just xs

57− else Nothing

58−

59−-- | Tokenize a given input using GHC's lexer.

60−

61−tokenize :: String -> Maybe [L.Token]

62−tokenize input =

63− case L.unP pLexer parseState of

64− L.PFailed {} -> Nothing

65− L.POk _ x -> Just x

66− where

67− location = mkRealSrcLoc (mkFastString "") 1 1

68− buffer = stringToStringBuffer input

69− parseState = L.mkPStatePure parserFlags buffer location

70− parserFlags = L.ParserFlags

71− { L.pWarningFlags = ES.empty

72− , L.pExtensionFlags = ES.empty

73− , L.pThisPackage = newSimpleUnitId (ComponentId (mkFastString ""))

74− , L.pExtsBitmap = 0xffffffffffffffff

75− }

76−

77−-- | Haskell lexer.

78−

79−pLexer :: L.P [L.Token]

80−pLexer = go

81− where

82− go = do

83− r <- L.lexer False return

84− case unLoc r of

85− L.ITeof -> return []

86− x -> (x:) <$> go

src/Ormolu/Parser/Pragma.hsnew file+91

@@ -0,0 +1,91 @@

1+-- | A module for parsing of language pragmas from comments.

2+

3+{-# LANGUAGE LambdaCase #-}

4+{-# LANGUAGE OverloadedStrings #-}

5+

6+module Ormolu.Parser.Pragma

7+ ( Pragma (..)

8+ , parsePragma

9+ )

10+where

11+

12+import Data.Char (toLower, isSpace)

13+import Data.List (stripPrefix, dropWhileEnd)

14+import FastString (mkFastString, unpackFS)

15+import Module (newSimpleUnitId, ComponentId (..))

16+import SrcLoc

17+import StringBuffer

18+import qualified EnumSet as ES

19+import qualified Lexer as L

20+

21+data Pragma

22+ = PragmaLanguage [String]

23+ | PragmaOptionsGHC String

24+ | PragmaOptionsHaddock String

25+ deriving (Show, Eq)

26+

27+-- | Extract a Pragma from a comment if possible, or return 'Nothing'

28+-- otherwise.

29+

30+parsePragma :: String -> Maybe Pragma

31+parsePragma input = do

32+ contents <- trimSpaces <$> stripEnclosing "{-#" "#-}" input

33+ let (name, cs) = separateName contents

34+ case map toLower name of

35+ "language" -> PragmaLanguage <$> parseExtensions cs

36+ "options_ghc" -> Just $ PragmaOptionsGHC (trimSpaces cs)

37+ "options_haddock" -> Just $ PragmaOptionsHaddock (trimSpaces cs)

38+ _ -> Nothing

39+ where

40+ -- stripEnclosing pre suf (pre ++ str ++ suf) == Just str

41+ stripEnclosing :: String -> String -> String -> Maybe String

42+ stripEnclosing pre suf str =

43+ fmap reverse $ stripPrefix pre str >>= stripPrefix (reverse suf) . reverse

44+

45+ trimSpaces :: String -> String

46+ trimSpaces = dropWhileEnd isSpace . dropWhile isSpace

47+

48+-- | Assuming the input consists of a series of tokens from a language

49+-- pragma, return the set of enabled extensions.

50+

51+parseExtensions :: String -> Maybe [String]

52+parseExtensions str = tokenize str >>= go

53+ where

54+ go = \case

55+ (L.ITconid ext : []) -> return [unpackFS ext]

56+ (L.ITconid ext : L.ITcomma : xs) -> (unpackFS ext :) <$> go xs

57+ _ -> Nothing

58+

59+-- | Split a pragma to name and contents

60+

61+separateName :: String -> (String, String)

62+separateName = span (not . isSpace) . dropWhile isSpace

63+

64+-- | Tokenize a given input using GHC's lexer.

65+

66+tokenize :: String -> Maybe [L.Token]

67+tokenize input =

68+ case L.unP pLexer parseState of

69+ L.PFailed {} -> Nothing

70+ L.POk _ x -> Just x

71+ where

72+ location = mkRealSrcLoc (mkFastString "") 1 1

73+ buffer = stringToStringBuffer input

74+ parseState = L.mkPStatePure parserFlags buffer location

75+ parserFlags = L.ParserFlags

76+ { L.pWarningFlags = ES.empty

77+ , L.pExtensionFlags = ES.empty

78+ , L.pThisPackage = newSimpleUnitId (ComponentId (mkFastString ""))

79+ , L.pExtsBitmap = 0xffffffffffffffff

80+ }

81+

82+-- | Haskell lexer.

83+

84+pLexer :: L.P [L.Token]

85+pLexer = go

86+ where

87+ go = do

88+ r <- L.lexer False return

89+ case unLoc r of

90+ L.ITeof -> return []

91+ x -> (x:) <$> go

src/Ormolu/Parser/Result.hs+2−2

@@ -8,10 +8,10 @@ module Ormolu.Parser.Result

8 )

9where

10

11−import Data.Set (Set)

12import GHC

11import GHC

13import Ormolu.Parser.Anns

12import Ormolu.Parser.Anns

14import Ormolu.Parser.CommentStream

13import Ormolu.Parser.CommentStream

14+import Ormolu.Parser.Pragma (Pragma)

15

16-- | A collection of data that represents a parsed module in Ormolu.

17

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

22 -- ^ Ormolu-specfic representation of annotations

23 , prCommentStream :: CommentStream

24 -- ^ Comment stream

25− , prExtensions :: Set String

25+ , prExtensions :: [Pragma]

26 -- ^ Extensions enabled in that module

27 }

28

src/Ormolu/Printer/Meat/LanguagePragma.hsdeleted−23

@@ -1,23 +0,0 @@

1−-- | Pretty-printing of language pragmas.

2−

3−{-# LANGUAGE LambdaCase #-}

4−{-# LANGUAGE OverloadedStrings #-}

5−

6−module Ormolu.Printer.Meat.LanguagePragma

7− ( p_langPragmas

8− )

9−where

10−

11−import Data.Set (Set)

12−import Ormolu.Printer.Combinators

13−import qualified Data.Set as S

14−import qualified Data.Text as T

15−

16−p_langPragmas :: Set String -> R ()

17−p_langPragmas = mapM_ p_langPragma . S.toAscList

18−

19−p_langPragma :: String -> R ()

20−p_langPragma ext = line $ do

21− txt "{-# LANGUAGE "

22− txt (T.pack ext)

23− txt " #-}"

src/Ormolu/Printer/Meat/Module.hs+7−6

@@ -1,3 +1,4 @@

1+{-# LANGUAGE LambdaCase #-}

1{-# LANGUAGE OverloadedStrings #-}

2{-# LANGUAGE OverloadedStrings #-}

2{-# LANGUAGE RecordWildCards #-}

3{-# LANGUAGE RecordWildCards #-}

3

4

@@ -10,9 +11,9 @@ where

10

11

11import Control.Monad

12import Control.Monad

12import Data.Maybe (isJust)

13import Data.Maybe (isJust)

13−import Data.Set (Set)

14import GHC

15import Ormolu.Imports

16+import Ormolu.Parser.Pragma

16import Ormolu.Printer.Combinators

17import Ormolu.Printer.Combinators

17import Ormolu.Printer.Comments

18import Ormolu.Printer.Comments

18import Ormolu.Printer.Internal (isNewlineModified)

19import Ormolu.Printer.Internal (isNewlineModified)

@@ -20,10 +21,10 @@ import Ormolu.Printer.Meat.Common

20import Ormolu.Printer.Meat.Declaration

21import Ormolu.Printer.Meat.Declaration

21import Ormolu.Printer.Meat.Declaration.Warning

22import Ormolu.Printer.Meat.Declaration.Warning

22import Ormolu.Printer.Meat.ImportExport

23import Ormolu.Printer.Meat.ImportExport

23−import Ormolu.Printer.Meat.LanguagePragma

24+import Ormolu.Printer.Meat.Pragma

24

25

25−p_hsModule :: Set String -> ParsedSource -> R ()

26+p_hsModule :: [Pragma] -> ParsedSource -> R ()

26−p_hsModule exts (L moduleSpan HsModule {..}) = do

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

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

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

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

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

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

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

@@ -31,11 +32,11 @@ p_hsModule exts (L moduleSpan HsModule {..}) = do

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

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

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

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

33 switchLayout spans' $ do

34 switchLayout spans' $ do

34− let hasLangPragmas = not (null exts)

35+ let hasLangPragmas = not (null pragmas)

35 hasModuleHeader = isJust hsmodName

36 hasModuleHeader = isJust hsmodName

36 hasImports = not (null hsmodImports)

37 hasImports = not (null hsmodImports)

37 hasDecls = not (null hsmodDecls)

38 hasDecls = not (null hsmodDecls)

38− p_langPragmas exts

39+ p_pragmas pragmas

39 when (hasLangPragmas &&

40 when (hasLangPragmas &&

40 (hasModuleHeader || hasImports || hasDecls)) $

41 (hasModuleHeader || hasImports || hasDecls)) $

41 newline

42 newline

src/Ormolu/Printer/Meat/Pragma.hsnew file+39

@@ -0,0 +1,39 @@

1+-- | Pretty-printing of language pragmas.

2+

3+{-# LANGUAGE LambdaCase #-}

4+{-# LANGUAGE OverloadedStrings #-}

5+{-# LANGUAGE TupleSections #-}

6+

7+module Ormolu.Printer.Meat.Pragma

8+ ( p_pragmas

9+ )

10+where

11+

12+import Ormolu.Printer.Combinators

13+import Ormolu.Parser.Pragma (Pragma (..))

14+import qualified Data.Set as S

15+import qualified Data.Text as T

16+

17+data PragmaTy = Language | OptionsGHC | OptionsHaddock

18+ deriving (Eq, Ord)

19+

20+p_pragmas :: [Pragma] -> R ()

21+p_pragmas ps =

22+ let ps' = concatMap (\case

23+ PragmaLanguage xs -> map (Language,) xs

24+ PragmaOptionsGHC x -> [(OptionsGHC, x)]

25+ PragmaOptionsHaddock x -> [(OptionsHaddock, x)]

26+ ) ps

27+ sorted = S.toAscList . S.fromList $ ps'

28+ in mapM_ (uncurry p_pragma) sorted

29+

30+p_pragma :: PragmaTy -> String -> R ()

31+p_pragma ty c = line $ do

32+ txt "{-# "

33+ txt $ case ty of

34+ Language -> "LANGUAGE"

35+ OptionsGHC -> "OPTIONS_GHC"

36+ OptionsHaddock -> "OPTIONS_HADDOCK"

37+ txt " "

38+ txt (T.pack c)

39+ txt " #-}"

tests/Ormolu/Parser/LanguagePragmaSpec.hsdeleted−25

@@ -1,25 +0,0 @@

1−module Ormolu.Parser.LanguagePragmaSpec (spec) where

2−

3−import Ormolu.Parser.LanguagePragma

4−import Test.Hspec

5−import qualified Data.Set as S

6−

7−spec :: Spec

8−spec = do

9− describe "parseLanguagePragma" $ do

10− stdTest "{-# LANGUAGE Foo #-}" (Just ["Foo"])

11− stdTest "{-# language Foo #-}" (Just ["Foo"])

12− stdTest "{-#LANGUAGE Foo#-}" (Just ["Foo"])

13− stdTest "{-# LANGUAGE Foo#-}" (Just ["Foo"])

14− stdTest "{-#language Foo#-}" (Just ["Foo"])

15− stdTest "{-# lAngUAGe Foo #-}" (Just ["Foo"])

16− stdTest "{-# LANGUAGE Foo, Bar #-}" (Just ["Bar", "Foo"])

17− stdTest "{-# LANGUAGE Foo Bar #-}" Nothing

18− stdTest "{-# BOO Foo #-}" Nothing

19− stdTest "something" Nothing

20− stdTest "{-# LANGUAGE foo, Bar #-}" Nothing

21−

22−stdTest :: String -> Maybe [String] -> Spec

23−stdTest input result = it input $

24− (S.toAscList <$> parseLanguagePragma input) `shouldBe`

25− result

tests/Ormolu/Parser/PragmaSpec.hsnew file+22

@@ -0,0 +1,22 @@

1+module Ormolu.Parser.PragmaSpec (spec) where

2+

3+import Ormolu.Parser.Pragma

4+import Test.Hspec

5+

6+spec :: Spec

7+spec = do

8+ describe "parsePragma" $ do

9+ stdTest "{-# LANGUAGE Foo #-}" (Just $ PragmaLanguage ["Foo"])

10+ stdTest "{-# language Foo #-}" (Just $ PragmaLanguage ["Foo"])

11+ stdTest "{-# lAngUAGe Foo#-}" (Just $ PragmaLanguage ["Foo"])

12+ stdTest "{-# LANGUAGE Foo, Bar #-}" (Just $ PragmaLanguage ["Foo", "Bar"])

13+ stdTest "{-# OPTIONS_GHC foo bar baz #-}" (Just $ PragmaOptionsGHC "foo bar baz")

14+ stdTest "{-#OPTIONS_HADDOCK foo, bar, baz #-}" (Just $ PragmaOptionsHaddock "foo, bar, baz")

15+ stdTest "{-# LANGUAGE Foo Bar #-}" Nothing

16+ stdTest "{-# BOO Foo #-}" Nothing

17+ stdTest "something" Nothing

18+ stdTest "{-# LANGUAGE foo, Bar #-}" Nothing

19+

20+stdTest :: String -> Maybe Pragma -> Spec

21+stdTest input result = it input $

22+ parsePragma input `shouldBe` result