on master help sign in
Workaround GHC tokenizer bug while extracting LANGUAGE pragmas
be6d09dUtku Demir
data/examples/other/language-pragma-out.hs+3
@@ -1,5 +1,8 @@
1+{-# LANGUAGE AllowAmbiguousTypes #-}
1{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE DataKinds #-}
3+{-# LANGUAGE IncoherentInstances #-}
2{-# LANGUAGE LambdaCase #-}
4{-# LANGUAGE LambdaCase #-}
5+{-# LANGUAGE OverloadedStrings #-}
3{-# LANGUAGE ViewPatterns #-}
6{-# LANGUAGE ViewPatterns #-}
4
7
5-- | Header comment.
8-- | Header comment.
data/examples/other/language-pragma.hs+4−1
@@ -1,7 +1,10 @@
1-- | Header comment.
1-- | Header comment.
2
2
3{-# LANGUAGE LambdaCase #-}
3{-# LANGUAGE LambdaCase #-}
4−{-# LANGuagE ViewPatterns #-}
4+{-#LANGuagE ViewPatterns #-}
5+{-# LANGUAGE OverloadedStrings#-}
5{-# language DataKinds, LambdaCase #-}
6{-# language DataKinds, LambdaCase #-}
7+{-# language IncoherentInstances
8+ , AllowAmbiguousTypes #-}
6
9
7module Foo () where
10module Foo () where
src/Ormolu/Parser/LanguagePragma.hs+10−9
@@ -8,8 +8,9 @@ module Ormolu.Parser.LanguagePragma
8 )
8 )
9where
9where
10
10
11+import Control.Monad
11import Data.Char (toLower)
12import Data.Char (toLower)
12−import Data.List (isPrefixOf)
13+import Data.List (stripPrefix, isSuffixOf)
13import Data.Set (Set)
14import Data.Set (Set)
14import FastString (mkFastString, unpackFS)
15import FastString (mkFastString, unpackFS)
15import Module (newSimpleUnitId, ComponentId (..))
16import Module (newSimpleUnitId, ComponentId (..))
@@ -25,20 +26,20 @@ import qualified Lexer as L
25parseLanguagePragma
26parseLanguagePragma
26 :: String -- ^ Comment to try to parse
27 :: String -- ^ Comment to try to parse
27 -> Maybe (Set String)
28 -> Maybe (Set String)
28−parseLanguagePragma input =
29+parseLanguagePragma input = do
29− if "{-#" `isPrefixOf` input
30+ inputNoPrefix <- stripPrefix "{-#" input
30− then do
31+ guard ("#-}" `isSuffixOf` input)
31− toks0 <- tokenize (drop 3 input)
32+ let contents = take (length inputNoPrefix - 3) inputNoPrefix
33+ toks0 <- tokenize contents
32− toks1 <- dropLanguage toks0
34+ toks1 <- dropLanguage toks0
33− S.fromList <$> parseExtensions toks1
35+ S.fromList <$> parseExtensions toks1
34− else Nothing
35
36
36-- | Assuming the input consists of a series of tokens from a language
37-- | Assuming the input consists of a series of tokens from a language
37-- pragma, return the set of enabled extensions.
38-- pragma, return the set of enabled extensions.
38
39
39parseExtensions :: [L.Token] -> Maybe [String]
40parseExtensions :: [L.Token] -> Maybe [String]
40parseExtensions = \case
41parseExtensions = \case
41− (L.ITconid ext : L.ITclose_prag : []) -> return [unpackFS ext]
42+ (L.ITconid ext : []) -> return [unpackFS ext]
42 (L.ITconid ext : L.ITcomma : xs) -> (unpackFS ext :) <$> parseExtensions xs
43 (L.ITconid ext : L.ITcomma : xs) -> (unpackFS ext :) <$> parseExtensions xs
43 _ -> Nothing
44 _ -> Nothing
44
45
tests/Ormolu/Parser/LanguagePragmaSpec.hs+3
@@ -9,6 +9,9 @@ spec = do
9 describe "parseLanguagePragma" $ do
9 describe "parseLanguagePragma" $ do
10 stdTest "{-# LANGUAGE Foo #-}" (Just ["Foo"])
10 stdTest "{-# LANGUAGE Foo #-}" (Just ["Foo"])
11 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"])
12 stdTest "{-# lAngUAGe Foo #-}" (Just ["Foo"])
15 stdTest "{-# lAngUAGe Foo #-}" (Just ["Foo"])
13 stdTest "{-# LANGUAGE Foo, Bar #-}" (Just ["Bar", "Foo"])
16 stdTest "{-# LANGUAGE Foo, Bar #-}" (Just ["Bar", "Foo"])
14 stdTest "{-# LANGUAGE Foo Bar #-}" Nothing
17 stdTest "{-# LANGUAGE Foo Bar #-}" Nothing