@@ -1,4 +1,4 @@
1−-- | A module for parsing of language pragmas from comments.
1+-- | A module for parsing of pragmas from comments.
22
33{-# LANGUAGE LambdaCase #-}
44{-# LANGUAGE OverloadedStrings #-}
@@ -9,8 +9,9 @@ module Ormolu.Parser.Pragma
99 )
1010where
1111
12+import Control.Monad
1213import Data.Char (toLower, isSpace)
13−import Data.List (stripPrefix, dropWhileEnd)
14+import Data.List
1415import FastString (mkFastString, unpackFS)
1516import Module (newSimpleUnitId, ComponentId (..))
1617import SrcLoc
@@ -18,30 +19,31 @@ import StringBuffer
1819import qualified EnumSet as ES
1920import qualified Lexer as L
2021
22+-- | Ormolu's representation of pragmas.
23+
2124data Pragma
22− = PragmaLanguage [String]
23− | PragmaOptionsGHC String
24− | PragmaOptionsHaddock String
25+ = PragmaLanguage [String] -- ^ Language pragma
26+ | PragmaOptionsGHC String -- ^ GHC options pragma
27+ | PragmaOptionsHaddock String -- ^ Haddock options pragma
2528 deriving (Show, Eq)
2629
27−-- | Extract a Pragma from a comment if possible, or return 'Nothing'
30+-- | Extract a pragma from a comment if possible, or return 'Nothing'
2831-- otherwise.
2932
30−parsePragma :: String -> Maybe Pragma
33+parsePragma
34+ :: String -- ^ Comment to try to parse
35+ -> Maybe Pragma
3136parsePragma input = do
32− contents <- trimSpaces <$> stripEnclosing "{-#" "#-}" input
33− let (name, cs) = separateName contents
34− case map toLower name of
37+ inputNoPrefix <- stripPrefix "{-#" input
38+ guard ("#-}" `isSuffixOf` input)
39+ let contents = take (length inputNoPrefix - 3) inputNoPrefix
40+ (pragmaName, cs) = (break isSpace . dropWhile isSpace) contents
41+ case toLower <$> pragmaName of
3542 "language" -> PragmaLanguage <$> parseExtensions cs
3643 "options_ghc" -> Just $ PragmaOptionsGHC (trimSpaces cs)
3744 "options_haddock" -> Just $ PragmaOptionsHaddock (trimSpaces cs)
3845 _ -> Nothing
3946 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−
4547 trimSpaces :: String -> String
4648 trimSpaces = dropWhileEnd isSpace . dropWhile isSpace
4749
@@ -56,11 +58,6 @@ parseExtensions str = tokenize str >>= go
5658 (L.ITconid ext : L.ITcomma : xs) -> (unpackFS ext :) <$> go xs
5759 _ -> Nothing
5860
59−-- | Split a pragma to name and contents
60−
61−separateName :: String -> (String, String)
62−separateName = span (not . isSpace) . dropWhile isSpace
63−
6461-- | Tokenize a given input using GHC's lexer.
6562
6663tokenize :: String -> Maybe [L.Token]