{-# LANGUAGE CPP #-}

-- | Pragma-related functions.
module HIndent.Pragma
  ( extractPragmasFromCode
  , extractPragmaNameAndElement
  , pragmaRegex
  ) where

import Data.Maybe
import GHC.Parser.Lexer
import HIndent.Parse
import Text.Regex.TDFA hiding (empty)

-- | Extracts all pragmas from the given source code.
--
-- FIXME: The function is slow because it lexicographically analyzes the
-- given source code. An alternative way is to use regular expressions.
-- However, this method cannot determine if what appears to be a pragma is
-- really a pragma, or requires complex regular expressions. For example,
-- @{-\n\n{-# LANGUAGE CPP #-}\n\n-}@ is not a pragma, but is likely to be
-- recognized as such.
extractPragmasFromCode :: String -> [(String, String)] -- ^ [(Pragma's name (e.g., @"LANGUAGE"@), Pragma's element (e.g., @"CPP, DerivingVia"@))]
extractPragmasFromCode :: String -> [(String, String)]
extractPragmasFromCode =
  (String -> Maybe (String, String))
-> [String] -> [(String, String)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe String -> Maybe (String, String)
extractPragmaNameAndElement ([String] -> [(String, String)])
-> (String -> [String]) -> String -> [(String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Token -> Maybe String) -> [Token] -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Token -> Maybe String
extractBlockComment ([Token] -> [String]) -> (String -> [Token]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => String -> [Token]
String -> [Token]
lexCode
  where
    extractBlockComment :: Token -> Maybe String
extractBlockComment (ITblockComment String
c PsSpan
_) = String -> Maybe String
forall a. a -> Maybe a
Just String
c
    extractBlockComment Token
_ = Maybe String
forall a. Maybe a
Nothing

-- | Extracts the pragma's name and its element from the given pragma.
--
-- This function returns a 'Nothing' if it fails to extract them.
extractPragmaNameAndElement :: String -> Maybe (String, String) -- ^ [(Pragma's name (e.g., @"LANGUAGE"@), Pragma's element (e.g., @"CPP, DerivingVia"@))]
extractPragmaNameAndElement :: String -> Maybe (String, String)
extractPragmaNameAndElement String
l
  | (String
_, String
_, String
_, [String
name, String
element]) <-
      Regex -> String -> (String, String, String, [String])
forall regex source target.
RegexContext regex source target =>
regex -> source -> target
match Regex
pragmaRegex String
l :: (String, String, String, [String]) =
    (String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just (String
name, String
element)
extractPragmaNameAndElement String
_ = Maybe (String, String)
forall a. Maybe a
Nothing

-- | A regex to match against a pragma.
pragmaRegex :: Regex
pragmaRegex :: Regex
pragmaRegex =
  CompOption -> ExecOption -> String -> Regex
forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
compOpt -> execOpt -> source -> regex
makeRegexOpts
    CompOption
compOption
    ExecOption
execOption
    String
"^{-#[[:space:]]*([^[:space:]]+)[[:space:]]+([^#]+)#-}"

-- | The option for matching against a pragma.
execOption :: ExecOption
execOption :: ExecOption
execOption = ExecOption {captureGroups :: Bool
captureGroups = Bool
True}

-- | The option for matching against a pragma.
--
-- 'multiline' is set to 'False' to match against multiline pragmas, e.g.,
-- @{-# LANGUAGE CPP\nOverloadedStrings #-}@.
compOption :: CompOption
compOption :: CompOption
compOption =
  CompOption
    { caseSensitive :: Bool
caseSensitive = Bool
True
    , multiline :: Bool
multiline = Bool
False
    , rightAssoc :: Bool
rightAssoc = Bool
True
    , newSyntax :: Bool
newSyntax = Bool
True
    , lastStarGreedy :: Bool
lastStarGreedy = Bool
True
    }