ae40a33 · ormolu · git.iko.soy

data/examples/declaration/class/associated-data-out.hs+1

compare with master

unifiedsplit

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

1{-# LANGUAGE TypeFamilies #-}

2+

2class Foo a where

3class Foo a where

3

4

4 data FooBar a

5 data FooBar a

data/examples/declaration/class/associated-type-defaults-out.hs+1

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

1{-# LANGUAGE TypeFamilies #-}

2+

2class Foo a where

3class Foo a where

3

4

4 type FooBar a = Int

5 type FooBar a = Int

data/examples/declaration/class/associated-types-out.hs+1

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

1{-# LANGUAGE TypeFamilies #-}

2+

2class Foo a where

3class Foo a where

3

4

4 type FooBar a

5 type FooBar a

data/examples/declaration/class/multi-parameters-out.hs+1

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

1{-# LANGUAGE MultiParamTypeClasses #-}

2+

2class Foo a b where

3class Foo a b where

3

4

4 foo :: a -> b

5 foo :: a -> b

data/examples/declaration/class/poly-kinded-classes-out.hs+1

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

1{-# LANGUAGE PolyKinds #-}

2+

2class Foo (a :: k)

3class Foo (a :: k)

3

4

4class

5class

data/examples/declaration/class/type-operators-out.hs+1

@@ -1,5 +1,6 @@

1{-# LANGUAGE MultiParamTypeClasses #-}

2{-# LANGUAGE TypeOperators #-}

3+

3class (:$) a b

4class (:$) a b

4

5

5class

6class

data/examples/declaration/data/empty-out.hs+1

@@ -1,2 +1,3 @@

1{-# LANGUAGE EmptyDataDecls #-}

2+

2data Foo

3data Foo

data/examples/declaration/data/existential-multiline-out.hs+1

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

1{-# LANGUAGE ExistentialQuantification #-}

2+

2data Foo

3data Foo

3 = forall a. MkFoo a (a -> Bool)

4 = forall a. MkFoo a (a -> Bool)

4 | forall a. Eq a => MkBar a

5 | forall a. Eq a => MkBar a

data/examples/declaration/data/existential-out.hs+1

@@ -1,2 +1,3 @@

1{-# LANGUAGE ExistentialQuantification #-}

2+

2data Foo = forall a. MkFoo a (a -> Bool)

3data Foo = forall a. MkFoo a (a -> Bool)

data/examples/declaration/foreign/foreign-import-out.hs+1

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

1{-# LANGUAGE CApiFFI #-}

2+

2foreign import ccall safe foo :: Int -> IO Int

3foreign import ccall safe foo :: Int -> IO Int

3

4

4-- | 'bar' is a very important thing

5-- | 'bar' is a very important thing

data/examples/declaration/instance/associated-data-out.hs+1

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

1{-# LANGUAGE TypeFamilies #-}

2+

2instance Foo Int where

3instance Foo Int where

3

4

4 data Bar Int = IntBar Int Int

5 data Bar Int = IntBar Int Int

data/examples/declaration/instance/associated-types-out.hs+1

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

1{-# LANGUAGE TypeFamilies #-}

2+

2instance Foo Int where

3instance Foo Int where

3

4

4 type Bar Int = Double

5 type Bar Int = Double

data/examples/declaration/instance/data-family-instances-out.hs+1

@@ -1,5 +1,6 @@

1{-# LANGUAGE GADTSyntax #-}

2{-# LANGUAGE TypeFamilies #-}

3+

3data instance Foo Int = FooInt Int

4data instance Foo Int = FooInt Int

4

5

5data instance Foo [Int]

6data instance Foo [Int]

data/examples/declaration/instance/instance-sigs-out.hs+1

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

1{-# LANGUAGE InstanceSigs #-}

2+

2instance Eq Int where

3instance Eq Int where

3

4

4 (==) :: Int -> Int -> Bool

5 (==) :: Int -> Int -> Bool

data/examples/declaration/instance/type-family-instances-out.hs+1

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

1{-# LANGUAGE TypeFamilies #-}

2+

2type instance Foo Int = Int

3type instance Foo Int = Int

3

4

4type instance

5type instance

data/examples/declaration/role-annotation/simple-out.hs+2−1

@@ -1,5 +1,6 @@

1−{-# LANGUAGE RoleAnnotations #-}

2{-# LANGUAGE MagicHash #-}

1{-# LANGUAGE MagicHash #-}

2+{-# LANGUAGE RoleAnnotations #-}

3+

3type role Ptr representational

4type role Ptr representational

4

5

5type role A nominal nominal

6type role A nominal nominal

data/examples/declaration/signature/pattern/multiline-out.hs+1

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

1{-# LANGUAGE PatternSynonyms #-}

2+

2pattern Arrow

3pattern Arrow

3 :: Type

4 :: Type

4 -> Type

5 -> Type

data/examples/declaration/signature/pattern/single-line-out.hs+1

@@ -1,2 +1,3 @@

1{-# LANGUAGE PatternSynonyms #-}

2+

2pattern Arrow :: Type -> Type -> Type

3pattern Arrow :: Type -> Type -> Type

data/examples/declaration/signature/type/arguments-out.hs+1

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

1{-# LANGUAGE RankNTypes #-}

2+

2functionName

3functionName

3 :: (C1, C2, C3, C4, C5)

4 :: (C1, C2, C3, C4, C5)

4 => a

5 => a

data/examples/declaration/splice/bracket-out.hs+1

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

1{-# LANGUAGE TemplateHaskell #-}

2+

2foo =

3foo =

3 [e|

4 [e|

4 foo bar

5 foo bar

data/examples/declaration/splice/quasiquote-out.hs+1

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

1{-# LANGUAGE QuasiQuotes #-}

2+

2x = [foo| foo bar |]

3x = [foo| foo bar |]

3

4

4x =

5x =

data/examples/declaration/splice/splice-decl-out.hs+1

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

1{-# LANGUAGE TemplateHaskell #-}

2+

2$(foo bar)

3$(foo bar)

3

4

4$foo

5$foo

data/examples/declaration/splice/typed-splice-out.hs+1

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

1{-# LANGUAGE TemplateHaskell #-}

2+

2x =

3x =

3 $$( foo bar

4 $$( foo bar

4 )

5 )

data/examples/declaration/splice/untyped-splice-out.hs+1

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

1{-# LANGUAGE TemplateHaskell #-}

2+

2x = $(foo bar)

3x = $(foo bar)

3

4

4x =

5x =

data/examples/declaration/value/function/arrow/expression-applications-out.hs+1

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

1{-# LANGUAGE Arrows #-}

2+

2foo x y = x -< y

3foo x y = x -< y

3

4

4bar f x =

5bar f x =

data/examples/declaration/value/function/arrow/expression-forms-out.hs+1

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

1{-# LANGUAGE Arrows #-}

2+

2foo f g x y = (|test (f -< x) (g -< y)|)

3foo f g x y = (|test (f -< x) (g -< y)|)

3

4

4bar f g x y =

5bar f g x y =

data/examples/declaration/value/function/arrow/proc-applications-out.hs+1

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

1{-# LANGUAGE Arrows #-}

2+

2foo x = proc a -> a -< x

3foo x = proc a -> a -< x

3

4

4bar f x =

5bar f x =

data/examples/declaration/value/function/arrow/proc-cases-out.hs+1

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

1{-# LANGUAGE Arrows #-}

2+

2foo f = proc a -> case a of Left b -> f -< b

3foo f = proc a -> case a of Left b -> f -< b

3

4

4bar f g h j = proc a -> case a of

5bar f g h j = proc a -> case a of

data/examples/declaration/value/function/arrow/proc-do-complex-out.hs+1

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

1{-# LANGUAGE Arrows #-}

2+

2foo

3foo

3 f

4 f

4 g

5 g

data/examples/declaration/value/function/arrow/proc-do-simple-out.hs+1

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

1{-# LANGUAGE Arrows #-}

2+

2foo f = proc a -> do

3foo f = proc a -> do

3 f -< a

4 f -< a

4

5

data/examples/declaration/value/function/arrow/proc-forms-out.hs+1

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

1{-# LANGUAGE Arrows #-}

2+

2foo0 f g x y = proc _ -> (|f (g -< (x, y))|)

3foo0 f g x y = proc _ -> (|f (g -< (x, y))|)

3

4

4foo1 f g h x = proc (y, z) ->

5foo1 f g h x = proc (y, z) ->

data/examples/declaration/value/function/arrow/proc-ifs-out.hs+1

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

1{-# LANGUAGE Arrows #-}

2+

2foo f = proc a -> if a then f -< 0 else f -< 1

3foo f = proc a -> if a then f -< 0 else f -< 1

3

4

4bar f g = proc a ->

5bar f g = proc a ->

data/examples/declaration/value/function/arrow/proc-lambdas-out.hs+1

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

1{-# LANGUAGE Arrows #-}

2+

2foo = proc a -> \f b -> a -< f b -- Foo

3foo = proc a -> \f b -> a -< f b -- Foo

3

4

4bar = proc x -> \f g h -> \() -> \(Left (x, y)) -> -- Tuple value

5bar = proc x -> \f g h -> \() -> \(Left (x, y)) -> -- Tuple value

data/examples/declaration/value/function/arrow/proc-lets-out.hs+1

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

1{-# LANGUAGE Arrows #-}

2+

2foo f = proc a -> let b = a in f -< b

3foo f = proc a -> let b = a in f -< b

3

4

4bar f g = proc a ->

5bar f g = proc a ->

data/examples/declaration/value/function/arrow/proc-parentheses-out.hs+1

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

1{-# LANGUAGE Arrows #-}

2+

2foo f = proc a -> (f -< a)

3foo f = proc a -> (f -< a)

3

4

4bar f g = proc a ->

5bar f g = proc a ->

data/examples/declaration/value/function/arrow/recursive-procs-out.hs+1

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

1{-# LANGUAGE Arrows #-}

2+

2foo f g = proc (x, y) -> do

3foo f g = proc (x, y) -> do

3 rec a <- f y -< x

4 rec a <- f y -< x

4 b <-

5 b <-

data/examples/declaration/value/function/do-out.hs+1

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

1{-# LANGUAGE RecursiveDo #-}

2+

2bar = do

3bar = do

3 foo

4 foo

4 bar

5 bar

data/examples/declaration/value/function/implicit-params-out.hs+1

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

1{-# LANGUAGE ImplicitParams #-}

2+

2sortBy :: (a -> a -> Bool) -> [a] -> [a]

3sortBy :: (a -> a -> Bool) -> [a] -> [a]

3

4

4sort :: (?cmp :: a -> a -> Bool) => [a] -> [a]

5sort :: (?cmp :: a -> a -> Bool) => [a] -> [a]

data/examples/declaration/value/function/lambda-case-out.hs+1

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

1{-# LANGUAGE LambdaCase #-}

2+

2foo :: Int -> Int

3foo :: Int -> Int

3foo = \case

4foo = \case

4 5 -> 10

5 5 -> 10

data/examples/declaration/value/function/multi-way-if-out.hs+1

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

1{-# LANGUAGE MultiWayIf #-}

2+

2foo x = if | x == 5 -> 5

3foo x = if | x == 5 -> 5

3

4

4bar x y =

5bar x y =

data/examples/declaration/value/function/overloaded-labels-out.hs+1

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

1{-# LANGUAGE OverloadedLabels #-}

2+

2foo = #field

3foo = #field

3

4

4bar = (#this) (#that)

5bar = (#this) (#that)

data/examples/declaration/value/function/pattern/n-plus-k-pattern-out.hs+1

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

1{-# LANGUAGE NPlusKPatterns #-}

2+

2singleline :: Int

3singleline :: Int

3singleline (n + 1) = n

4singleline (n + 1) = n

4

5

data/examples/declaration/value/function/pattern/quasi-quotes-pattern-out.hs+1

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

1{-# LANGUAGE QuasiQuotes #-}

2+

2singleline :: ()

3singleline :: ()

3singleline [yamlQQ|something|] = ()

4singleline [yamlQQ|something|] = ()

4

5

data/examples/declaration/value/function/pattern/splice-pattern-out.hs+1

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

1{-# LANGUAGE TemplateHaskell #-}

2+

2singleLine = case () of

3singleLine = case () of

3 $x -> ()

4 $x -> ()

4 $(y "something") -> ()

5 $(y "something") -> ()

data/examples/declaration/value/function/pattern/view-pattern-out.hs+1

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

1{-# LANGUAGE ViewPatterns #-}

2+

2example f (f -> 4) = True

3example f (f -> 4) = True

3

4

4f (t -> Nothing) = "Nothing"

5f (t -> Nothing) = "Nothing"

data/examples/declaration/value/function/quasi-quotes-out.hs+1

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

1{-# LANGUAGE QuasiQuotes #-}

2+

2singleline :: Value

3singleline :: Value

3singleline = [yamlQQ|something|]

4singleline = [yamlQQ|something|]

4

5

data/examples/declaration/value/function/record-wildcards-out.hs+1

@@ -1,5 +1,6 @@

1{-# LANGUAGE NamedFieldPuns #-}

2{-# LANGUAGE RecordWildCards #-}

3+

3foo x y = Foo {x, y}

4foo x y = Foo {x, y}

4

5

5bar x y z = Bar

6bar x y z = Bar

data/examples/declaration/value/function/splice-out.hs+1

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

1{-# LANGUAGE TemplateHaskell #-}

2+

2bar = $bar

3bar = $bar

3

4

4bar' = $(bar "something")

5bar' = $(bar "something")

data/examples/declaration/value/function/static-pointers-out.hs+1

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

1{-# LANGUAGE StaticPointers #-}

2+

2foo :: StaticPtr Int

3foo :: StaticPtr Int

3foo = static 5

4foo = static 5

4

5

data/examples/declaration/value/function/tuple-sections-out.hs+1

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

1{-# LANGUAGE TupleSections #-}

2+

2foo = (,2)

3foo = (,2)

3

4

4bar = (,5,)

5bar = (,5,)

data/examples/declaration/value/function/type-applications-out.hs+1

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

1{-# LANGUAGE TypeApplications #-}

2+

2foo = f @String a b c

3foo = f @String a b c

3

4

4bar = f @(Maybe Int) a b

5bar = f @(Maybe Int) a b

data/examples/declaration/value/function/unboxed-sums-out.hs+1

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

1{-# LANGUAGE UnboxedSums #-}

2+

2foo = (# 1 | #)

3foo = (# 1 | #)

3

4

4bar = (# | | 2 | #)

5bar = (# | | 2 | #)

data/examples/declaration/value/function/unboxed-tuples-out.hs+1

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

1{-# LANGUAGE UnboxedTuples #-}

2+

2foo = (# 1, 2, 3 #)

3foo = (# 1, 2, 3 #)

3

4

4bar =

5bar =

data/examples/declaration/value/pattern-synonyms/explicitely-bidirectional-out.hs+1

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

1{-# LANGUAGE PatternSynonyms #-}

2+

2pattern HeadC x <-

3pattern HeadC x <-

3 x : xs

4 x : xs

4 where

5 where

data/examples/declaration/value/pattern-synonyms/unidirectional-out.hs+1

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

1{-# LANGUAGE PatternSynonyms #-}

2+

2pattern Head x <- x : xs

3pattern Head x <- x : xs

3

4

4pattern Head' x <-

5pattern Head' x <-

data/examples/module-header/multiline-with-comments-out.hs+2−2

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

1−-- | Header.

2−

3{-# LANGUAGE FlexibleContexts #-}

1{-# LANGUAGE FlexibleContexts #-}

4{-# LANGUAGE TypeFamilies #-}

2{-# LANGUAGE TypeFamilies #-}

3+

4+-- | Header.

5module My.Module

6 ( -- * Something

7 foo

data/examples/module-header/singleline-empty-out.hsnew file+5

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

1+-- | This demonstrates a BUG.

2+module Foo

3+ (

4+ )

5+where

data/examples/module-header/singleline-empty.hsnew file+2

@@ -0,0 +1,2 @@

1+-- | This demonstrates a BUG.

2+module Foo () where

data/examples/other/language-pragma-no-header-out.hsnew file+3

@@ -0,0 +1,3 @@

1+{-# LANGUAGE DataKinds #-}

2+{-# LANGUAGE LambdaCase #-}

3+{-# LANGUAGE ViewPatterns #-}

data/examples/other/language-pragma-no-header.hsnew file+3

@@ -0,0 +1,3 @@

1+{-# LANGUAGE LambdaCase #-}

2+{-# LANGuagE ViewPatterns #-}

3+{-# language DataKinds, LambdaCase #-}

data/examples/other/language-pragma-out.hsnew file+9

@@ -0,0 +1,9 @@

1+{-# LANGUAGE DataKinds #-}

2+{-# LANGUAGE LambdaCase #-}

3+{-# LANGUAGE ViewPatterns #-}

4+

5+-- | Header comment.

6+module Foo

7+ (

8+ )

9+where

data/examples/other/language-pragma.hsnew file+7

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

1+-- | Header comment.

2+

3+{-# LANGUAGE LambdaCase #-}

4+{-# LANGuagE ViewPatterns #-}

5+{-# language DataKinds, LambdaCase #-}

6+

7+module Foo () where

ormolu.cabal+10−4

@@ -11,7 +11,9 @@ category: Development, Formatting

11synopsis: A formatter for Haskell source code

12build-type: Simple

13description: A formatter for Haskell source code.

14+extra-doc-files: CONTRIBUTING.md

14−extra-doc-files: CHANGELOG.md

15+ , CHANGELOG.md

16+ , DESIGN.md

15 , README.md

17 , README.md

16data-files: data/examples/declaration/data/*.hs

18data-files: data/examples/declaration/data/*.hs

17 , data/examples/declaration/data/gadt/*.hs

19 , data/examples/declaration/data/gadt/*.hs

@@ -47,13 +49,15 @@ library

47 , text >= 0.2 && < 1.3

49 , text >= 0.2 && < 1.3

48 , yaml >= 0.8 && < 0.12

50 , yaml >= 0.8 && < 0.12

49 exposed-modules: Ormolu

51 exposed-modules: Ormolu

50− , Ormolu.Anns

51− , Ormolu.CommentStream

52 , Ormolu.Config

53 , Ormolu.Diff

54 , Ormolu.Exception

55 , Ormolu.Imports

56 , Ormolu.Parser

57+ , Ormolu.Parser.Anns

58+ , Ormolu.Parser.CommentStream

59+ , Ormolu.Parser.LanguagePragma

60+ , Ormolu.Parser.Result

57 , Ormolu.Printer

61 , Ormolu.Printer

58 , Ormolu.Printer.Combinators

62 , Ormolu.Printer.Combinators

59 , Ormolu.Printer.Comments

63 , Ormolu.Printer.Comments

@@ -74,9 +78,10 @@ library

74 , Ormolu.Printer.Meat.Declaration.Value

78 , Ormolu.Printer.Meat.Declaration.Value

75 , Ormolu.Printer.Meat.Declaration.Warning

79 , Ormolu.Printer.Meat.Declaration.Warning

76 , Ormolu.Printer.Meat.ImportExport

80 , Ormolu.Printer.Meat.ImportExport

81+ , Ormolu.Printer.Meat.LanguagePragma

77 , Ormolu.Printer.Meat.Module

82 , Ormolu.Printer.Meat.Module

78 , Ormolu.Printer.Meat.Type

83 , Ormolu.Printer.Meat.Type

79− , Ormolu.SpanStream

84+ , Ormolu.Printer.SpanStream

80 , Ormolu.Utils

85 , Ormolu.Utils

81 if flag(dev)

86 if flag(dev)

82 ghc-options: -Wall -Werror -Wcompat

87 ghc-options: -Wall -Werror -Wcompat

@@ -103,6 +108,7 @@ test-suite tests

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

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

104 other-modules:

109 other-modules:

105 Ormolu.Printer.CombinatorsSpec

110 Ormolu.Printer.CombinatorsSpec

111+ , Ormolu.Parser.LanguagePragmaSpec

106 , Ormolu.PrinterSpec

112 , Ormolu.PrinterSpec

107

113

108 if flag(dev)

114 if flag(dev)

src/Ormolu.hs+12−26

@@ -18,17 +18,16 @@ import Control.Monad

18import Control.Monad.IO.Class (MonadIO (..))

19import Data.Text (Text)

20import Debug.Trace

21−import Ormolu.Anns

22−import Ormolu.CommentStream

23import Ormolu.Config

21import Ormolu.Config

24import Ormolu.Diff

22import Ormolu.Diff

25import Ormolu.Exception

23import Ormolu.Exception

26import Ormolu.Parser

24import Ormolu.Parser

25+import Ormolu.Parser.Result

27import Ormolu.Printer

26import Ormolu.Printer

27+import Ormolu.Utils (showOutputable)

28import qualified CmdLineParser as GHC

29import qualified Data.Text as T

30import qualified GHC

31−import qualified Outputable as GHC

32

31

33-- | Format a 'String', return formatted version as 'Text'.

32-- | Format a 'String', return formatted version as 'Text'.

34--

33--

@@ -48,20 +47,19 @@ ormolu

48 -> String -- ^ Input to format

47 -> String -- ^ Input to format

49 -> m Text

48 -> m Text

50ormolu cfg path str = do

49ormolu cfg path str = do

51− (ws, (cstream0, anns0, parsedSrc0)) <-

50+ (ws, result0) <-

52 parseModule' cfg OrmoluParsingFailed path str

51 parseModule' cfg OrmoluParsingFailed path str

53 when (cfgDebug cfg) $ do

52 when (cfgDebug cfg) $ do

54 traceM "warnings:\n"

53 traceM "warnings:\n"

55 traceM (concatMap showWarn ws)

54 traceM (concatMap showWarn ws)

56− traceM "comment stream:\n"

55+ traceM (prettyPrintParseResult result0)

57− traceM (showCommentStream cstream0)

58− let txt = printModule (cfgDebug cfg) cstream0 anns0 parsedSrc0

56+ let txt = printModule (cfgDebug cfg) result0

59 -- Parse the result of pretty-printing again and make sure that AST is the

57 -- Parse the result of pretty-printing again and make sure that AST is the

60 -- same as AST of original snippet module span positions.

58 -- same as AST of original snippet module span positions.

61 unless (cfgUnsafe cfg) $ do

59 unless (cfgUnsafe cfg) $ do

62− (_, (cstream1, _, parsedSrc1)) <-

60+ (_, result1) <-

63 parseModule' cfg OrmoluOutputParsingFailed "<rendered>" (T.unpack txt)

61 parseModule' cfg OrmoluOutputParsingFailed "<rendered>" (T.unpack txt)

64− when (diff (cstream0, parsedSrc0) (cstream1, parsedSrc1)) $

62+ when (diff result0 result1) $

65 liftIO $ throwIO (OrmoluASTDiffers str txt)

63 liftIO $ throwIO (OrmoluASTDiffers str txt)

66 return txt

64 return txt

67

65

@@ -91,8 +89,7 @@ parseModule'

91 -- ^ How to obtain 'OrmoluException' to throw when parsing fails

89 -- ^ How to obtain 'OrmoluException' to throw when parsing fails

92 -> FilePath -- ^ File name to use in errors

90 -> FilePath -- ^ File name to use in errors

93 -> String -- ^ Actual input for the parser

91 -> String -- ^ Actual input for the parser

94− -> m ([GHC.Warn], (CommentStream, Anns, GHC.ParsedSource))

92+ -> m ([GHC.Warn], ParseResult)

95− -- ^ Comment stream and parsed source

96parseModule' Config {..} mkException path str = do

93parseModule' Config {..} mkException path str = do

97 (ws, r) <- parseModule cfgDynOptions path str

94 (ws, r) <- parseModule cfgDynOptions path str

98 case r of

95 case r of

@@ -102,18 +99,7 @@ parseModule' Config {..} mkException path str = do

102-- | Pretty-print a 'GHC.Warn'.

99-- | Pretty-print a 'GHC.Warn'.

103

100

104showWarn :: GHC.Warn -> String

101showWarn :: GHC.Warn -> String

105−showWarn (GHC.Warn reason l) =

102+showWarn (GHC.Warn reason l) = unlines

106− showOutputable reason ++ "\n" ++ showOutputable l ++ "\n"

103+ [ showOutputable reason

107−

108−-- | Pretty-print a 'CommentStream'.

109−

110−showCommentStream :: CommentStream -> String

111−showCommentStream (CommentStream xs) = unlines $

112− showComment <$> xs

113− where

114− showComment (GHC.L l str) = showOutputable l ++ " " ++ show str

104+ , showOutputable l

115−

105+ ]

116−-- | Pretty-print an 'GHC.Outputable' thing.

117−

118−showOutputable :: GHC.Outputable o => o -> String

119−showOutputable = GHC.showSDocUnsafe . GHC.ppr

src/Ormolu/Diff.hs+8−6

@@ -12,17 +12,19 @@ where

12import BasicTypes (SourceText)

13import Data.Generics

14import GHC

15−import Ormolu.CommentStream

16import Ormolu.Imports (sortImports)

15import Ormolu.Imports (sortImports)

16+import Ormolu.Parser.Result

17

18-- | Return 'False' if two annotated ASTs are the same modulo span

19-- positions.

20

21−diff

21+diff :: ParseResult -> ParseResult -> Bool

22− :: (CommentStream, ParsedSource) -- ^ First comment stream and AST

22+diff ParseResult { prCommentStream = cstream0

23− -> (CommentStream, ParsedSource) -- ^ Second comment stream and AST

23+ , prParsedSource = ps0

24− -> Bool

24+ }

25−diff (cstream0, ps0) (cstream1, ps1) =

25+ ParseResult { prCommentStream = cstream1

26+ , prParsedSource = ps1

27+ } =

26 not (matchIgnoringSrcSpans cstream0 cstream1)

28 not (matchIgnoringSrcSpans cstream0 cstream1)

27 || not (matchIgnoringSrcSpans ps0 ps1)

29 || not (matchIgnoringSrcSpans ps0 ps1)

28

30

src/Ormolu/Exception.hs+1−6

@@ -10,10 +10,10 @@ where

10

11import Control.Exception

12import Data.Text (Text)

13+import Ormolu.Utils (showOutputable)

13import System.Exit (ExitCode (..), exitWith)

14import System.Exit (ExitCode (..), exitWith)

14import System.IO

15import System.IO

15import qualified GHC

16import qualified GHC

16−import qualified Outputable as GHC

17

18-- | Ormolu exception representing all cases when Ormolu can fail.

19

@@ -72,8 +72,3 @@ showParsingErr msg spn err = unlines

72 , showOutputable spn

73 , err

74 ]

75−

76−-- | Display something 'GHC.Outputable'.

77−

78−showOutputable :: GHC.Outputable o => o -> String

79−showOutputable = GHC.showSDocUnsafe . GHC.ppr

src/Ormolu/Parser.hs+13−10

@@ -15,10 +15,11 @@ import Data.Maybe (catMaybes)

15import GHC hiding (IE, parseModule, parser)

16import GHC.LanguageExtensions.Type (Extension (Cpp))

17import GHC.Paths (libdir)

18−import Ormolu.Anns

19−import Ormolu.CommentStream

20import Ormolu.Config

18import Ormolu.Config

21import Ormolu.Exception

19import Ormolu.Exception

20+import Ormolu.Parser.Anns

21+import Ormolu.Parser.CommentStream

22+import Ormolu.Parser.Result

22import qualified CmdLineParser as GHC

23import qualified CmdLineParser as GHC

23import qualified DynFlags as GHC

24import qualified DynFlags as GHC

24import qualified FastString as GHC

25import qualified FastString as GHC

@@ -37,8 +38,7 @@ parseModule

37 -> FilePath -- ^ File name (only for source location annotations)

38 -> FilePath -- ^ File name (only for source location annotations)

38 -> String -- ^ Input for parser

39 -> String -- ^ Input for parser

39 -> m ( [GHC.Warn]

40 -> m ( [GHC.Warn]

40− , Either (SrcSpan, String)

41+ , Either (SrcSpan, String) ParseResult

41− (CommentStream, Anns, ParsedSource)

42 )

43parseModule dynOpts path input' = liftIO $ do

44 let (input, extraComments) = stripLinePragmas input'

@@ -56,10 +56,13 @@ parseModule dynOpts path input' = liftIO $ do

56 GHC.PFailed _ ss m ->

57 Left (ss, GHC.showSDoc dynFlags m)

58 GHC.POk pstate pmod ->

59− Right ( mkCommentStream extraComments pstate

59+ let (comments, exts) = mkCommentStream extraComments pstate

60+ in Right ParseResult

61+ { prParsedSource = pmod

60− , mkAnns pstate

62+ , prAnns = mkAnns pstate

61− , pmod

63+ , prCommentStream = comments

62− )

64+ , prExtensions = exts

65+ }

63 return (ws, r)

66 return (ws, r)

64

67

65----------------------------------------------------------------------------

68----------------------------------------------------------------------------

@@ -85,8 +88,8 @@ initDynFlagsPure fp input = do

85 -- long as 'parseDynamicFilePragma' is impure there seems to be no reason

88 -- long as 'parseDynamicFilePragma' is impure there seems to be no reason

86 -- to use it.

89 -- to use it.

87 dflags0 <- GHC.getSessionDynFlags

90 dflags0 <- GHC.getSessionDynFlags

88− let pragmaInfo = GHC.getOptions dflags0 (GHC.stringToStringBuffer input) fp

91+ let tokens = GHC.getOptions dflags0 (GHC.stringToStringBuffer input) fp

89− (dflags1, _, _) <- GHC.parseDynamicFilePragma dflags0 pragmaInfo

92+ (dflags1, _, _) <- GHC.parseDynamicFilePragma dflags0 tokens

90 -- Turn this on last to avoid T10942

93 -- Turn this on last to avoid T10942

91 let dflags2 = dflags1 `GHC.gopt_set` GHC.Opt_KeepRawTokenStream

94 let dflags2 = dflags1 `GHC.gopt_set` GHC.Opt_KeepRawTokenStream

92 -- Prevent parsing of .ghc.environment.* "package environment files"

95 -- Prevent parsing of .ghc.environment.* "package environment files"

src/Ormolu/Anns.hs → src/Ormolu/Parser/Anns.hsrenamed+1−1

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

1-- | Ormolu-specific representation of GHC annotations.

2

3−module Ormolu.Anns

3+module Ormolu.Parser.Anns

4 ( Anns (..)

5 , emptyAnns

6 , mkAnns

src/Ormolu/CommentStream.hs → src/Ormolu/Parser/CommentStream.hsrenamed+49−15

@@ -1,24 +1,32 @@

1+{-# LANGUAGE BangPatterns #-}

1{-# LANGUAGE DeriveDataTypeable #-}

2{-# LANGUAGE DeriveDataTypeable #-}

2{-# LANGUAGE GeneralizedNewtypeDeriving #-}

3{-# LANGUAGE GeneralizedNewtypeDeriving #-}

3{-# LANGUAGE LambdaCase #-}

4{-# LANGUAGE LambdaCase #-}

5+{-# LANGUAGE TupleSections #-}

4

6

5-- | Functions for working with comment stream.

7-- | Functions for working with comment stream.

6

8

7−module Ormolu.CommentStream

9+module Ormolu.Parser.CommentStream

8 ( CommentStream (..)

10 ( CommentStream (..)

9 , Comment (..)

11 , Comment (..)

10 , mkCommentStream

12 , mkCommentStream

11 , isPrevHaddock

13 , isPrevHaddock

14+ , showCommentStream

12 )

15 )

13where

16where

14

17

15import Data.Char (isSpace)

18import Data.Char (isSpace)

16import Data.Data (Data)

19import Data.Data (Data)

20+import Data.Either (partitionEithers)

17import Data.List (isPrefixOf, sortOn)

21import Data.List (isPrefixOf, sortOn)

18import Data.List.NonEmpty (NonEmpty (..))

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

19import Data.Maybe (mapMaybe)

23import Data.Maybe (mapMaybe)

24+import Data.Set (Set)

25+import Ormolu.Parser.LanguagePragma

26+import Ormolu.Utils (showOutputable)

20import SrcLoc

27import SrcLoc

21import qualified Data.List.NonEmpty as NE

28import qualified Data.List.NonEmpty as NE

29+import qualified Data.Set as S

22import qualified GHC

30import qualified GHC

23import qualified Lexer as GHC

31import qualified Lexer as GHC

24

32

@@ -34,28 +42,31 @@ newtype CommentStream = CommentStream [RealLocated Comment]

34newtype Comment = Comment (NonEmpty String)

42newtype Comment = Comment (NonEmpty String)

35 deriving (Eq, Show, Data)

43 deriving (Eq, Show, Data)

36

44

37−-- | Create 'CommentStream' from 'GHC.PState'.

45+-- | Create 'CommentStream' from 'GHC.PState'. We also create a 'Set' of

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

47+-- removed from the 'CommentStream'.

38

48

39mkCommentStream

49mkCommentStream

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

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

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

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

42− -> CommentStream

52+ -> (CommentStream, Set String)

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

43−mkCommentStream extraComments pstate

54+mkCommentStream extraComments pstate =

44− = CommentStream

55+ ( CommentStream $

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

56+ -- NOTE It's easier to normalize pragmas right when we construct comment

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

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

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

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

48− . fmap (mkComment . (fmap normalizePragma))

59+ mkComment . fmap normalizePragma

49− . sortOn startOfSpan

60+ <$> sortOn (realSrcSpanStart . getLoc) comments

61+ , S.unions exts

62+ )

63+ where

64+ (comments, exts) = partitionEithers (partitionComments <$> rawComments)

50− . mapMaybe toRealSpan $

65+ rawComments = mapMaybe toRealSpan $

51 extraComments ++

66 extraComments ++

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

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

53 concatMap (fmap (fmap unAnnotationComment) . snd)

68 concatMap (fmap (fmap unAnnotationComment) . snd)

54 (GHC.annotations_comments pstate)

69 (GHC.annotations_comments pstate)

55− where

56− startOfSpan (L l _) = realSrcSpanStart l

57− toRealSpan (L (RealSrcSpan l) a) = Just (L l a)

58− toRealSpan _ = Nothing

59

70

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

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

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

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

@@ -63,6 +74,14 @@ mkCommentStream extraComments pstate

63isPrevHaddock :: Comment -> Bool

74isPrevHaddock :: Comment -> Bool

64isPrevHaddock (Comment (x :| _)) = "-- ^" `isPrefixOf` x

75isPrevHaddock (Comment (x :| _)) = "-- ^" `isPrefixOf` x

65

76

77+-- | Pretty-print a 'CommentStream'.

78+

79+showCommentStream :: CommentStream -> String

80+showCommentStream (CommentStream xs) = unlines $

81+ showComment <$> xs

82+ where

83+ showComment (GHC.L l str) = showOutputable l ++ " " ++ show str

84+

66----------------------------------------------------------------------------

85----------------------------------------------------------------------------

67-- Helpers

86-- Helpers

68

87

@@ -105,3 +124,18 @@ unAnnotationComment = \case

105 GHC.AnnDocOptions s -> s

124 GHC.AnnDocOptions s -> s

106 GHC.AnnLineComment s -> s

125 GHC.AnnLineComment s -> s

107 GHC.AnnBlockComment s -> s

126 GHC.AnnBlockComment s -> s

127+

128+toRealSpan :: Located a -> Maybe (RealLocated a)

129+toRealSpan (L (RealSrcSpan l) a) = Just (L l a)

130+toRealSpan _ = Nothing

131+

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

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

134+

135+partitionComments

136+ :: RealLocated String

137+ -> Either (RealLocated String) (Set String)

138+partitionComments input =

139+ case parseLanguagePragma (unLoc input) of

140+ Nothing -> Left input

141+ Just exts -> Right exts

src/Ormolu/Parser/LanguagePragma.hsnew file+85

@@ -0,0 +1,85 @@

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 Data.Char (toLower)

12+import Data.List (isPrefixOf)

13+import Data.Set (Set)

14+import FastString (mkFastString, unpackFS)

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

16+import SrcLoc

17+import StringBuffer

18+import qualified Data.Set as S

19+import qualified EnumSet as ES

20+import qualified Lexer as L

21+

22+-- | Extract a 'Set' of language extensions from a comment if it's a

23+-- language pragma or return 'Nothing' otherwise.

24+

25+parseLanguagePragma

26+ :: String -- ^ Comment to try to parse

27+ -> Maybe (Set String)

28+parseLanguagePragma input =

29+ if "{-#" `isPrefixOf` input

30+ then do

31+ toks0 <- tokenize (drop 3 input)

32+ toks1 <- dropLanguage toks0

33+ S.fromList <$> parseExtensions toks1

34+ else Nothing

35+

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

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

38+

39+parseExtensions :: [L.Token] -> Maybe [String]

40+parseExtensions = \case

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

42+ (L.ITconid ext : L.ITcomma : xs) -> (unpackFS ext :) <$> parseExtensions xs

43+ _ -> Nothing

44+

45+-- | Drop LANGUAGE pragma text from the token stream.

46+

47+dropLanguage :: [L.Token] -> Maybe [L.Token]

48+dropLanguage = \case

49+ (L.ITconid lang : xs) -> go lang xs

50+ (L.ITvarid lang : xs) -> go lang xs

51+ _ -> Nothing

52+ where

53+ go lang xs =

54+ if (toLower <$> unpackFS lang) == "language"

55+ then Just xs

56+ else Nothing

57+

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

59+

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

61+tokenize input =

62+ case L.unP pLexer parseState of

63+ L.PFailed {} -> Nothing

64+ L.POk _ x -> Just x

65+ where

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

67+ buffer = stringToStringBuffer input

68+ parseState = L.mkPStatePure parserFlags buffer location

69+ parserFlags = L.ParserFlags

70+ { L.pWarningFlags = ES.empty

71+ , L.pExtensionFlags = ES.empty

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

73+ , L.pExtsBitmap = 0xffffffffffffffff

74+ }

75+

76+-- | Haskell lexer.

77+

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

79+pLexer = go

80+ where

81+ go = do

82+ r <- L.lexer False return

83+ case unLoc r of

84+ L.ITeof -> return []

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

src/Ormolu/Parser/Result.hsnew file+37

@@ -0,0 +1,37 @@

1+-- | A type for result of parsing.

2+

3+{-# LANGUAGE RecordWildCards #-}

4+

5+module Ormolu.Parser.Result

6+ ( ParseResult (..)

7+ , prettyPrintParseResult

8+ )

9+where

10+

11+import Data.Set (Set)

12+import GHC

13+import Ormolu.Parser.Anns

14+import Ormolu.Parser.CommentStream

15+

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

17+

18+data ParseResult = ParseResult

19+ { prParsedSource :: ParsedSource

20+ -- ^ 'ParsedSource' from GHC

21+ , prAnns :: Anns

22+ -- ^ Ormolu-specfic representation of annotations

23+ , prCommentStream :: CommentStream

24+ -- ^ Comment stream

25+ , prExtensions :: Set String

26+ -- ^ Extensions enabled in that module

27+ }

28+

29+-- | Pretty-print a 'ParseResult'.

30+

31+prettyPrintParseResult :: ParseResult -> String

32+prettyPrintParseResult ParseResult {..} = unlines

33+ [ "parse result:"

34+ , " comment stream:"

35+ , showCommentStream prCommentStream

36+ -- XXX extend as needed

37+ ]

src/Ormolu/Printer.hs+9−9

@@ -10,20 +10,20 @@ module Ormolu.Printer

10where

11

12import Data.Text (Text)

13−import GHC

13+import Ormolu.Parser.Result

14−import Ormolu.Anns

15−import Ormolu.CommentStream

16import Ormolu.Printer.Combinators

14import Ormolu.Printer.Combinators

17import Ormolu.Printer.Meat.Module

15import Ormolu.Printer.Meat.Module

18−import Ormolu.SpanStream

16+import Ormolu.Printer.SpanStream

19

17

20-- | Render a module.

18-- | Render a module.

21

19

22printModule

20printModule

23 :: Bool -- ^ Whether to trace debugging information

21 :: Bool -- ^ Whether to trace debugging information

24− -> CommentStream -- ^ Comment stream

22+ -> ParseResult -- ^ Result of parsing

25− -> Anns -- ^ Annotations

26− -> ParsedSource -- ^ Parsed source

27 -> Text -- ^ Resulting rendition

23 -> Text -- ^ Resulting rendition

28−printModule debugOn cstream anns src =

24+printModule debugOn ParseResult {..} =

29− runR debugOn (p_hsModule src) (mkSpanStream src) cstream anns

25+ runR debugOn

26+ (p_hsModule prExtensions prParsedSource)

27+ (mkSpanStream prParsedSource)

28+ prCommentStream

29+ prAnns

src/Ormolu/Printer/Comments.hs+1−1

@@ -15,7 +15,7 @@ where

15import Control.Monad

16import Data.Coerce (coerce)

17import Data.Data (Data)

18−import Ormolu.CommentStream

18+import Ormolu.Parser.CommentStream

19import Ormolu.Printer.Internal

20import Ormolu.Utils (isModule)

21import SrcLoc

src/Ormolu/Printer/Internal.hs+3−3

@@ -44,9 +44,9 @@ import Data.Text (Text)

44import Data.Text.Lazy.Builder

45import Debug.Trace

46import GHC

47−import Ormolu.Anns

47+import Ormolu.Parser.Anns

48−import Ormolu.CommentStream

48+import Ormolu.Parser.CommentStream

49−import Ormolu.SpanStream

49+import Ormolu.Printer.SpanStream

50import SrcLoc

51import qualified Data.Text as T

52import qualified Data.Text.Lazy as TL

src/Ormolu/Printer/Meat/LanguagePragma.hsnew file+23

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

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+15−5

@@ -10,6 +10,7 @@ where

10

11import Control.Monad

12import Data.Maybe (isJust)

13+import Data.Set (Set)

13import GHC

14import GHC

14import Ormolu.Imports

15import Ormolu.Imports

15import Ormolu.Printer.Combinators

16import Ormolu.Printer.Combinators

@@ -18,10 +19,11 @@ import Ormolu.Printer.Meat.Common

18import Ormolu.Printer.Meat.Declaration

19import Ormolu.Printer.Meat.Declaration

19import Ormolu.Printer.Meat.Declaration.Warning

20import Ormolu.Printer.Meat.Declaration.Warning

20import Ormolu.Printer.Meat.ImportExport

21import Ormolu.Printer.Meat.ImportExport

22+import Ormolu.Printer.Meat.LanguagePragma

21import SrcLoc (combineSrcSpans)

23import SrcLoc (combineSrcSpans)

22

24

23−p_hsModule :: ParsedSource -> R ()

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

24−p_hsModule loc@(L moduleSpan hsModule) = do

26+p_hsModule exts loc@(L moduleSpan hsModule) = do

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

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

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

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

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

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

@@ -30,6 +32,14 @@ p_hsModule loc@(L moduleSpan hsModule) = do

30 Nothing -> moduleSpan

32 Nothing -> moduleSpan

31 Just (L exportsSpan _) -> combineSrcSpans moduleSpan exportsSpan

33 Just (L exportsSpan _) -> combineSrcSpans moduleSpan exportsSpan

32 locatedVia (Just spn) loc $ \HsModule {..} -> do

34 locatedVia (Just spn) loc $ \HsModule {..} -> do

35+ let hasLangPragmas = not (null exts)

36+ hasModuleHeader = isJust hsmodName

37+ hasImports = not (null hsmodImports)

38+ hasDecls = not (null hsmodDecls)

39+ p_langPragmas exts

40+ when (hasLangPragmas &&

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

42+ newline

33 case hsmodName of

43 case hsmodName of

34 Nothing -> pure ()

44 Nothing -> pure ()

35 Just hsmodName' -> line $ do

45 Just hsmodName' -> line $ do

@@ -42,10 +52,10 @@ p_hsModule loc@(L moduleSpan hsModule) = do

42 inci (locatedVia Nothing hsmodExports' p_hsmodExports)

52 inci (locatedVia Nothing hsmodExports' p_hsmodExports)

43 breakpoint

53 breakpoint

44 txt "where"

54 txt "where"

45− when (not (null hsmodImports) || not (null hsmodDecls)) newline

55+ when (hasImports || hasDecls) newline

46 forM_ (sortImports hsmodImports) (located' p_hsmodImport)

56 forM_ (sortImports hsmodImports) (located' p_hsmodImport)

47− when (not (null hsmodImports) && not (null hsmodDecls)) newline

57+ when (hasImports && hasDecls) newline

48 p_hsDecls Free hsmodDecls

58 p_hsDecls Free hsmodDecls

49 trailingComments <- hasMoreComments

59 trailingComments <- hasMoreComments

50− when (trailingComments && isJust hsmodName) newline

60+ when (trailingComments && hasModuleHeader) newline

51 spitRemainingComments

61 spitRemainingComments

src/Ormolu/SpanStream.hs → src/Ormolu/Printer/SpanStream.hsrenamed+1−1

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

3

4-- | Build span stream from AST.

5

6−module Ormolu.SpanStream

6+module Ormolu.Printer.SpanStream

7 ( SpanStream (..)

8 , mkSpanStream

9 )

src/Ormolu/Utils.hs+7

@@ -4,12 +4,14 @@ module Ormolu.Utils

4 ( combineSrcSpans'

5 , isModule

6 , notImplemented

7+ , showOutputable

7 )

8 )

8where

9where

9

10

10import Data.Data (Data, showConstr, toConstr)

11import Data.Data (Data, showConstr, toConstr)

11import Data.List.NonEmpty (NonEmpty (..))

12import Data.List.NonEmpty (NonEmpty (..))

12import SrcLoc

13import SrcLoc

14+import qualified Outputable as GHC

13

15

14-- | Combine all source spans from the given list.

16-- | Combine all source spans from the given list.

15

17

@@ -25,3 +27,8 @@ isModule x = showConstr (toConstr x) == "HsModule"

25

27

26notImplemented :: String -> a

28notImplemented :: String -> a

27notImplemented msg = error $ "not implemented yet: " ++ msg

29notImplemented msg = error $ "not implemented yet: " ++ msg

30+

31+-- | Pretty-print an 'GHC.Outputable' thing.

32+

33+showOutputable :: GHC.Outputable o => o -> String

34+showOutputable = GHC.showSDocUnsafe . GHC.ppr

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

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

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, Bar #-}" (Just ["Bar", "Foo"])

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

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

16+ stdTest "something" Nothing

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

18+

19+stdTest :: String -> Maybe [String] -> Spec

20+stdTest input result = it input $

21+ (S.toAscList <$> parseLanguagePragma input) `shouldBe`

22+ result

tests/Ormolu/Printer/CombinatorsSpec.hs+1−1

@@ -2,7 +2,7 @@

2

3module Ormolu.Printer.CombinatorsSpec (spec) where

4

5−import Ormolu.Anns

5+import Ormolu.Parser.Anns

6import Ormolu.Printer.Combinators

7import Ormolu.Printer.Internal

8import Test.Hspec