0233f6d · ormolu · git.iko.soy

git.iko.soy/ormolu

on master help sign in

Misc corrections

0233f6dmrkkrp7 years ago

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

compare with master

unifiedsplit

@@ -48,17 +48,17 @@ mkCommentStream

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

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

50 -> (CommentStream, [Pragma])

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

51+ -- ^ Comment stream and a set of extracted pragmas

52mkCommentStream extraComments pstate =

53 ( CommentStream $

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

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

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

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

58− , pragma

58+ , pragmas

59 )

60 where

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

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

62 rawComments = mapMaybe toRealSpan $

63 extraComments ++

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

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

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

120toRealSpan _ = Nothing

121

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

122+-- | If a given comment is a pragma, return it in parsed form in 'Right'.

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

123+-- Otherwise return the original comment unchanged.

124

125partitionComments

126 :: RealLocated String

@@ -128,4 +128,4 @@ partitionComments

128partitionComments input =

129 case parsePragma (unLoc input) of

130 Nothing -> Left input

131− Just pr -> Right pr

131+ Just pragma -> Right pragma

src/Ormolu/Parser/Pragma.hs+17−20

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

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

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

3{-# LANGUAGE LambdaCase #-}

4{-# LANGUAGE OverloadedStrings #-}

@@ -9,8 +9,9 @@ module Ormolu.Parser.Pragma

9 )

10where

12+import Control.Monad

12import Data.Char (toLower, isSpace)

13import Data.Char (toLower, isSpace)

13−import Data.List (stripPrefix, dropWhileEnd)

14+import Data.List

14import FastString (mkFastString, unpackFS)

15import FastString (mkFastString, unpackFS)

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

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

16import SrcLoc

17import SrcLoc

@@ -18,30 +19,31 @@ import StringBuffer

18import qualified EnumSet as ES

19import qualified EnumSet as ES

19import qualified Lexer as L

20import qualified Lexer as L

22+-- | Ormolu's representation of pragmas.

23+

21data Pragma

24data Pragma

22− = PragmaLanguage [String]

25+ = PragmaLanguage [String] -- ^ Language pragma

23− | PragmaOptionsGHC String

26+ | PragmaOptionsGHC String -- ^ GHC options pragma

24− | PragmaOptionsHaddock String

27+ | PragmaOptionsHaddock String -- ^ Haddock options pragma

25 deriving (Show, Eq)

28 deriving (Show, Eq)

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

30+-- | Extract a pragma from a comment if possible, or return 'Nothing'

28-- otherwise.

31-- otherwise.

30−parsePragma :: String -> Maybe Pragma

33+parsePragma

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

35+ -> Maybe Pragma

31parsePragma input = do

36parsePragma input = do

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

37+ inputNoPrefix <- stripPrefix "{-#" input

33− let (name, cs) = separateName contents

38+ guard ("#-}" `isSuffixOf` input)

39+ let contents = take (length inputNoPrefix - 3) inputNoPrefix

40+ (pragmaName, cs) = (break isSpace . dropWhile isSpace) contents

34− case map toLower name of

41+ case toLower <$> pragmaName of

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

42 "language" -> PragmaLanguage <$> parseExtensions cs

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

43 "options_ghc" -> Just $ PragmaOptionsGHC (trimSpaces cs)

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

44 "options_haddock" -> Just $ PragmaOptionsHaddock (trimSpaces cs)

38 _ -> Nothing

45 _ -> Nothing

39 where

46 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

47 trimSpaces :: String -> String

46 trimSpaces = dropWhileEnd isSpace . dropWhile isSpace

48 trimSpaces = dropWhileEnd isSpace . dropWhile isSpace

@@ -56,11 +58,6 @@ parseExtensions str = tokenize str >>= go

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

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

57 _ -> Nothing

59 _ -> Nothing

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.

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

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

63tokenize :: String -> Maybe [L.Token]

src/Ormolu/Printer/Meat/Pragma.hs+4−6

@@ -19,13 +19,11 @@ data PragmaTy = Language | OptionsGHC | OptionsHaddock

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

21p_pragmas ps =

22− let ps' = concatMap (\case

22+ let prepare = concatMap $ \case

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

23+ PragmaLanguage xs -> (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

26+ in mapM_ (uncurry p_pragma) (S.toAscList . S.fromList . prepare $ ps)

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

28p_pragma :: PragmaTy -> String -> R ()

31p_pragma ty c = line $ do

29p_pragma ty c = line $ do

@@ -34,6 +32,6 @@ p_pragma ty c = line $ do

34 Language -> "LANGUAGE"

32 Language -> "LANGUAGE"

35 OptionsGHC -> "OPTIONS_GHC"

33 OptionsGHC -> "OPTIONS_GHC"

36 OptionsHaddock -> "OPTIONS_HADDOCK"

34 OptionsHaddock -> "OPTIONS_HADDOCK"

37− txt " "

35+ space

38 txt (T.pack c)

36 txt (T.pack c)

39 txt " #-}"

37 txt " #-}"

tests/Ormolu/Parser/PragmaSpec.hs+9−6

@@ -6,16 +6,19 @@ import Test.Hspec

6spec :: Spec

7spec = do

8 describe "parsePragma" $ do

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

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

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

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

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

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

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

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

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

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

15+ 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 "{-# LANGUAGE Foo Bar #-}" Nothing

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

17 stdTest "{-# BOO Foo #-}" Nothing

17 stdTest "something" Nothing

18 stdTest "something" Nothing

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

19 stdTest "{-# LANGUAGE foo, Bar #-}" Nothing

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

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

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

23stdTest :: String -> Maybe Pragma -> Spec

21stdTest input result = it input $

24stdTest input result = it input $